auto-install/working.el

   1 ;;; working --- Display a "working" message in the minibuffer.
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003,
   4 ;;               2004, 2007, 2008, 2009  Eric M. Ludlam
   5
   6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   7 ;; Version: 1.5
   8 ;; Keywords: status
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Working lets Emacs Lisp programmers easily display working messages.
  28 ;; These messages typically come in the form of a percentile, or generic
  29 ;; doodles if a maximum is unknown.
  30 ;;
  31 ;; The working entry points are quite simple.  If you have a loop that needs
  32 ;; to display a status as it goes along, it would look like this:
  33 ;;
  34 ;;  (working-status-forms "Doing stuff" "done"
  35 ;;    (while condition
  36 ;;      (working-status (calc-percentile))
  37 ;;      (my-work))
  38 ;;    (working-status t))
  39 ;;
  40 ;; If you cannot calculate a percentile, use the function
  41 ;; `working-dynamic-status' instead, and pass in what you know.  For
  42 ;; both status printing functions, the first argument is optional,
  43 ;; and you may pass in additional arguments as `format' elements
  44 ;; to the first argument of `working-status-forms'.
  45 ;;
  46 ;; See the examples at the end of the buffer.
  47
  48 ;;; Backwards Compatibility:
  49 ;;
  50 ;; If you want to use working in your program, but don't want to force people
  51 ;; to install working, use could add this at the beginning of your program for
  52 ;; compatibility.
  53 ;;
  54 ;; (eval-and-compile
  55 ;;   (condition-case nil
  56 ;;       (require 'working)
  57 ;;     (error
  58 ;;      (progn
  59 ;;        (defmacro working-status-forms (message donestr &rest forms)
  60 ;;          "Contain a block of code during which a working status is shown."
  61 ;;          (list 'let (list (list 'msg message) (list 'dstr donestr)
  62 ;;                           '(ref1 0))
  63 ;;                (cons 'progn forms)))
  64 ;;
  65 ;;        (defun working-status (&optional percent &rest args)
  66 ;;          "Called within the macro `working-status-forms', show the status."
  67 ;;          (message "%s%s" (apply 'format msg args)
  68 ;;                   (if (eq percent t) (concat "... " dstr)
  69 ;;                     (format "... %3d%%"
  70 ;;                             (or percent
  71 ;;                                 (floor (* 100.0 (/ (float (point))
  72 ;;                                                    (point-max)))))))))
  73 ;;
  74 ;;        (defun working-dynamic-status (&optional number &rest args)
  75 ;;          "Called within the macro `working-status-forms', show the status."
  76 ;;          (message "%s%s" (apply 'format msg args)
  77 ;;                   (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ref1 4))))
  78 ;;          (setq ref1 (1+ ref1)))
  79 ;;
  80 ;;        (put 'working-status-forms 'lisp-indent-function 2)))))
  81 ;;
  82 ;; Depending on what features you use, it is, of course, easy to
  83 ;; reduce the total size of the above by omitting those features you
  84 ;; do not use.
  85
  86 ;;; History:
  87 ;;
  88 ;; 1.0 First Version
  89 ;;
  90 ;; 1.1 Working messages are no longer logged.
  91 ;;     Added a generic animation display funciton:
  92 ;;        Convert celeron to animator
  93 ;;        Added a bounce display
  94 ;;     Made working robust under a multi-frame environment (speedbar)
  95 ;;
  96 ;; 1.2 Fix up documentation.
  97 ;;     Updated dotgrowth function for exceptionally large numbers of dots.
  98 ;;     Added the percentage bubble displays.
  99 ;;
 100 ;; 1.3 Added `working-status-timeout' and `working-status-call-process'.
 101 ;;     Added test fns `working-wait-for-keypress' and `working-verify-sleep'.
 102 ;;
 103 ;; 1.4 ???
 104 ;;
 105 ;; 1.5 Use features from the fame library.
 106 ;;
 107
 108 (require 'custom)
 109 (require 'fame)
 110
 111 ;;; Code:
 112 (defgroup working nil
 113   "Working messages display."
 114   :prefix "working"
 115   :group 'lisp
 116   )
 117
 118 ;;; User configurable variables
 119 ;;
 120 (defcustom working-status-percentage-type 'working-bar-percent-display
 121   "*Function used to display the percent status.
 122 Functions provided in `working' are:
 123   `working-percent-display'
 124   `working-bar-display'
 125   `working-bar-percent-display'
 126   `working-percent-bar-display'
 127   `working-bubble-display'
 128   `working-bubble-precent-display'
 129   `working-celeron-percent-display'"
 130   :group 'working
 131   :type '(choice (const working-percent-display)
 132                  (const working-bar-display)
 133                  (const working-bar-percent-display)
 134                  (const working-percent-bar-display)
 135                  (const working-bubble-display)
 136                  (const working-bubble-percent-display)
 137                  (const working-celeron-percent-display)
 138                  (const nil)))
 139
 140 (defcustom working-status-dynamic-type 'working-celeron-display
 141   "*Function used to display an animation indicating progress being made.
 142 Dynamic working types occur when the program does not know how long
 143 it will take ahead of time.  Functions provided in `working' are:
 144   `working-number-display'
 145   `working-text-display'
 146   `working-spinner-display'
 147   `working-dotgrowth-display'
 148   `working-celeron-display'
 149   `working-bounce-display'"
 150   :group 'working
 151   :type '(choice (const working-number-display)
 152                  (const working-text-display)
 153                  (const working-spinner-display)
 154                  (const working-dotgrowth-display)
 155                  (const working-celeron-display)
 156                  (const working-bounce-display)
 157                  (const nil)))
 158
 159 (defcustom working-percentage-step 2
 160   "*Percentage display step.
 161 A number representing how large a step must be taken when working a
 162 percentage display.  A number such as `2' means `2%'."
 163   :group 'working'
 164   :type 'number)
 165
 166 ;;; Mode line hacks
 167 ;;
 168 ;; When the user doesn't want messages in the minibuffer, hack the mode
 169 ;; line of the current buffer.
 170 (if (featurep 'xemacs)
 171     (eval-and-compile (defalias 'working-mode-line-update 'redraw-modeline))
 172   (eval-and-compile (defalias 'working-mode-line-update 'force-mode-line-update)))
 173
 174 (defvar working-mode-line-message nil
 175   "Message used by working when showing status in the mode line.")
 176
 177 (if (boundp 'global-mode-string)
 178     (progn
 179       ;; If this variable exists, use it to push the working message into
 180       ;; an interesting part of the mode line.
 181       (if (null global-mode-string)
 182           (setq global-mode-string (list "")))
 183       (setq global-mode-string
 184             (append global-mode-string '(working-mode-line-message))))
 185   ;; Else, use minor mode trickery to get a reliable way of doing the
 186   ;; same thing across many versions of Emacs.
 187   (setq minor-mode-alist (cons
 188                           '(working-mode-line-message working-mode-line-message)
 189                           minor-mode-alist))
 190   )
 191
 192 (defvar working-use-echo-area-p t
 193   "*Non-nil use the echo area to display working messages.")
 194
 195 ;;; Variables used in stages
 196 ;;
 197 (defvar working-message nil
 198   "Message stored when in a status loop.")
 199 (defvar working-donestring nil
 200   "Done string stored when in a status loop.")
 201 (defvar working-ref1 nil
 202   "A reference number used in a status loop.")
 203 (defvar working-last-percent 0
 204   "A reference number used in a status loop.")
 205
 206 ;;; Programmer functions
 207 ;;
 208 (eval-when-compile
 209   (cond
 210    ((fboundp 'noninteractive)
 211     ;; Silence the XEmacs byte compiler
 212     (defvar noninteractive))
 213    ((boundp 'noninteractive)
 214     ;; Silence the Emacs byte compiler
 215     (defun noninteractive nil))
 216    ))
 217
 218 (defsubst working-noninteractive ()
 219   "Return non-nil if running without interactive terminal."
 220   (if (boundp 'noninteractive)
 221       noninteractive
 222     (noninteractive)))
 223
 224 (defun working-message-echo (&rest args)
 225   "Print but don't log a one-line message at the bottom of the screen.
 226 See the function `message' for details on ARGS."
 227   (or (working-noninteractive)
 228       (apply 'fame-message-nolog args)))
 229
 230 (defalias 'working-current-message 'fame-current-message)
 231 (defalias 'working-temp-message 'fame-temp-message)
 232
 233 (defun working-message (&rest args)
 234   "Display a message using `working-message-echo' or in mode line.
 235 See the function `message' for details on ARGS."
 236   (if working-use-echo-area-p
 237       (apply 'working-message-echo args)
 238     (when (not working-mode-line-message)
 239       ;; If we start out nil, put stuff in to show we are up to
 240       (setq working-mode-line-message "Working...")
 241       (working-mode-line-update)
 242       (sit-for 0)
 243       )))
 244
 245 ;;; Compatibility
 246 (cond ((fboundp 'run-with-timer)
 247        (eval-and-compile (defalias 'working-run-with-timer 'run-with-timer))
 248        (eval-and-compile (defalias 'working-cancel-timer 'cancel-timer))
 249        )
 250       ;;Add compatibility here
 251       (t
 252        ;; This gets the message out but has no timers.
 253        (defun working-run-with-timer (&rest foo)
 254          (working-message working-message))
 255        (defun working-cancel-timer (&rest foo)
 256          (working-message "%s%s"
 257                           working-message
 258                           working-donestring)))
 259       )
 260
 261 (defmacro working-status-forms (message donestr &rest forms)
 262   "Contain a block of code during which a working status is shown.
 263 MESSAGE is the message string to use and DONESTR is the completed text
 264 to use when the functions `working-status' is called from FORMS."
 265   (let ((current-message (make-symbol "working-current-message")))
 266     `(let ((,current-message (working-current-message))
 267            (working-message ,message)
 268            (working-donestring ,donestr)
 269            (working-ref1 0)
 270            (working-last-percent 0))
 271        (unwind-protect
 272            (progn ,@forms)
 273          (setq working-mode-line-message nil)
 274          (if working-use-echo-area-p
 275              (message ,current-message)
 276            (working-mode-line-update)
 277            (sit-for 0))))
 278     ))
 279 (put 'working-status-forms 'lisp-indent-function 2)
 280
 281 (defmacro working-status-timeout (timeout message donestr &rest forms)
 282   "Contain a block of code during which working status is shown.
 283 The code may call `sit-for' or `accept-process-output', so a timer
 284 is needed to update the message.
 285 TIMEOUT is the length of time to wait between message updates.
 286 MESSAGE is the message string to use and DONESTR is the completed text
 287 to use when the functions `working-status' is called from FORMS."
 288   (let ((current-message (make-symbol "working-current-message")))
 289     `(let* ((,current-message (working-current-message))
 290             (working-message ,message)
 291             (working-donestring ,donestr)
 292             (working-ref1 0)
 293             (time ,timeout)
 294             (working-timer
 295              (working-run-with-timer time time 'working-dynamic-status)))
 296        (unwind-protect
 297            (progn ,@forms)
 298          (working-cancel-timer working-timer)
 299          (working-dynamic-status t)
 300          (setq working-mode-line-message nil)
 301          (if working-use-echo-area-p
 302              (message ,current-message)
 303            (working-mode-line-update)
 304            (sit-for 0))))
 305     ))
 306 (put 'working-status-timeout 'lisp-indent-function 3)
 307
 308 (defun working-status-call-process
 309   (timeout message donestr program &optional infile buffer display &rest args)
 310   "Display working messages while running a process.
 311 TIMEOUT is how fast to display the messages.
 312 MESSAGE is the message to show, and DONESTR is the string to add when done.
 313 CALLPROCESSARGS are the same style of args as passed to `call-process'.
 314 The are: PROGRAM, INFILE, BUFFER, DISPLAY, and ARGS.
 315 Since it actually calls `start-process', not all features will work."
 316   (working-status-timeout timeout message donestr
 317     (let ((proc (apply 'start-process "working"
 318                               (if (listp buffer) (car buffer) buffer)
 319                                      program args)))
 320       (set-process-sentinel proc 'list)
 321       (while (eq (process-status proc) 'run)
 322         (accept-process-output proc)
 323         ;; accept-process-output caused my solaris Emacs 20.3 to crash.
 324         ;; If this is unreliable for you, use the below which will work
 325         ;; in that situation.
 326         ;; (if (not (sit-for timeout)) (read-event))
 327         ))))
 328
 329 (defun working-status (&optional percent &rest args)
 330   "Called within the macro `working-status-forms', show the status.
 331 If PERCENT is nil, then calculate PERCENT from the value of `point' in
 332 the current buffer.  If it is a number or float, use it as the raw
 333 percentile.
 334 Additional ARGS are passed to fill on % elements of MESSAGE from the
 335 macro `working-status-forms'."
 336   (when (and working-message working-status-percentage-type)
 337     (let ((p (or percent
 338                  (floor (* 100.0 (/ (float (point)) (point-max)))))))
 339       (if (or (eq p t)
 340               (> (- p working-last-percent) working-percentage-step))
 341           (let* ((m1 (apply 'format working-message args))
 342                  (m2 (funcall working-status-percentage-type (length m1) p)))
 343             (working-message "%s%s" m1 m2)
 344             (setq working-last-percent p))))))
 345
 346 (defun working-dynamic-status (&optional number &rest args)
 347   "Called within the macro `working-status-forms', show the status.
 348 If NUMBER is nil, then increment a local NUMBER from 0 with each call.
 349 If it is a number or float, use it as the raw percentile.
 350 Additional ARGS are passed to fill on % elements of MESSAGE from the
 351 macro `working-status-forms'."
 352   (when (and working-message working-status-dynamic-type)
 353     (let* ((n (or number working-ref1))
 354            (m1 (apply 'format working-message args))
 355            (m2 (funcall working-status-dynamic-type (length m1) n)))
 356       (working-message "%s%s" m1 m2)
 357       (setq working-ref1 (1+ working-ref1)))))
 358
 359 ;;; Utilities
 360 ;;
 361 (defun working-message-frame-width ()
 362   "Return the width of the frame the working message will be in."
 363   (let* ((mbw (cond ((fboundp 'frame-parameter)
 364                      (frame-parameter (selected-frame) 'minibuffer))
 365                     ((fboundp 'frame-property)
 366                      (frame-property (selected-frame) 'minibuffer))))
 367          (fr (if (windowp mbw)
 368                  (window-frame mbw)
 369                default-minibuffer-frame)))
 370     (frame-width fr)))
 371
 372 ;;; Percentage display types.
 373 ;;
 374 (defun working-percent-display (length percent)
 375   "Return the percentage of the buffer that is done in a string.
 376 LENGTH is the amount of display that has been used.  PERCENT
 377 is t to display the done string, or the percentage to display."
 378   (cond ((eq percent t) (concat "... " working-donestring))
 379         ;; All the % signs because it then gets passed to message.
 380         (t (format "... %3d%%" percent))))
 381
 382 (defun working-bar-display (length percent)
 383   "Return a string with a bar-graph showing percent.
 384 LENGTH is the amount of display that has been used.  PERCENT
 385 is t to display the done string, or the percentage to display."
 386   (let ((bs (- (working-message-frame-width) length 5)))
 387     (cond ((eq percent t)
 388            (concat ": [" (make-string bs ?#) "] " working-donestring))
 389           ((< bs 0) "")
 390           (t (let ((bsl (floor (* (/ percent 100.0) bs))))
 391                (concat ": ["
 392                        (make-string bsl ?#)
 393                        (make-string (- bs bsl) ?.)
 394                        "]"))))))
 395
 396 (defun working-bar-percent-display (length percent)
 397   "Return a string with a bar-graph and percentile showing percentage.
 398 LENGTH is the amount of display that has been used.  PERCENT
 399 is t to display the done string, or the percentage to display."
 400   (let* ((ps (if (eq percent t)
 401                  (concat "... " working-donestring)
 402                (working-percent-display length percent)))
 403          (psl (+ 2 length (length ps))))
 404     (cond ((eq percent t)
 405            (concat (working-bar-display psl 100) " " ps))
 406           (t
 407            (setq working-ref1 (length ps))
 408            (concat (working-bar-display psl percent) " " ps)))))
 409
 410 (defun working-percent-bar-display (length percent)
 411   "Return a string with a percentile and bar-graph showing percentage.
 412 LENGTH is the amount of display that has been used.  PERCENT
 413 is t to display the done string, or the percentage to display."
 414   (let* ((ps (if (eq percent t)
 415                  (concat "... " working-donestring)
 416                (working-percent-display length percent)))
 417          (psl (+ 1 length (length ps))))
 418     (cond ((eq percent t)
 419            (concat ps " " (working-bar-display psl 100)))
 420           (t
 421            (setq working-ref1 (length ps))
 422            (concat ps " " (working-bar-display psl percent))))))
 423
 424 (defun working-bubble-display (length percent)
 425   "Return a string with a bubble graph indicating the precent completed.
 426 LENGTH is the amount of the display that has been used.  PERCENT
 427 is t to display the done string, or the percentage to display."
 428   (if (eq percent t)
 429       (concat " [@@@@@@@@@@@@@@@@@@@@] " working-donestring)
 430     (let ((bs " [")
 431           (bubbles [ ?. ?- ?o ?O ?@ ]))
 432       (if (> percent 5)
 433           (setq bs (concat bs (make-string (/ (floor percent) 5) ?@))))
 434       (setq bs (concat bs
 435                        (char-to-string (aref bubbles (% (floor percent) 5)))))
 436       (if (< (/ (floor percent) 5) 20)
 437           (setq bs (concat bs (make-string (- 19 (/ (floor percent) 5)) ? ))))
 438       (concat bs "]"))))
 439
 440 (defun working-bubble-percent-display (length percent)
 441   "Return a string with a percentile and bubble graph showing percentage.
 442 LENGTH is the amount of display that has been used.  PERCENT
 443 is t to display the done string, or the percentage to display."
 444   (let* ((ps (if (eq percent t)
 445                  (concat " ... " working-donestring)
 446                (working-percent-display length percent)))
 447          (psl (+ 1 length (length ps))))
 448     (cond ((eq percent t)
 449            (concat (working-bubble-display psl t)))
 450           (t
 451            (setq working-ref1 (length ps))
 452            (concat (working-bubble-display psl percent) ps)))))
 453
 454 (defun working-celeron-percent-display (length percent)
 455   "Return a string with a celeron and string showing percent.
 456 LENGTH is the amount of display that has been used.  PERCENT
 457 is t to display the done string, or the percentage to display."
 458   (prog1
 459       (cond ((eq percent t) (working-celeron-display length t))
 460             ;; All the % signs because it then gets passed to message.
 461             (t (format "%s %3d%%"
 462                        (working-celeron-display length 0)
 463                        percent)))
 464     (setq working-ref1 (1+ working-ref1))))
 465
 466 ;;; Dynamic display types.
 467 ;;
 468 (defun working-number-display (length number)
 469   "Return a string displaying the number of things that happened.
 470 LENGTH is the amount of display that has been used.  NUMBER
 471 is t to display the done string, or the number to display."
 472   (cond ((eq number t) (concat "... " working-donestring))
 473         ;; All the % signs because it then gets passed to message.
 474         (t (format "... %d" number))))
 475
 476 (defun working-text-display (length text)
 477     "Return a string displaying the name of things that happened.
 478 LENGTH is the amount of display that has been used.  TEXT
 479 is t to display the done string, or the text to display."
 480     (if (eq text t)
 481         (concat "... " working-donestring)
 482       (format "... %s" text)))
 483
 484 (defun working-spinner-display (length number)
 485   "Return a string displaying a spinner based on a number.
 486 LENGTH is the amount of display that has been used.  NUMBER
 487 is t to display the done string, or the number to display."
 488   (cond ((eq number t) (concat "... " working-donestring))
 489         ;; All the % signs because it then gets passed to message.
 490         (t (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% working-ref1 4))))))
 491
 492 (defun working-dotgrowth-display (length number)
 493   "Return a string displaying growing dots due to activity.
 494 LENGTH is the amount of display that has been used.  NUMBER
 495 is t to display the done string, or the number to display.
 496 This display happens to ignore NUMBER."
 497   (let* ((width (- (working-message-frame-width) 4 length))
 498          (num-wrap (/ working-ref1 width))
 499          (num-. (% working-ref1 width))
 500          (dots [ ?. ?, ?o ?* ?O ?@ ?# ]))
 501     (concat " (" (make-string num-. (aref dots (% num-wrap (length dots)))) ")"
 502             (if (eq number t) (concat " " working-donestring) ""))))
 503
 504 (defun working-frame-animation-display (length number frames)
 505   "Manage a simple frame-based animation for working functions.
 506 LENGTH is the number of characters left.  NUMBER is a passed in
 507 number (which happens to be ignored.).  While coders pass t into
 508 NUMBER, functions using this should convert NUMBER into a vector
 509 describing how to render the done message.
 510 Argument FRAMES are the frames used in the animation."
 511   (cond ((vectorp number)
 512          (let ((zone (- (length (aref frames 0)) (length (aref number 0))
 513                         (length (aref number 1)))))
 514            (if (< (length working-donestring) zone)
 515                (concat " " (aref number 0)
 516                        (make-string
 517                         (ceiling (/ (- (float zone)
 518                                        (length working-donestring)) 2)) ? )
 519                        working-donestring
 520                        (make-string
 521                         (floor (/ (- (float zone)
 522                                      (length working-donestring)) 2)) ? )
 523                        (aref number 1))
 524              (concat " " (aref frames (% working-ref1 (length frames)))
 525                      " " working-donestring))))
 526         (t (concat " " (aref frames (% working-ref1 (length frames)))))))
 527
 528 (defvar working-celeron-strings
 529   [ "[O     ]" "[oO    ]" "[-oO   ]" "[ -oO  ]" "[  -oO ]" "[   -oO]"
 530     "[    -O]" "[     O]" "[    Oo]" "[   Oo-]"  "[  Oo- ]" "[ Oo-  ]"
 531     "[Oo-   ]" "[O-    ]"]
 532   "Strings representing a silly celeron.")
 533
 534 (defun working-celeron-display (length number)
 535   "Return a string displaying a celeron as things happen.
 536 LENGTH is the amount of display that has been used.  NUMBER
 537 is t to display the done string, or the number to display."
 538   (cond ((eq number t)
 539          (working-frame-animation-display length [ "[" "]" ]
 540                                           working-celeron-strings))
 541         ;; All the % signs because it then gets passed to message.
 542         (t (working-frame-animation-display length number
 543                                             working-celeron-strings))))
 544
 545 (defvar working-bounce-strings
 546   [
 547    "[_         ]"
 548    "[ -        ]"
 549    "[  ~       ]"
 550    "[   -      ]"
 551    "[    _     ]"
 552    "[     -    ]"
 553    "[      ~   ]"
 554    "[       -  ]"
 555    "[        _ ]"
 556    "[         -]"
 557
 558    ]
 559   "Strings for the bounce animation.")
 560
 561 (defun working-bounce-display (length number)
 562   "Return a string displaying a celeron as things happen.
 563 LENGTH is the amount of display that has been used.  NUMBER
 564 is t to display the done string, or the number to display."
 565   (cond ((eq number t)
 566          (working-frame-animation-display length [ "[" "]" ]
 567                                           working-bounce-strings))
 568         ;; All the % signs because it then gets passed to message.
 569         (t (working-frame-animation-display length number
 570                                             working-bounce-strings))))
 571
 572 ;;; Some edebug hooks
 573 ;;
 574 (add-hook
 575  'edebug-setup-hook
 576  (lambda ()
 577    (def-edebug-spec working-status-forms (form form def-body))
 578    (def-edebug-spec working-status-timeout (form form form def-body))))
 579
 580 ;;; Example function using `working'
 581 ;;
 582 (defun working-verify-parenthesis-a ()
 583   "Verify all the parenthesis in an elisp program buffer."
 584   (interactive)
 585   (working-status-forms "Scanning" "done"
 586     (save-excursion
 587       (goto-char (point-min))
 588       (while (not (eobp))
 589         ;; Use default buffer position.
 590         (working-status)
 591         (forward-sexp 1)
 592         (sleep-for 0.05)
 593         )
 594       (working-status t))
 595     (sit-for 1)))
 596
 597 (defun working-verify-parenthesis-b ()
 598   "Verify all the parenthesis in an elisp program buffer."
 599   (interactive)
 600   (working-status-forms "Scanning" "done"
 601     (save-excursion
 602       (goto-char (point-min))
 603       (while (not (eobp))
 604         ;; Use default buffer position.
 605         (working-dynamic-status nil)
 606         (forward-sexp 1)
 607         (sleep-for 0.05)
 608         )
 609       (working-dynamic-status t))
 610     (sit-for 0)))
 611
 612 (defun working-wait-for-keypress ()
 613   "Display funny graphics while waiting for a keypress."
 614   (interactive)
 615   (working-status-timeout .1 "Working Test: Press a key" "done"
 616     (while (sit-for 10)))
 617   (when (input-pending-p)
 618     (if (fboundp 'read-event)
 619         (read-event)
 620       (read-char)))
 621   )
 622
 623 (defun working-verify-sleep ()
 624   "Display funny graphics while waiting for sleep to sleep."
 625   (interactive)
 626   (working-status-call-process .1 "Zzzzz" "Snort" "sleep" nil nil nil "2"))
 627
 628 (defun working-verify-mode-line ()
 629   "Display graphics in the mode-line for timeout."
 630   (interactive)
 631   (let ((working-use-echo-area-p nil))
 632     (message "Pres a Key")
 633     (working-status-timeout .1 "" ""
 634       (while (sit-for 10)))
 635     ))
 636
 637 (provide 'working)
 638
 639 ;;; working.el ends here