semantic / working.el

Diff from to

working.el

 ;;; working --- Display a "working" message in the minibuffer.
 
-;;;  Copyright (C) 1998, 1999, 2000, 2001  Eric M. Ludlam
+;;;  Copyright (C) 1998, 1999, 2000, 2001, 2002  Eric M. Ludlam
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 1.4
   :group 'lisp
   )
 
-;;; Compatibility
-(cond ((fboundp 'run-with-timer)
-       (defalias 'working-run-with-timer 'run-with-timer)
-       (defalias 'working-cancel-timer 'cancel-timer)
-       )
-      ;;Add compatibility here
-      (t 
-       ;; This gets the message out but has no timers.
-       (defun working-run-with-timer (&rest foo) (message working-message))
-       (defun working-cancel-timer (&rest foo) (message "%s%s"
-							working-message
-							working-donestring)))
-      )
-
 ;;; User configurable variables
 ;;
 (defcustom working-status-percentage-type 'working-bar-percent-display
 Dynamic working types occur when the program does not know how long
 it will take ahead of time.  Functions provided in `working' are:
   `working-number-display'
+  `working-text-display'
   `working-spinner-display'
   `working-dotgrowth-display'
   `working-celeron-display'
   `working-bounce-display'"
   :group 'working
   :type '(choice (const working-number-display)
+                 (const working-text-display)
 		 (const working-spinner-display)
 		 (const working-dotgrowth-display)
 		 (const working-celeron-display)
   :group 'working'
   :type 'number)
 
+;;; Mode line hacks
+;;
+;; When the user doesn't want messages in the minibuffer, hack the mode
+;; line of the current buffer.
+(if (featurep 'xemacs)
+    (defalias 'working-mode-line-update 'redraw-modeline)
+  (defalias 'working-mode-line-update 'force-mode-line-update))
+
+(defvar working-mode-line-message nil
+  "Message used by working when showing status in the mode line.")
+
+(if (boundp 'global-mode-string)
+    (progn
+      ;; If this variable exists, use it to push the working message into
+      ;; an interesting part of the mode line.
+      (if (null global-mode-string)
+	  (setq global-mode-string (list "")))
+      (setq global-mode-string
+	    (append global-mode-string '(working-mode-line-message))))
+  ;; Else, use minor mode trickery to get a reliable way of doing the
+  ;; same thing across many versions of Emacs.
+  (setq minor-mode-alist (cons
+			  '(working-mode-line-message working-mode-line-message)
+			  minor-mode-alist))
+  )
+
+(defvar working-use-echo-area-p t
+  "*Non-nil use the echo area to display working messages.")
+
 ;;; Variables used in stages
 ;;
 (defvar working-message nil
 
 ;;; Programmer functions
 ;;
+(eval-when-compile
+  (or (fboundp 'noninteractive)
+      ;; Silence the Emacs byte compiler
+      (defun noninteractive nil))
+  (or (boundp 'noninteractive)
+      ;; Silence the XEmacs byte compiler
+      (defvar noninteractive))
+  )
+
 (defun working-message-emacs (&rest args)
-  "Print but no log a one-line message at the bottom of the screen.
+  "Print but don't log a one-line message at the bottom of the screen.
 See the function `message' for details on ARGS."
-  (let ((message-log-max nil)) ;; No logging
-    (apply 'message args)))
+  (or noninteractive
+      (let ((message-log-max nil)) ;; No logging
+        (apply 'message args))))
 
 (defun working-message-xemacs (&rest args)
-  "Print but no log a one-line message at the bottom of the screen.
+  "Print but don't log a one-line message at the bottom of the screen.
 See the function `message' for details on ARGS."
-  (let ((log-message-filter-function #'ignore)) ;; No logging
-    (apply 'message args)))
+  (or (noninteractive)
+      (let ((log-message-filter-function #'ignore)) ;; No logging
+        (apply 'message args))))
 
 (eval-and-compile
-  (defalias 'working-message
+  (defalias 'working-message-echo
     (if (boundp 'log-message-filter-function)
 	'working-message-xemacs
       'working-message-emacs))
+  (defalias 'working-current-message
+    (if (fboundp 'current-message)
+        'current-message
+      'ignore))
   )
 
+(defun working-message (&rest args)
+  "Display a message using `working-message-echo' or in mode line.
+See the function `message' for details on ARGS."
+  (if working-use-echo-area-p
+      (apply 'working-message-echo args)
+    (when (not working-mode-line-message)
+      ;; If we start out nil, put stuff in to show we are up to
+      (setq working-mode-line-message "Working...")
+      (working-mode-line-update)
+      (sit-for 0)
+      )))
+
+;;; Compatibility
+(cond ((fboundp 'run-with-timer)
+       (defalias 'working-run-with-timer 'run-with-timer)
+       (defalias 'working-cancel-timer 'cancel-timer)
+       )
+      ;;Add compatibility here
+      (t 
+       ;; This gets the message out but has no timers.
+       (defun working-run-with-timer (&rest foo)
+         (working-message working-message))
+       (defun working-cancel-timer (&rest foo)
+         (working-message "%s%s"
+                          working-message
+                          working-donestring)))
+      )
+
 (defmacro working-status-forms (message donestr &rest forms)
   "Contain a block of code during which a working status is shown.
 MESSAGE is the message string to use and DONESTR is the completed text
 to use when the functions `working-status' is called from FORMS."
-  `(let ((working-message ,message)
-	 (working-donestring ,donestr)
-	 (working-ref1 0)
-	 (working-last-percent 0))
-     ,@forms))
+  (let ((current-message (make-symbol "working-current-message")))
+    `(let ((,current-message (working-current-message))
+           (working-message ,message)
+           (working-donestring ,donestr)
+           (working-ref1 0)
+           (working-last-percent 0))
+       (unwind-protect
+           (progn ,@forms)
+         (setq working-mode-line-message nil)
+         (if working-use-echo-area-p
+             (message ,current-message)
+           (working-mode-line-update)
+           (sit-for 0))))
+    ))
 (put 'working-status-forms 'lisp-indent-function 2)
 
 (defmacro working-status-timeout (timeout message donestr &rest forms)
 TIMEOUT is the length of time to wait between message updates.
 MESSAGE is the message string to use and DONESTR is the completed text
 to use when the functions `working-status' is called from FORMS."
-  `(let* ((working-message ,message)
-	  (working-donestring ,donestr)
-	  (working-ref1 0)
-	  (time ,timeout)
-	  (working-timer
-	   (working-run-with-timer time time 'working-dynamic-status)))
-     (unwind-protect
-	 (progn ,@forms)
-       (working-cancel-timer working-timer))
-     (working-dynamic-status t)))
+  (let ((current-message (make-symbol "working-current-message")))
+    `(let* ((,current-message (working-current-message))
+            (working-message ,message)
+            (working-donestring ,donestr)
+            (working-ref1 0)
+            (time ,timeout)
+            (working-timer
+             (working-run-with-timer time time 'working-dynamic-status)))
+       (unwind-protect
+           (progn ,@forms)
+         (working-cancel-timer working-timer)
+         (working-dynamic-status t)
+         (setq working-mode-line-message nil)
+         (if working-use-echo-area-p
+             (message ,current-message)
+           (working-mode-line-update)
+           (sit-for 0))))
+    ))
 (put 'working-status-timeout 'lisp-indent-function 3)
 
 (defun working-status-call-process
 			             program args)))
       (set-process-sentinel proc 'list)
       (while (eq (process-status proc) 'run)
-	;; This caused my solaris Emacs 20.3 to crash.
-	;; (accept-process-output proc)
-	(sit-for timeout)))))
+	(accept-process-output proc)
+	;; accept-process-output caused my solaris Emacs 20.3 to crash.
+	;; If this is unreliable for you, use the below which will work
+	;; in that situation.
+	;; (if (not (sit-for timeout)) (read-event))
+	))))
 
 (defun working-status (&optional percent &rest args)
   "Called within the macro `working-status-forms', show the status.
 ;;; Dynamic display types.
 ;;
 (defun working-number-display (length number)
-  "Return a string display the number of things that happened.
+  "Return a string displaying the number of things that happened.
 LENGTH is the amount of display that has been used.  NUMBER
 is t to display the done string, or the number to display."
   (cond ((eq number t) (concat "... " working-donestring))
 	;; All the % signs because it then gets passed to message.
 	(t (format "... %d" number))))
 
+(defun working-text-display (length text)
+    "Return a string displaying the name of things that happened.
+LENGTH is the amount of display that has been used.  TEXT
+is t to display the done string, or the text to display."
+    (if (eq text t)
+        (concat "... " working-donestring)
+      (format "... %s" text)))
+
 (defun working-spinner-display (length number)
   "Return a string displaying a spinner based on a number.
 LENGTH is the amount of display that has been used.  NUMBER
   (interactive)
   (working-status-call-process .1 "Zzzzz" "Snort" "sleep" nil nil nil "5"))
 
+(defun working-verify-mode-line ()
+  "Display graphics in the mode-line for timeout."
+  (interactive)
+  (let ((working-use-echo-area-p nil))
+    (message "Pres a Key")
+    (working-status-timeout .1 "" ""
+      (while (sit-for 10)))
+    ))
+
 (provide 'working)
 
 ;;; working.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.