X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a79dd37f3cbe3ba0b513a22bbda8d335bd856f00..af1503e299857e5c3d3a04c50a32e00c968ed494:/packages/fsm/fsm.el diff --git a/packages/fsm/fsm.el b/packages/fsm/fsm.el index c89322b2a..42dda1542 100644 --- a/packages/fsm/fsm.el +++ b/packages/fsm/fsm.el @@ -1,9 +1,12 @@ ;;; fsm.el --- state machine library -*- lexical-binding: t; -*- -;; Copyright (C) 2006, 2007, 2008 Magnus Henoch +;; Copyright (C) 2006, 2007, 2008, 2015 Free Software Foundation, Inc. -;; Author: Magnus Henoch -;; Version: 0.1ttn4 +;; Author: Magnus Henoch +;; Maintainer: Thomas Fitzsimmons +;; Version: 0.2 +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) +;; Keywords: extensions ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -97,6 +100,7 @@ ;; -- Remove unnecessary fsm-debug-output message. ;; -- Add FSM name to fsm-debug-output messages that were not including it. ;; -- Fix checkdoc errors. +;; -- Change FSMs from plists to uninterned symbols. ;; NOTE: This is version 0.1ttn4 of fsm.el, with the following ;; mods (an exercise in meta-meta-programming ;-) by ttn: @@ -176,14 +180,16 @@ arguments. ,docstring ,@interactive-spec (fsm-debug-output "Starting %s" ',name) - (let ((fsm (list :fsm ',name))) + (let ((fsm (cl-gensym (concat "fsm-" ,(symbol-name name) "-")))) (cl-destructuring-bind (state state-data &optional timeout) (progn ,@body) - (nconc fsm (list :state nil :state-data nil - :sleep ,(or sleep (lambda (secs) - (accept-process-output - nil secs))) - :deferred nil)) + (put fsm :name ',name) + (put fsm :state nil) + (put fsm :state-data nil) + (put fsm :sleep ,(or sleep (lambda (secs) + (accept-process-output + nil secs)))) + (put fsm :deferred nil) (fsm-update fsm state state-data timeout) fsm))))))) @@ -295,20 +301,17 @@ any state machines using them. Return nil." The timer is canceled if another event occurs before, unless the event handler explicitly asks to keep the timer." (fsm-stop-timer fsm) - (setf (cddr fsm) - (plist-put - (cddr fsm) - :timeout (run-with-timer secs - nil - #'fsm-send-sync fsm - :timeout)))) + (put fsm + :timeout (run-with-timer + secs nil + #'fsm-send-sync fsm :timeout))) (defun fsm-stop-timer (fsm) "Stop the timeout timer of FSM." - (let ((timer (plist-get (cddr fsm) :timeout))) + (let ((timer (get fsm :timeout))) (when (timerp timer) (cancel-timer timer) - (setf (cddr fsm) (plist-put (cddr fsm) :timeout nil))))) + (put fsm :timeout nil)))) (defun fsm-maybe-change-timer (fsm timeout) "Change the timer of FSM according to TIMEOUT." @@ -321,17 +324,17 @@ event handler explicitly asks to keep the timer." )) (defun fsm-send (fsm event &optional callback) - "Send FSM EVENT asynchronously. + "Send EVENT to FSM asynchronously. If the state machine generates a response, eventually call CALLBACK with the response as only argument." (run-with-timer 0 nil #'fsm-send-sync fsm event callback)) (defun fsm-update (fsm new-state new-state-data timeout) "Update FSM with NEW-STATE, NEW-STATE-DATA and TIMEOUT." - (let ((fsm-name (cadr fsm)) - (old-state (plist-get (cddr fsm) :state))) - (plist-put (cddr fsm) :state new-state) - (plist-put (cddr fsm) :state-data new-state-data) + (let ((fsm-name (get fsm :name)) + (old-state (get fsm :state))) + (put fsm :state new-state) + (put fsm :state-data new-state-data) (fsm-maybe-change-timer fsm timeout) ;; On state change, call enter function and send deferred events @@ -344,26 +347,25 @@ CALLBACK with the response as only argument." (condition-case e (cl-destructuring-bind (newer-state-data newer-timeout) (funcall enter-fn fsm new-state-data) - (plist-put (cddr fsm) :state-data newer-state-data) + (put fsm :state-data newer-state-data) (fsm-maybe-change-timer fsm newer-timeout)) ((debug error) (fsm-debug-output "%s/%s update didn't work: %S" fsm-name new-state e))))) - (let ((deferred (nreverse (plist-get (cddr fsm) :deferred)))) - (setf (cddr fsm) - (plist-put (cddr fsm) :deferred nil)) + (let ((deferred (nreverse (get fsm :deferred)))) + (put fsm :deferred nil) (dolist (event deferred) (apply 'fsm-send-sync fsm event)))))) (defun fsm-send-sync (fsm event &optional callback) - "Send FSM EVENT synchronously. + "Send EVENT to FSM synchronously. If the state machine generates a response, eventually call CALLBACK with the response as only argument." (save-match-data - (let* ((fsm-name (cl-second fsm)) - (state (plist-get (cddr fsm) :state)) - (state-data (plist-get (cddr fsm) :state-data)) + (let* ((fsm-name (get fsm :name)) + (state (get fsm :state)) + (state-data (get fsm :state-data)) (state-fn (gethash state (get fsm-name :fsm-event)))) ;; If the event is a list, output only the car, to avoid an ;; overflowing debug buffer. @@ -376,9 +378,8 @@ CALLBACK with the response as only argument." ;; Special case for deferring an event until next state change. (cond ((eq result :defer) - (let ((deferred (plist-get (cddr fsm) :deferred))) - (plist-put (cddr fsm) :deferred - (cons (list event callback) deferred)))) + (let ((deferred (get fsm :deferred))) + (put fsm :deferred (cons (list event callback) deferred)))) ((null result) (fsm-debug-output "Warning: event %S ignored in state %s/%s" event fsm-name state)) @@ -398,7 +399,7 @@ CALLBACK with the response as only argument." result))))))) (defun fsm-call (fsm event) - "Send FSM EVENT synchronously, and wait for a reply. + "Send EVENT to FSM synchronously, and wait for a reply. Return the reply. `with-timeout' might be useful." (let (reply) (fsm-send-sync fsm event (lambda (r) (setq reply (list r)))) @@ -421,14 +422,14 @@ Events sent are of the form (:sentinel PROCESS STRING)." (fsm-send-sync fsm (list :sentinel process string))))) (defun fsm-sleep (fsm secs) - "Let FSM receive events while sleeping up to SECS seconds." - (funcall (plist-get (cddr fsm) :sleep) secs)) + "Sleep up to SECS seconds in a way that lets FSM receive events." + (funcall (get fsm :sleep) secs)) (defun fsm-get-state-data (fsm) "Return the state data of FSM. Note the absence of a set function. The fsm should manage its state data itself; other code should just send messages to it." - (plist-get (cddr fsm) :state-data)) + (get fsm :state-data)) (provide 'fsm)