emacs_el/tiny-tools/other/expect.el

   1 ;;; expect.el --- support for external process communication
   2
   3 ;; This file is not part of Emacs
   4
   5 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   6 ;; Author: Lars Magne Ingebrigtsen <lmi@gnus.org>
   7 ;; Keywords: extensions, processes
   8 ;;
   9 ;; This file is soon to be part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with program; see the file COPYING. If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;
  26 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  27
  28 ;;; Commentary:
  29
  30 ;;; Code:
  31
  32 (require 'cl)
  33
  34 (eval-and-compile
  35   ;; Old XEmacs does not have this, ignore load error
  36   (ignore-errors (require 'timer))
  37
  38   (when (and (not (fboundp 'run-at-time))
  39              (locate-library "tinyliba"))
  40     (require 'tinyliba)))
  41
  42 (defvar expect-message nil
  43   "*If non-nil, report how much data has arrived in the process buffer.
  44 This variable is buffer-local to all Expect buffers, and should be set
  45 inside @code{with-expect} forms.")
  46
  47 (defvar expect-start nil
  48   "If a number, start the Expect searches from that point.
  49 If not, start searches from `(point-min)'.
  50 This variable is typically `let' to t before calling `with-expect'
  51 when waiting for output from a process that is already started and may
  52 have output data.")
  53
  54 (defvar expect-timeout 10
  55   "The number of seconds to wait before an Expect timeout element is triggered.")
  56
  57 ;;; Internal variables.
  58
  59 (defvar expect-processes nil)
  60 (defvar expect-asynchronous nil)
  61 (defvar expect-process nil)             ; Dynamic variable
  62 (defvar expect-current-info nil)        ; Dynamic variable
  63
  64 ;;; Utility macros.
  65
  66 (defun expect-make-info (process message point)
  67   (list process message point nil nil))
  68
  69 (defmacro expect-info-process (info)
  70   `(nth 0 ,info))
  71
  72 (defmacro expect-info-message (info)
  73   `(nth 1 ,info))
  74
  75 (defmacro expect-info-point (info)
  76   `(nth 2 ,info))
  77 (defmacro expect-info-set-point (info point)
  78   `(setcar (nthcdr 2 ,info) ,point))
  79
  80 (defmacro expect-info-sentinels (info)
  81   `(nth 3 ,info))
  82 (defmacro expect-info-set-sentinels (info sentinels)
  83   `(setcar (nthcdr 3 ,info) ,sentinels))
  84
  85 (defmacro expect-info-timer (info)
  86   `(nth 4 ,info))
  87 (defmacro expect-info-set-timer (info timer)
  88   `(setcar (nthcdr 4 ,info) ,timer))
  89
  90 (defmacro expect-info-queries (info)
  91   `(nthcdr 5 ,info))
  92 (defmacro expect-info-set-queries (info queries)
  93   `(setcdr (nthcdr 4 ,info) ,queries))
  94
  95 (defmacro expect-find-info (process)
  96   `(assoc ,process expect-processes))
  97
  98 ;;; Interface macros.
  99
 100 ;;;###autoload
 101 (defmacro with-expect (program &rest forms)
 102   "Set things up for communication with PROGRAM.
 103 FORMS will be evaluated in the normal manner.  To talk to the process,
 104 use `expect' and `expect-send'.  See the manual for full documentation.
 105 This macro returns nil.
 106
 107 If PROGRAM is a string, start that program.  If PROGRAM is a list, use
 108 the first element of that list as the program and the remainder as the
 109 parameters.  If PROGRAM is a process, talk to that process.
 110
 111 PROGRAM will be started up in a new, fresh temporary buffer.  The
 112 buffer will be killed upon completion.  If PROGRAM is a process,
 113 a new buffer won't be created, and the buffer won't be killed upon
 114 completion."
 115   (let ((buf (make-symbol "buf"))
 116         (point (make-symbol "point")))
 117     `(save-excursion
 118        (let ((,buf (generate-new-buffer " *expect*"))
 119              (,point (point))
 120              expect-process expect-current-info)
 121          (set-buffer ,buf)
 122          (unless (setq expect-process
 123                        (expect-start-process ,program))
 124            (error "Can't start program"))
 125          (expect-setup ,point)
 126          ,@forms
 127          (unless (expect-info-sentinels expect-current-info)
 128            (expect t))
 129          nil))))
 130
 131 (defun expect-start-process (program)
 132   (cond
 133    ((stringp program)
 134     (start-process "expect" (current-buffer) program))
 135    ((consp program)
 136     (apply 'start-process
 137            "expect" (current-buffer) (car program) (cdr program)))
 138    ((processp program)
 139     program)
 140    (t
 141     (error "Illegal process spec"))))
 142
 143 (defmacro with-expect-asynchronous (program &rest forms)
 144   "Set things up for asynchronous communication with PROGRAM.
 145 This macro behaves like `with-expect', only that `expect' calls
 146 contained in FORMS will be evaluated asyncronously.
 147
 148 See the documentation of the `with-expect' macro for documentation."
 149   `(let ((expect-asynchronous t))
 150      (with-expect ,program ,@forms)))
 151
 152 (defmacro expect (regexp &rest forms)
 153   "Execute FORMS when REGEXP  has arrived in the buffer."
 154   `(expect-1 ,regexp #'(lambda () ,@forms)))
 155
 156 (defmacro expect-cond (&rest clauses)
 157   "Try each clause until one succeeds.
 158 Each clause looks like (CONDITION BODY).  CONDITION should be
 159 a regular expression to wait for, or a process status symbol.
 160 If CONDITION is satisfied (i. e., the data has arrived or
 161 the process has entered the specified status), BODY will be executed."
 162   (let (result)
 163     (while clauses
 164       (push (if (stringp (caar clauses)) (caar clauses)
 165               (list 'quote (caar clauses)))
 166             result)
 167       (push (car `(#'(lambda () ,@(cdar clauses)))) result)
 168       (pop clauses))
 169     `(expect-1 ,@(nreverse result))))
 170
 171 (defmacro expect-exit (&rest forms)
 172   "Execute FORMS when the process has exited."
 173   `(expect-exit-1 #'(lambda () ,@forms)))
 174
 175 ;;; User utility functions.
 176
 177 (defmacro expect-send (string)
 178   "Send STRING to the current buffer's process."
 179   `(process-send-string expect-process ,string))
 180
 181 ;;; Internal functions.
 182
 183 (defun expect-setup (&optional point)
 184   "Initialize Expect data, filter and sentinel."
 185   (setq expect-current-info
 186         (expect-make-info expect-process expect-message
 187                           (or point expect-start (point-min))))
 188   (push expect-current-info expect-processes)
 189   (set-process-filter expect-process 'expect-filter)
 190   (set-process-sentinel expect-process 'expect-sentinel)
 191   (set-buffer (process-buffer expect-process)))
 192
 193 (defun expect-shutdown (process)
 194   "Remove Expect infestation of PROCESS."
 195   (setq expect-processes (delq (expect-find-info process) expect-processes))
 196   (set-process-filter process nil)
 197   (set-process-sentinel process nil))
 198
 199 (defun expect-kill (process)
 200   "Kill PROCESS and its buffer."
 201   (let ((buffer (process-buffer process)))
 202     (when (buffer-name buffer)
 203       (kill-buffer buffer))
 204     (expect-shutdown process)
 205     (delete-process process)))
 206
 207 (defun expect-wait ()
 208   "Wait until the current outstanding command has been performed."
 209   (let ((info (expect-find-info expect-process)))
 210     (expect-setup-timer info)
 211     (while (and (car (expect-info-queries (expect-find-info expect-process)))
 212                 (memq (process-status expect-process) '(open run)))
 213       (accept-process-output expect-process 1))
 214     (expect-cancel-timer info))
 215   ;; We return nil.
 216   nil)
 217
 218 (defun expect-1 (&rest clauses)
 219   (let (entries
 220         timeout)
 221     (unless expect-process
 222       (error "No expect in this buffer"))
 223     ;; Add this clause to the list of things to be executed.
 224     (while clauses
 225       (if (eq (car clauses) 'timeout)
 226           (setq timeout (cadr clauses)
 227                 clauses (cddr clauses))
 228         (push (list (pop clauses) (pop clauses))
 229               entries)))
 230     (when timeout
 231       (expect-info-set-timer expect-current-info
 232                              (list nil expect-timeout timeout)))
 233     (nconc expect-current-info (list (nreverse entries)))
 234     ;; We see whether we have to wait for the command to complete
 235     ;; or not.
 236     (if expect-asynchronous
 237         nil
 238       (expect-wait))))
 239
 240 (defun expect-exit-1 (function)
 241   (unless expect-process
 242     (error "No expect in this buffer"))
 243   (let ((info (expect-find-info expect-process)))
 244     (expect-info-set-sentinels
 245      info
 246      (nconc (expect-info-sentinels info)
 247             (list function))))
 248   ;; We return nil.
 249   nil)
 250
 251 (defun expect-filter (process string)
 252   "Controlling Expect function run as a process filter."
 253   (let ((old-buffer (current-buffer))
 254         (expect-process process))
 255     (unwind-protect
 256         (let (moving)
 257           (set-buffer (process-buffer process))
 258           (setq moving (= (point) (process-mark process)))
 259           (save-excursion
 260             ;; Insert the text, moving the process-marker.
 261             (goto-char (process-mark process))
 262             (insert string)
 263             (set-marker (process-mark process) (point))
 264             ;; Do Expect things.
 265             (expect-find-event process))
 266           (when (memq (process-status process) '(open run))
 267             (if moving (goto-char (process-mark process)))))
 268       (when (buffer-name old-buffer)
 269         (set-buffer old-buffer)))))
 270
 271 (defun expect-sentinel (process status)
 272   "Controlling Expect sentinel."
 273   ;; Perhaps we're waiting for one of the process events?
 274   (when (memq (process-status process) '(open run))
 275     (expect-find-event process))
 276   ;; We do `expect-exit' calls.
 277   (when (eq 'exit (process-status process))
 278     (save-excursion
 279       (let ((expect-process process))
 280         (when (and (process-buffer process)
 281                    (buffer-name (process-buffer process)))
 282           (set-buffer (process-buffer process))
 283           (let ((sentinels (expect-info-sentinels (expect-find-info process))))
 284             (while sentinels
 285               (save-excursion
 286                 (funcall (pop sentinels))))
 287             (expect-shutdown process)))))))
 288
 289 (defun expect-find-event (process)
 290   "Find (and execute) the next event."
 291   (let* ((info (expect-find-info process))
 292          (point (expect-info-point info))
 293          (queries (expect-info-queries info))
 294          (clause (car queries))
 295          cond)
 296     (expect-setup-timer info)
 297     (when (expect-info-message info)
 298       (message "Expect received %d bytes" (point-max)))
 299     (when clause
 300       (if (eq (caar clause) t)
 301           ;; We have handled all queries and want to die.
 302           (expect-kill process)
 303         (when (> (point-max) point)
 304           (goto-char point)
 305           (while clause
 306             (setq cond (caar clause))
 307             (when (cond
 308                    ;; Regexp
 309                    ((stringp cond)
 310                     (re-search-forward (caar clause) nil t))
 311                    ;; Fall-through
 312                    ((eq t cond)
 313                     t)
 314                    ;; Process state
 315                    ((memq cond '(exit run stop signal open closed))
 316                     (eq cond (process-status process)))
 317                    (t
 318                     (error "Illegal condition: %s" cond)))
 319               (expect-cancel-timer info)
 320               (expect-info-set-point info (point))
 321               (expect-info-set-queries info (cdr queries))
 322               (save-excursion
 323                 (funcall (cadar clause)))
 324               (setq clause nil)
 325               ;; More than one event may have arrived, so we try again.
 326               (when (memq (process-status process) '(open run))
 327                 (expect-find-event process)))
 328             (setq clause (cdr clause))))))))
 329
 330 (defun expect-setup-timer (info)
 331   (let ((timer (expect-info-timer info)))
 332     (when timer
 333       (expect-cancel-timer info)
 334       (setcar timer (run-at-time (cadr timer) nil (caddr timer))))))
 335
 336 (defun expect-cancel-timer (info)
 337   (when (car (expect-info-timer info))
 338     (ignore-errors (cancel-timer (car (expect-info-timer info))))))
 339
 340 ;;; Indentation and edebug specs.
 341
 342 (put 'expect 'lisp-indent-function 1)
 343 (put 'expect 'edebug-form-spec '(form body))
 344 (put 'expect-exit 'lisp-indent-function 0)
 345 (put 'expect-exit 'edebug-form-spec '(body))
 346 (put 'with-expect 'lisp-indent-function 1)
 347 (put 'with-expect 'edebug-form-spec '(form body))
 348 (put 'with-expect-asynchronous 'lisp-indent-function 1)
 349 (put 'with-expect-asynchronous 'edebug-form-spec '(form body))
 350
 351 (provide 'expect)
 352
 353 ;;; expect.el ends here