Re: RFC: A framework for task management and execution in Emacs

[Lennart Borgman]

On Tue, Jul 13, 2010 at 12:00 PM,  <address@hidden> wrote:
> Jan Moringen <address@hidden> writes:
>
>> Hi,
>>
>> I would like to start a discussion regarding a topic that has bothered
>> me for some time now: management and execution of (long-running) tasks
>> in Emacs. Instead of properly explaining what I mean by "task", I will
>> just paste a table from my notes that has several examples:
>>
>> | Component    | Execution          | Progress Indication | Cancelable
>> |--------------+--------------------+---------------------+-----------
>> | Tramp        | synchronous        | progress reporter   | no?
>> | VC           | sync, async        | mode-line           | sometimes
>> | Gnus         | synchronous        | ?                   | ?
>> | Compilation  | asynchronous       | mode-line           | yes
>> | URL          | synchronous, async | progress reporter   | ?
>> | Emacs Jabber | timers, fsm        | ?                   | ?
>> | SemanticDB   | idle-timers        | custom reporter     | on input
>>
>> Each of these packages performs some kinds of potentially long running
>> operations. Originally, the table was intended to illustrate the
>> heterogeneous nature of solutions despite similar requirements and
>> use-cases.
>>
>> The (hopefully) upcoming thread support will probably make the situation
>> better and worse. Better, because long-running operations could "simply"
>> run in their own threads, worse because actually implementing this is
>> usually not that simple. The number and complexity of solutions for task
>> execution would probably grow further once threads become available.
>>
>> My proposal is to introduce a set of mechanisms that make task execution
>> more uniform for the user and easier for programmers. Here is the full
>> set of requirements/aspects I could come up with:
>>
>> + Scheduling/Execution
>>   + Resource Allocation (threads)
>>   + Synchronization (order of execution, retrieval of results)
>>   + Canceling
>> + User Interface
>>   + Graphical Indicators
>>   + Progress/remaining Time Estimation
>>   + Error Reporting
>> + Desktop Integration
>>   + Power Management inhibition
>>   + Desktop-wide Task Management
>>     (Example:
>> http://ssickert.wordpress.com/2010/05/09/introducing-my-gsoc project/)
>> + Customization
>> + Compatibility
>>   + Portability
>>   + Backwards Compatibility
>>
>> Since there is so much potential for code duplication, reinventing the
>> wheel and divergent user interfaces, I think all of these issue should
>> be addressed in a general way.
>>
>> Other Environments such as Eclipse or the Evolution mail client seem to
>> employ such generic mechanisms since their user interfaces contain lists
>> of currently running tasks, which can also be interacted with.
>>
>> At this point, my general question is whether there are any plans or
>> related efforts regarding this topic. Of course, I would also like to
>> know whether people consider the approach worthwhile at all :)
>>
>> The second part of this message is about a small prototype framework I
>> made to explore the issue practically.
>>
>> The framework is structured like this:
>>
>> Interface Layer
>> +--------------------------------+-----------------------------------+
>> |                                |                                   |
>> |         User Interface         |               Macros              |
>> |                                |                                   |
>> +--------------------------------+-----------------------------------+
>> Backend Layer
>> +------------------------------+-------------------------------------+
>> |                              |                                     |
>> |              Tasks           +---+            Execution            |
>> | +-----------+     +-----------+  | +-----------+     +-----------+ |
>> | | Strategy1 | ... | StrategyN |  | | Strategy1 | ... | StrategyN | |
>> | +-----------+     +-----------+  | +-----------+     +-----------+ |
>> +----------------------------------+---------------------------------+
>>
>> These components are discussed below:
>>
>> *Macros*
>>
>> Basically just two macros with identical syntax:
>>
>> ({do,run}-as-task NAME (TASK-SPEC) (EXECUTION-SPEC)
>>   [DOCSTRING]
>>   BODY)
>>
>> The difference being that the do- macro returns the result of BODY when
>> it is ready while the run- variant immediately returns an object from
>> which the result of BODY can be retrieved later.
>>
>> Examples:
>>
>> (do-as-task add-numbers () ()
>>   "Add some numbers."
>>   (dolist (i (number-sequence 1 1000))
>>     (+ 1 2 3)
>>     'my-result))
>>
>> + Blocks immediately
>> + Body may or may not start executing immediately
>> + Returns when the body finishes
>> + Returns the value returned by the body
>>
>> (let ((delayed (run-as-task add-numbers () ()
>>   "Add some numbers."
>>   (dolist (i (number-sequence 1 1000))
>>     (+ 1 2 3)
>>       'my-result))))
>>   ;; do other stuff
>>   (future-get delayed))
>>
>> + Does not block
>> + Body may or may not start executing immediately
>> + Returns immediately
>> + Returns an object that implements a "future" protocol
>> + Result of body can be retrieved from returned object
>>
>> *Tasks Strategies*
>>
>>>From the commentary section:
>>
>> ;; What a task is
>> ;; + What gets executed
>> ;; + Execution context (functions callable from task code)
>> ;; + Meta information (name, description)
>> ;; What a task is not
>> ;; + how to execute (synchronous vs. asynchronous)
>> ;; + when to execute (delayed, lazy etc)
>>
>> (do-as-task add-numbers (progress) ()
>>   "Add some numbers, reporting progress."
>>   (dolist (i (number-sequence 1 1000))
>>     (+ 1 2 3)
>>     (progress i))
>>   'my-result)
>>
>> (do-as-task add-numbers (cancelable) ()
>>   "Add some numbers, cancelable."
>>    (dolist (i (number-sequence 1 1000))
>>      (+ 1 2 3)
>>      (maybe-cancel))
>>    'my-result)
>>
>> (do-as-task add-numbers (progress cancelable) ()
>>   "Add some numbers, reporting progress and cancelable."
>>    (dolist (i (number-sequence 1 1000))
>>      (+ 1 2 3)
>>      (progress i)
>>      (maybe-cancel))
>>    'my-result)
>>
>> *Execution Strategies*
>>
>> These control how and when a task is executed. The currently available
>> executions are (:thread is just a teaser, of course):
>>
>> (run-as-task add-numbers () (:execution blocking)
>>
>> (run-as-task add-numbers () (:execution idle)
>>
>> (run-as-task add-numbers () (:execution (timeout :delay 5))
>>
>> (run-as-task add-numbers () (:execution thread))
>>
>> *User Interface*
>>
>> There is also user interface code, but discussing it here would probably
>> provide little insight.
>>
>> The code of the framework described above is available at
>>
>>   http://bazaar.launchpad.net/~scymtym/etasks/trunk/
>>
>> Feedback and suggestions would be greatly appreciated.
>
> Sounds very interesting. I have a scanner package called "emsane" for
> which I developed "emsane-postop". This is basically an event driven
> transaction queue. you push operations on a queue, and when an event
> happens, the operation is popped and executed. If the the operation
> fails, the transaction fails.
>
> Does this fit in your framework? I dont have anywhere public to place
> the code at yet, so I attach the file instead, so you can have a look.
>
>
> ;; (C) FSF 2010, Joakim Verona, part of the emsane package
>
> ;;I want some form of process queue because:
> ;; - tramp gets swamped with lots of async calls
> ;; - some postops are slow, and hundreds of them cant be expected to run in 
> parallell
> ;; emsane was used for a long time withouth a queue, but it put constraints 
> on what could be done
>
> ;; it wouldve been nice if i didnt have to write it, but i didnt find 
> anything.
> ;; i fully expect to be pointed to something glaringly obviously already 
> existing once
> ;; i publish the code.
>
> ;; TODO I want scan-job postprocessing also, for book-level ocr for 
> instance(with ocropus)
>
>
> ;;;tentative stuff
>
> ;; - operation  base class
> ;; - transaction class(a list of operations)
> ;; - queue class(a list of transactions, a result slot)
>
> ;;when a image is finished scanned, a new transaction is created, and the 
> image pushed on the transaction result slot
> ;;the section definition pushes a bunch of ops on the tx
> ;;maybe someone else also pushes a op(the job? scanner?)
> ;;the tx is pushed on the queue
> ;;the queue is event driven, these are events:
> ;; - pushing a tx on the queue
> ;; - an emacs op finishes
> ;; - a shell op finishes
> ;;if any op ina tx fails, the entire tx fails, otoh other txes are unafected
> ;;the workdir is set on the post op buffer, so will work with tramp
> ;;there is a set workdir op, so different scan jobs wont trahs each other
>
>
> ;;its possible to define many queues,
> ;;a queue is connected to 1 postop buffer
>
> ;;transactions are independent, so they could in principle be executed in 
> parallell
> ;;however, a queue will only do transactions in sequence
> ;;futureish is supporting several queues, then pushing transactions round 
> robin on them
>
> ;;emsane-postop-next-op pops an op from the current tx, and executes it
> ;;emsane-postop-push-op pushes op on tx
>
> ;;an op ought to be able to provide environment modifiers, such as changing 
> the flags for the scanner
> ;; the use-case for this is for instance a dust-detector that needs the 
> scanner to scan a little bit more than
> ;; the actual document. the op will then split the img in 2 parts, one actual 
> image, and one part used for dust detection.
>
> (provide 'emsane-postop)
>
> (defclass emsane-postop-operation ()
>  ()
>  "base class for post operations for image scans")
>
> (defclass emsane-postop-lisp-operation (emsane-postop-operation)
>  ((operation-lambda :initarg :operation-lambda
>                     :documentation "a lambda of the form (lambda 
> (transaction) (do-something-with-transaction))"))
>  "A lisp image file operation. for instance for renaming files.")
>
> (defclass emsane-postop-simple-shell-operation (emsane-postop-operation)
>  ((operation-shell-command :initarg :operation-shell-command
>                            :documentation "a simple string to be evaluated by 
> a shell"))
>  "a simple file operation done with a shell command")
>
> (defclass emsane-postop-lifo ()
>  ((lifo :initarg :lifo
>         :initform '()
>         :documentation "a LIFO, Last In First Out"))
>  "base class for queue and transaction")
>
> (defclass emsane-postop-queue (emsane-postop-lifo)
>  ((process-buffer :initarg :process-buffer)
>   (continue-go-loop :initarg  :continue-go-loop :initform t
>                     :documentation "flag setable by subprocess, to indicate 
> continuation")
>   (default-directory :initarg :default-directory :initform default-directory
>     :documentation "subproces default dir")
>   (state :initarg :state :initform nil
>          :documentation  "nil if ok, otherwise an object indicating some 
> error")
>   (error-queue :initarg :error-queue :initform nil  :documentation 
> "transactions who failed gets pushed here")
>   (current-tx :initarg :current-tx :initform nil)
>   (current-op :initarg :current-op :initform nil)
>   (error-hooks :initarg :error-hooks :initform nil
>                :documentation "hooks to run in the event of a transaction 
> error"))
>  "a list of transactions to be performed")
>
> (defmethod emsane-postop-exec ((this emsane-postop-lisp-operation) tx q)
>  "execute lisp operation"
>  (let*
>      ((default-directory  (oref q default-directory)))
>    (condition-case lispop-error
>        (progn
>          (funcall (oref this :operation-lambda) tx q)
>          (emsane-postop-push q tx);;push backcurrent tx. will be skipped if 
> op fails
>          (emsane-process-buffer-message q "lisp-op:%s env:%s\n"
>                            (oref this :operation-lambda)
>                            (emsane-plist2env (oref tx environment))))
>      (error (emsane-postop-signal-error q lispop-error)))))
>
> (defmethod emsane-postop-exec ((this emsane-postop-simple-shell-operation) tx 
> q)
>  "execute shell operation"
>  (let*
>      ((default-directory  (oref q default-directory))
>       (cmd (oref this operation-shell-command))
>       (proc-buf  (oref q :process-buffer))
>       (process-environment (emsane-plist2env (oref tx :environment)))
>       (post-process (start-file-process-shell-command
>                      "postop"
>                      proc-buf
>                      cmd)))
>    (set-process-sentinel post-process 'emsane-postop-sentinel)
>    (process-put post-process 'queue q)
>    (emsane-process-buffer-message q "shell-op:%s env:%s ..." cmd 
> (emsane-plist2env (oref tx environment)))
>    (oset q :continue-go-loop 'waiting-for-shell-op)))
>
> (defun emsane-plist2env (plist)
>  "convert a plist to the env var format used by process-environment"
>  (let*
>      ((env '()))
>    (while plist
>      (setq env (append env (list (format "%s=%s" (first plist) (second 
> plist)))))
>      (setq plist (cdr (cdr plist))))
>    env))
>
> (defun emsane-postop-sentinel (process result)
>  "called when an image shell postop finishes"
>  (let*
>      ((queue (process-get process 'queue))
>       (tx-no-error (= 0 (process-exit-status process))))
>    (unless tx-no-error
>      (emsane-postop-signal-error queue result))
>    (emsane-postop-finish-shell-operation queue tx-no-error)
>    (emsane-postop-go queue);;now continue processing queue transations
>    ))
>
> (defmethod emsane-postop-signal-error ((this emsane-postop-queue) result)
>  "error handler"
>  ;;TODO better error handler
>  ;;there are levels of errors:
>  ;; - tx killers, move the tx to an error queue, other tx:es arent affected
>  ;; - queue killers, inhibit further queue opperations, stop scanning!
>  ;;TODO call hooks, client should know about error(shut down scanner 
> processes in this case)
>  ;;(oset this :state result) ;;TODO "state" is currently used as a 
> queue-killer, which doesnt happen atm
>
>  ;;the case below is "tx killer", push the broken tx on an error queue for 
> later examination, queue chugs on as usual
>  (unless (object-p (oref this :error-queue)) (oset this :error-queue 
> (emsane-postop-lifo "errorq"))) ;;TODO move to q initializer
>
>  ;;the current tx must be removed from the queue, but, uh, only if were 
> executing a shell op??
>  ;;this is because a shell op is pushed back onto the queue before its 
> actualy finished. hmmm.
>  ;;see donext. this sucks.
>
>  ;;im trying to have the sentinel push back the tx instead
>
>  ;; (if (equal (object-class (oref this :current-op))  
> 'emsane-postop-simple-shell-operation)
>  ;;     (emsane-postop-dequeue this))
>
>
>  ;;TODO :current-tx should be the complete failed transaction, not the same 
> as the modified tx on top of the q, as it is now
>  (emsane-postop-push (oref this :current-tx) (oref this :current-op));;push 
> back the failed op on current tx
>  (emsane-postop-push (oref this :error-queue) (oref this :current-tx));;push 
> failed tx on error q
>
>
>  (mapc #'funcall (oref this :error-hooks));;using run-hooks turned out not so 
> good here
>  (let*
>      ((msg (format "postop failed. result:%s\n  tx:%s\n  op:%s" result (oref 
> this :current-tx) (oref this :current-op))))
>    (emsane-process-buffer-message this msg)
>    (message msg))
>  )
>
> (defmethod emsane-postop-push ((this emsane-postop-lifo) object)
>  "Push object on the LIFO queue. New objects go at the head of the list."
>  (oset this :lifo (cons object   (oref this :lifo))))
>
> (defmethod emsane-postop-push ((this emsane-postop-queue) object)
>  "add some debugging output"
>  (call-next-method)
>  ;;(emsane-process-buffer-message this "pushed on queue: %s\n" object)
>  )
>
>
> (defmethod emsane-postop-dequeue ((this emsane-postop-lifo))
>  "Return object from the end of the LIFO  queue, and remove the element."
>  (unless (emsane-postop-hasnext this) (error "poping an empty queue is bad"))
>  (let
>      ((rv (car (last (oref this :lifo)))))
>    ;;(oset this :lifo (nreverse (cdr (nreverse (oref this :lifo)))));;TODO 
> ugly implementation
>    (oset this :lifo (delq rv (oref this :lifo)))
>    rv))
>
> (defmethod emsane-postop-hasnext ((this emsane-postop-lifo))
>  "empty?"
>  (not (null (oref this :lifo))))
>
> (defclass emsane-postop-transaction (emsane-postop-lifo)
>  ((environment :initarg :environment
>                :initform nil
>                :documentation "transaction environment variables."))
>  "a list of operations that must be performed together. contains environment 
> operations can access")
>
> (defmethod  emsane-postop-getenv ((this  emsane-postop-transaction) varname)
>  (plist-get (oref this environment) varname))
>
> (defmethod  emsane-postop-setenv ((this  emsane-postop-transaction) varname 
> value)
>  (oset this environment (plist-put (oref this environment) varname value)))
>
> (defmethod emsane-postop-finish-shell-operation ((this emsane-postop-queue) 
> tx-no-error)
>  "finishup an ongoing shell operation, take care of error situation."
>  (if tx-no-error
>      (progn
>        (emsane-postop-push this (oref this :current-tx));;push backcurrent tx 
> if everything went ok. awkward.
>        (emsane-process-buffer-message this "... DONE! env:%s\n"  
> (emsane-plist2env (oref (oref this :current-tx) environment)))
>        )
>    (emsane-process-buffer-message this "... FAILED! %s!!!.\n" tx-no-error))
>  (oset this :continue-go-loop t))
>
> (defmethod emsane-process-buffer-message ((this emsane-postop-queue) string 
> &rest objects)
>  ;;TODO should have its own insert marker, so moving the cursor doesnt break 
> output
>    (with-current-buffer (oref this :process-buffer)
>      (insert (apply 'format (cons string objects)))))
>
> (defmethod emsane-process-buffer-insert ((this emsane-postop-queue) string 
> &rest objects)
>  ;;TODO should have its own insert marker, so moving the cursor doesnt break 
> output
>    (with-current-buffer (oref this :process-buffer)
>      (insert (apply 'format (cons string objects)))))
>
> (defmethod emsane-postop-donext ((this emsane-postop-queue))
>  "pops an operation from the current transaction in the queue and executes it.
> continue with the 1st op of the next transaction if the current transaction 
> is finished.
> if the queue is empty return nil."
>  ;;TODO the method should always be safe to call, regardless of the queue 
> state, ensure this
>  ;;TODO delete the transaction if the operation fails.
>  ;;should almost work, because if crash, we dont push back th eop
>  (if (oref this state) (error "the queue is unwell:%s" (oref this state)))
>  (if (emsane-postop-hasnext this)
>      (let*
>          ((tx (emsane-postop-dequeue this))
>           (op))
>        (oset this :current-tx tx)
>        (if (emsane-postop-hasnext tx)
>            (progn
>              (setq op  (emsane-postop-dequeue tx))
>              (oset this :current-op op)
>              (emsane-postop-exec op tx this))
>          (emsane-postop-donext this) ;;TODO really? recursion doesnt feel 
> right when we might have a complicated error condition...
>          ))))
>
> (defmethod emsane-postop-go ((this emsane-postop-queue))
>  "start or continue executing transactions in queue.
> it is supposed to always be safe to call.";;TODO it isnt atm...
>  (if (oref this state) (error "the queue is unwell:%s" (oref this state)))
>  ;;(emsane-process-buffer-message this "cgloop:%s\n" (oref this 
> :continue-go-loop)  )
>  (unless  (equal (oref this :continue-go-loop) 'waiting-for-shell-op)
>      (let
>          ((continue-go-loop t))
>        (while (and continue-go-loop
>                    (not (eq 'waiting-for-shell-op continue-go-loop))
>                    (emsane-postop-hasnext this)) ;;TODO continue-go-loop is 
> madness atm
>          (emsane-postop-donext this)
>          (setq continue-go-loop (oref this :continue-go-loop))))))


I have a queue implementation for communicating with Firefox. Maybe
this could be replaced by this implementation. If someone is
interested please look in nXhtml, mozadd.el.