]>
Commit | Line | Data |
---|---|---|
53e6db90 DC |
1 | ;ELC\1c\0\0\0 |
2 | ;;; Compiled | |
3 | ;;; in Emacs version 28.2 | |
4 | ;;; with all optimizations. | |
5 | ||
6 | ||
7 | ||
8 | (require 'cl-lib) | |
9 | #@78 *Name of buffer for fsm debug messages. | |
10 | If nil, don't output debug messages.\1f | |
11 | (defvar fsm-debug "*fsm-debug*" (#$ . -102)) | |
12 | #@144 *Timestamp format (a string) for `fsm-debug-output'. | |
13 | Default format is whatever `current-time-string' returns | |
14 | followed by a colon and a space.\1f | |
15 | (defvar fsm-debug-timestamp-format nil (#$ . -231)) | |
16 | #@130 Append debug output to buffer named by the variable `fsm-debug'. | |
17 | FORMAT and ARGS are passed to `format'. | |
18 | ||
19 | (fn FORMAT &rest ARGS)\1f | |
20 | (defalias 'fsm-debug-output #[385 "\b\205%\0r\302\b!q\210\212db\210 \203\18\0\303 !\202\1c\0\304 \305P\306\307\ 4\ 4#\310\261\ 3*\207" [fsm-debug fsm-debug-timestamp-format get-buffer-create format-time-string current-time-string ": " apply format "\n"] 7 (#$ . 433)]) | |
21 | #@824 Define a state machine class called NAME. | |
22 | A function called start-NAME is created, which uses the argument | |
23 | list and body specified in the :start argument. BODY should | |
24 | return a list of the form (STATE STATE-DATA [TIMEOUT]), where | |
25 | STATE is the initial state (defined by `define-state'), | |
26 | STATE-DATA is any object, and TIMEOUT is the number of seconds | |
27 | before a :timeout event will be sent to the state machine. BODY | |
28 | may refer to the instance being created through the dynamically | |
29 | bound variable `fsm'. | |
30 | ||
31 | SLEEP-FUNCTION, if provided, takes one argument, the number of | |
32 | seconds to sleep while allowing events concerning this state | |
33 | machine to happen. There is probably no reason to change the | |
34 | default, which is accept-process-output with rearranged | |
35 | arguments. | |
36 | ||
37 | (fn NAME :start ((ARG ...) DOCSTRING BODY) [:sleep SLEEP-FUNCTION])\1f | |
38 | (defalias 'define-state-machine '(macro . #[385 "\300\ 1\301\"A@\300\ 2\302\"A@\ 2\211\2037\0\211@\303>\203 \0\211AA\262\ 1\202\r\0\304\ 4>A@\203.\0\305\262\ 1\202\r\0\306\307\ 2@\"\210\202\r\0\210\310\311\312\ 6\ 6\"!\305\ 3\211A\203O\0\ 4\211A\262\ 2\242\202V\0\313\314\315\ 3GD\"\ 1\211A\262\ 3\242\ 2@:\203s\0\ 2@@\316=\203s\0\ 2\211A\262\ 4\242C\262\ 4\211;\204|\0\306\317!\210\320\321\322\ 6\vD\323BB\321\322\ 6\fD\324BB\325\ 6\b\ 6\ 6\ 6\ 6\326\ 6\v\327\330\322\ 6\14DE\331\332\333\334\335\336\ 6\18!\337BBBDDC\340\341\320\ 6\11B\321\332\342\322\ 6\eDF\343\344\321\332\302\ 6\1a\206\307\0\345F\346BBBBBBBED\"BBBBF\207" [plist-member :start :sleep (:start :sleep :allow-other-keys) :allow-other-keys nil error "Keyword argument %s not one of (:start :sleep)" intern format "start-%s" signal wrong-number-of-arguments (arglist docstring &body body) interactive "Docstring is not a string" progn put quote (:fsm-enter (make-hash-table :size 11 :test 'eq)) (:fsm-event (make-hash-table :size 11 :test 'eq)) defun append fsm-debug-output "Starting %s" let fsm cl-gensym concat "fsm-" symbol-name ("-") cl-destructuring-bind (state state-data &optional timeout) :name (put fsm :state nil) (put fsm :state-data nil) (lambda (secs) (accept-process-output nil secs)) ((put fsm :deferred nil) (fsm-update fsm state state-data timeout) fsm)] 31 (#$ . 823)])) | |
39 | (put 'define-state-machine 'edebug-form-spec '(&define name :name start &rest &or [":start" (lambda-list [&optional ("interactive" interactive)] stringp def-body)] [":sleep" function-form])) | |
40 | #@1092 Define a state called STATE-NAME in the state machine FSM-NAME. | |
41 | ARGLIST and BODY make a function that gets called when the state | |
42 | machine receives an event in this state. The arguments are: | |
43 | ||
44 | FSM the state machine instance (treat it as opaque) | |
45 | STATE-DATA An object | |
46 | EVENT The occurred event, an object. | |
47 | CALLBACK A function of one argument that expects the response | |
48 | to this event, if any (often `ignore' is used) | |
49 | ||
50 | If the event should return a response, the state machine should | |
51 | arrange to call CALLBACK at some point in the future (not necessarily | |
52 | in this handler). | |
53 | ||
54 | The function should return a list of the form (NEW-STATE | |
55 | NEW-STATE-DATA TIMEOUT): | |
56 | ||
57 | NEW-STATE The next state, a symbol | |
58 | NEW-STATE-DATA An object | |
59 | TIMEOUT A number: send timeout event after this many seconds | |
60 | nil: cancel existing timer | |
61 | :keep: let existing timer continue | |
62 | ||
63 | Alternatively, the function may return the keyword :defer, in | |
64 | which case the event will be resent when the state machine enters | |
65 | another state. | |
66 | ||
67 | (fn FSM-NAME STATE-NAME ARGLIST &body BODY)\1f | |
68 | (defalias 'define-state '(macro . #[899 "\300\301\302\ 5D\303\302\ 6\bD\304BBE\305\ 4\ 4BBE\207" [setf gethash quote get (:fsm-event) lambda] 10 (#$ . 3107)])) | |
69 | (put 'define-state 'edebug-form-spec '(&define name name :name handler lambda-list def-body)) | |
70 | #@569 Define a function to call when FSM-NAME enters the state STATE-NAME. | |
71 | ARGLIST and BODY make a function that gets called when the state | |
72 | machine enters this state. The arguments are: | |
73 | ||
74 | FSM the state machine instance (treat it as opaque) | |
75 | STATE-DATA An object | |
76 | ||
77 | The function should return a list of the form (NEW-STATE-DATA | |
78 | TIMEOUT): | |
79 | ||
80 | NEW-STATE-DATA An object | |
81 | TIMEOUT A number: send timeout event after this many seconds | |
82 | nil: cancel existing timer | |
83 | :keep: let existing timer continue | |
84 | ||
85 | (fn FSM-NAME STATE-NAME ARGLIST &body BODY)\1f | |
86 | (defalias 'define-enter-state '(macro . #[899 "\300\301\302\ 5D\303\302\ 6\bD\304BBE\305\ 4\ 4BBE\207" [setf gethash quote get (:fsm-enter) lambda] 10 (#$ . 4450)])) | |
87 | (put 'define-enter-state 'edebug-form-spec '(&define name name :name enter lambda-list def-body)) | |
88 | #@847 Define a state machine class called NAME, along with its STATES. | |
89 | This macro is (further) syntatic sugar for `define-state-machine', | |
90 | `define-state' and `define-enter-state' macros, q.v. | |
91 | ||
92 | NAME is a symbol. Everything else is specified with a keyword arg. | |
93 | ||
94 | START and SLEEP are the same as for `define-state-machine'. | |
95 | ||
96 | STATES is a list, each element having the form (STATE-NAME . STATE-SPEC). | |
97 | STATE-NAME is a symbol. STATE-SPEC is an alist with keys `:event' or | |
98 | `:enter', and values a series of expressions representing the BODY of | |
99 | a `define-state' or `define-enter-state' call, respectively. | |
100 | ||
101 | FSM-NAME, STATE-DATA-NAME, CALLBACK-NAME, and EVENT-NAME are symbols, | |
102 | used to construct the state functions' arglists. | |
103 | ||
104 | (fn NAME &key START SLEEP STATES (FSM-NAME \='fsm) (STATE-DATA-NAME \='state-data) (CALLBACK-NAME \='callback) (EVENT-NAME \='event))\1f | |
105 | (defalias 'define-fsm '(macro . #[385 "\300\ 1\301\"A@\300\ 2\302\"A@\300\ 3\303\"A@\300\ 4\304\"\206\1a\0\305A@\300\ 5\306\"\206$\0\307A@\300\ 6\ 6\310\"\206/\0\311A@\300\ 6\a\312\"\206:\0\313A@\ 6\a\211\203i\0\211@\314>\203Q\0\211AA\262\ 1\202>\0\315\ 6 >A@\203`\0\316\262\ 1\202>\0\317\320\ 2@\"\210\202>\0\210\321\322\ 6\n\301\ 6\n\302\ 6\v\257\ 6\ 6\ 6\316\211\211\ 3:\203\315\0\ 3@\262\ 3\ 2\211A\262\ 4\242\262\ 2\323\ 3\236\211\203\246\0\324\ 6\10\ 4\ 6\r\ 6\rD\ 4ABBBB\ 2B\262\ 2\210\325\ 3\236\211\203\305\0\326\ 6\10\ 4\ 6\r\ 6\r\ 6\f\ 6\ eF\ 4ABBBB\ 2B\262\ 2\210\ 3A\262\ 4\202{\0\211\237\266\204BB\207" [plist-member :start :sleep :states :fsm-name (nil fsm) :state-data-name (nil state-data) :callback-name (nil callback) :event-name (nil event) (:start :sleep :states :fsm-name :state-data-name :callback-name :event-name :allow-other-keys) :allow-other-keys nil error "Keyword argument %s not one of (:start :sleep :states :fsm-name :state-data-name :callback-name :event-name)" progn define-state-machine :enter define-enter-state :event define-state] 23 (#$ . 5280)])) | |
106 | #@247 Unbind functions related to fsm NAME (a symbol). | |
107 | Includes start-NAME, and each fsm-NAME-STATE and fsm-NAME-enter-STATE. | |
108 | Functions are `fmakunbound', which will probably give (fatal) pause to | |
109 | any state machines using them. Return nil. | |
110 | ||
111 | (fn NAME)\1f | |
112 | (defalias 'fsm-goodbye-cruel-world #[257 "\300\301\302\303\ 4\"!!\210\304\305\ 2\306N\211\262\ 3!\203\1e\0\307\ 1!\210\310\ 2\306\"\210\305\ 2\311N\211\262\ 3!\2032\0\307\ 1!\210\310\ 2\311\"\210\210\304\207" [fmakunbound intern format "start-%s" nil hash-table-p :fsm-event clrhash cl-remprop :fsm-enter] 6 (#$ . 7102) "SUnbind function definitions for fsm named: "]) | |
113 | #@178 Send a timeout event to FSM after SECS seconds. | |
114 | The timer is canceled if another event occurs before, unless the | |
115 | event handler explicitly asks to keep the timer. | |
116 | ||
117 | (fn FSM SECS)\1f | |
118 | (defalias 'fsm-start-timer #[514 "\300\ 2!\210\301\ 2\302\303\ 4\304\305\ 6\b\302%#\207" [fsm-stop-timer put :timeout run-with-timer nil fsm-send-sync] 11 (#$ . 7702)]) | |
119 | #@42 Stop the timeout timer of FSM. | |
120 | ||
121 | (fn FSM)\1f | |
122 | (defalias 'fsm-stop-timer #[257 "\211\300N\301\ 1!\205\12\0\302\ 1!\210\303\ 2\300\304#\207" [:timeout timerp cancel-timer put nil] 6 (#$ . 8045)]) | |
123 | #@65 Change the timer of FSM according to TIMEOUT. | |
124 | ||
125 | (fn FSM TIMEOUT)\1f | |
126 | (defalias 'fsm-maybe-change-timer #[514 "\211\247\203\n\0\300\ 2\ 2\"\207\211?\205\12\0\301\ 2!\207" [fsm-start-timer fsm-stop-timer] 5 (#$ . 8231)]) | |
127 | #@174 Send EVENT to FSM asynchronously. | |
128 | If the state machine generates a response, eventually call | |
129 | CALLBACK with the response as only argument. | |
130 | ||
131 | (fn FSM EVENT &optional CALLBACK)\1f | |
132 | (defalias 'fsm-send #[770 "\300\301\302\303\ 6\ 6\ 6\ 6\ 6\ 6&\ 6\207" [run-with-timer 0 nil fsm-send-sync] 10 (#$ . 8442)]) | |
133 | #@99 Update FSM with NEW-STATE, NEW-STATE-DATA and TIMEOUT. | |
134 | ||
135 | (fn FSM NEW-STATE NEW-STATE-DATA TIMEOUT)\1f | |
136 | (defalias 'fsm-update #[1028 "\ 3\300N\ 4\301N\302\ 6\ 6\301\ 6\a#\210\302\ 6\ 6\303\ 6\ 6#\210\304\ 6\ 6\ 4\"\210\211\ 5=?\205\242\0\305\306\ 3\ 6\a#\210\307\ 5\ 3\310N\"\311\ 1!\203}\0\305\312\ 4\ 6\b#\210\3131t\0\211\ 6\a\ 6\ 6\"\211G\314U\203W\0\211\ 1A\262\ 2\242\202^\0\315\316\317\ 3GD\"\ 1\242\302\ 6\n\303\ 4#\210\304\ 6\n\ 2\"\266\2030\266\ 2\202~\0\305\320\ 5\ 6 \ 4$\266\ 2\210\ 5\321N\237\302\ 6\a\321\322#\210\211\211\205\236\0\211@\323\324\ 6\n\ 3#\210\ 1A\266\202\202\212\0\262\ 1\262\ 1\207" [:name :state put :state-data fsm-maybe-change-timer fsm-debug-output "%s enters %s" gethash :fsm-enter functionp "Found enter function for %s/%s" (debug error) 2 signal wrong-number-of-arguments (newer-state-data newer-timeout) "%s/%s update didn't work: %S" :deferred nil apply fsm-send-sync] 14 (#$ . 8732)]) | |
137 | #@173 Send EVENT to FSM synchronously. | |
138 | If the state machine generates a response, eventually call | |
139 | CALLBACK with the response as only argument. | |
140 | ||
141 | (fn FSM EVENT &optional CALLBACK)\1f | |
142 | (defalias 'fsm-send-sync #[770 "\300 \301\302\ 2\"\216\ 3\303N\ 4\304N\ 5\305N\306\ 2\ 4\307N\"\310\311\ 6\b\242\206 \0\ 6\b\ 6\ 6\ 6\ 6$\210\3121;\0\211\ 6\b\ 3\ 6 \ 6 \2066\0\313$0\202@\0\314\ 1B\262\ 1\211\315\267\202g\0\ 6\b\316N\317\ 6\n\316\ 6\v\ 6\vD\ 4B#\262\ 1\202\324\0\310\320\ 6 \ 6\a\ 6\a$\202\324\0\211\242\314=\203|\0\310\321\ 6\ 6\ 6\ 6\322\ 5A!$\202\324\0\211<\203\314\0\323\ 1GX\203\314\0\211G\324X\203\314\0\211\ 1A\203\236\0\ 1\211A\262\ 2\242\202\245\0\325\326\327\ 3GD\"\ 1\211A\262\ 3\242\ 2\211A\262\ 4\242\ 3\203\300\0\325\326\327\324\ 6\aG\\D\"\210\330\ 6\r\ 4\ 4\ 4$\266\204\202\324\0\310\331\ 6\ 6\ 6\ 6\ 4$\262\ 1\266\204)\207" [match-data make-closure #[0 "\301\300\302\"\207" [V0 set-match-data evaporate] 3] :name :state :state-data gethash :fsm-event fsm-debug-output "Sent %S to %s in state %s" (debug error) ignore :error-signaled #s(hash-table size 2 test eq rehash-size 1.5 rehash-threshold 0.8125 purecopy t data (:defer 70 nil 91)) :deferred put "Warning: event %S ignored in state %s/%s" "Error in %s/%s: %s" error-message-string 2 3 signal wrong-number-of-arguments (new-state new-state-data &optional timeout) fsm-update "Incorrect return value in %s/%s: %S"] 18 (#$ . 9559)]) | |
143 | #@123 Send EVENT to FSM synchronously, and wait for a reply. | |
144 | Return the reply. `with-timeout' might be useful. | |
145 | ||
146 | (fn FSM EVENT)\1f | |
147 | (defalias 'fsm-call #[514 "\300C\301\ 3\ 3\302\303\ 5\"#\210\211\242\204\18\0\304\ 3\305\"\210\202\v\0\211\242@\207" [nil fsm-send-sync make-closure #[257 "\300\ 1C\240\207" [V0] 3 "\n\n(fn R)"] fsm-sleep 1] 9 (#$ . 10825)]) | |
148 | #@116 Return a filter function that sends events to FSM. | |
149 | Events sent are of the form (:filter PROCESS STRING). | |
150 | ||
151 | (fn FSM)\1f | |
152 | (defalias 'fsm-make-filter #[257 "\211\300\301\ 2\"\207" [make-closure #[514 "\301\300\302\ 4\ 4E\"\207" [V0 fsm-send-sync :filter] 7 "\n\n(fn PROCESS STRING)"]] 5 (#$ . 11164)]) | |
153 | #@120 Return a sentinel function that sends events to FSM. | |
154 | Events sent are of the form (:sentinel PROCESS STRING). | |
155 | ||
156 | (fn FSM)\1f | |
157 | (defalias 'fsm-make-sentinel #[257 "\211\300\301\ 2\"\207" [make-closure #[514 "\301\300\302\ 4\ 4E\"\207" [V0 fsm-send-sync :sentinel] 7 "\n\n(fn PROCESS STRING)"]] 5 (#$ . 11459)]) | |
158 | #@80 Sleep up to SECS seconds in a way that lets FSM receive events. | |
159 | ||
160 | (fn FSM SECS)\1f | |
161 | (defalias 'fsm-sleep #[514 "\ 1\300N\ 1!\207" [:sleep] 4 (#$ . 11761)]) | |
162 | #@167 Return the state data of FSM. | |
163 | Note the absence of a set function. The fsm should manage its | |
164 | state data itself; other code should just send messages to it. | |
165 | ||
166 | (fn FSM)\1f | |
167 | (defalias 'fsm-get-state-data #[257 "\211\300N\207" [:state-data] 3 (#$ . 11915)]) | |
168 | (provide 'fsm) |