Mercurial > hg > xemacs-beta

comparison lisp/prim/itimer.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents 360340f9fd5f
children 8619ce7e4c50
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
43 ;; list-itimers 43 ;; list-itimers
44 ;; start-itimer 44 ;; start-itimer
45 ;; 45 ;;
46 ;; See the doc strings of these functions for more information. 46 ;; See the doc strings of these functions for more information.
47 47
48 (defvar itimer-version "1.03" 48 (defvar itimer-version "1.04"
49 "Version number of the itimer package.") 49 "Version number of the itimer package.")
50 50
51 (defvar itimer-list nil 51 (defvar itimer-list nil
52 "List of all active itimers.") 52 "List of all active itimers.")
53 53
181 (check-itimer itimer) 181 (check-itimer itimer)
182 (nth 3 itimer)) 182 (nth 3 itimer))
183 183
184 (defun itimer-is-idle (itimer) 184 (defun itimer-is-idle (itimer)
185 "Returns non-nil if ITIMER is an idle timer. 185 "Returns non-nil if ITIMER is an idle timer.
186 Normal timers eexpire after a set interval. Idle timers expire 186 Normal timers expire after a set interval. Idle timers expire
187 only after Emacs has been idle for a specific interval. ``Idle'' 187 only after Emacs has been idle for a specific interval. ``Idle''
188 means no command events within the interval." 188 means no command events within the interval."
189 (check-itimer itimer) 189 (check-itimer itimer)
190 (nth 4 itimer)) 190 (nth 4 itimer))
191 191
218 (let ((inhibit-quit t)) 218 (let ((inhibit-quit t))
219 ;; If the itimer is in the active list, and under the new 219 ;; If the itimer is in the active list, and under the new
220 ;; timeout value would expire before we would normally 220 ;; timeout value would expire before we would normally
221 ;; wakeup, wakeup now and recompute a new wakeup time. 221 ;; wakeup, wakeup now and recompute a new wakeup time.
222 (or (and (< value itimer-next-wakeup) 222 (or (and (< value itimer-next-wakeup)
223 (get-itimer (itimer-name itimer)) 223 (and (itimer-name itimer) (get-itimer (itimer-name itimer)))
224 (progn (itimer-driver-wakeup) 224 (progn (itimer-driver-wakeup)
225 (setcar (cdr itimer) value) 225 (setcar (cdr itimer) value)
226 (itimer-driver-wakeup) 226 (itimer-driver-wakeup)
227 t )) 227 t ))
228 (setcar (cdr itimer) value)) 228 (setcar (cdr itimer) value))
692 ;; itimer has expired, we must call its function. 692 ;; itimer has expired, we must call its function.
693 ;; protect our local vars from the itimer function. 693 ;; protect our local vars from the itimer function.
694 ;; allow keyboard quit to occur, but catch and report it. 694 ;; allow keyboard quit to occur, but catch and report it.
695 ;; provide the variable `current-itimer' in case the function 695 ;; provide the variable `current-itimer' in case the function
696 ;; is interested. 696 ;; is interested.
697 (condition-case condition-data 697 (unwind-protect
698 (save-match-data 698 (condition-case condition-data
699 (let* ((current-itimer itimer) 699 (save-match-data
700 (quit-flag nil) 700 (let* ((current-itimer itimer)
701 (inhibit-quit nil) 701 (quit-flag nil)
702 itimer itimers time-elapsed) 702 (inhibit-quit nil)
703 (if (itimer-uses-arguments current-itimer) 703 itimer itimers time-elapsed)
704 (apply (itimer-function current-itimer) 704 (if (itimer-uses-arguments current-itimer)
705 (itimer-function-arguments current-itimer)) 705 (apply (itimer-function current-itimer)
706 (funcall (itimer-function current-itimer))))) 706 (itimer-function-arguments current-itimer))
707 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) 707 (funcall (itimer-function current-itimer)))))
708 (prin1-to-string condition-data))) 708 (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
709 (quit (message "itimer \"%s\" quit" (itimer-name itimer)))) 709 (prin1-to-string condition-data)))
710 ;; restart the itimer if we should, otherwise delete it. 710 (quit (message "itimer \"%s\" quit" (itimer-name itimer))))
711 (if (null (itimer-restart itimer)) 711 ;; restart the itimer if we should, otherwise delete it.
712 (delete-itimer itimer) 712 (if (null (itimer-restart itimer))
713 (set-itimer-value-internal itimer (itimer-restart itimer)) 713 (delete-itimer itimer)
714 (setq next-wakeup (min next-wakeup (itimer-value itimer))))) 714 (set-itimer-value-internal itimer (itimer-restart itimer))
715 (setq next-wakeup (min next-wakeup (itimer-value itimer))))))
715 (setq itimers (cdr itimers))) 716 (setq itimers (cdr itimers)))
716 ;; if user is editing itimers, update displayed info 717 ;; if user is editing itimers, update displayed info
717 (if (eq major-mode 'itimer-edit-mode) 718 (if (eq major-mode 'itimer-edit-mode)
718 (list-itimers)) 719 (list-itimers))
719 next-wakeup )) 720 next-wakeup ))
726 (progn (message "itimer process gave odd output: %s" string) 727 (progn (message "itimer process gave odd output: %s" string)
727 ;; it may be still alive and waiting for input 728 ;; it may be still alive and waiting for input
728 (process-send-string itimer-process "3\n")) 729 (process-send-string itimer-process "3\n"))
729 ;; if there are no active itimers, return quickly. 730 ;; if there are no active itimers, return quickly.
730 (if itimer-list 731 (if itimer-list
731 (setq itimer-next-wakeup 732 (let ((wakeup nil))
732 (itimer-run-expired-timers (string-to-int string))) 733 (unwind-protect
734 (setq wakeup (itimer-run-expired-timers (string-to-int string)))
735 (and (null wakeup) (process-send-string process "1\n")))
736 (setq itimer-next-wakeup wakeup))
733 (setq itimer-next-wakeup 600)) 737 (setq itimer-next-wakeup 600))
734 ;; tell itimer-process when to wakeup again 738 ;; tell itimer-process when to wakeup again
735 (process-send-string itimer-process 739 (process-send-string itimer-process
736 (concat (int-to-string itimer-next-wakeup) 740 (concat (int-to-string itimer-next-wakeup)
737 "\n")))) 741 "\n"))))
781 itimer-timer (add-timeout itimer-short-interval 785 itimer-timer (add-timeout itimer-short-interval
782 'itimer-timer-driver nil nil)))) 786 'itimer-timer-driver nil nil))))
783 787
784 (defun itimer-timer-wakeup () 788 (defun itimer-timer-wakeup ()
785 (let ((inhibit-quit t)) 789 (let ((inhibit-quit t))
786 (cond ((fboundp 'cancel-timer) 790 (cond ;((fboundp 'cancel-timer)
787 (cancel-timer itimer-timer)) 791 ; (cancel-timer itimer-timer))
788 ((fboundp 'disable-timeout) 792 ((fboundp 'disable-timeout)
789 (disable-timeout itimer-timer))) 793 (disable-timeout itimer-timer)))
790 (setq itimer-timer (add-timeout itimer-short-interval 794 (setq itimer-timer (add-timeout itimer-short-interval
791 'itimer-timer-driver nil nil)))) 795 'itimer-timer-driver nil nil))))
792 796
816 ;; individual timer function to be aborted, so the user can 820 ;; individual timer function to be aborted, so the user can
817 ;; escape a feral timer function. 821 ;; escape a feral timer function.
818 (let* ((inhibit-quit t) 822 (let* ((inhibit-quit t)
819 (now (current-time)) 823 (now (current-time))
820 (elapsed (itimer-time-difference now itimer-timer-last-wakeup)) 824 (elapsed (itimer-time-difference now itimer-timer-last-wakeup))
821 sleep) 825 (sleep nil))
822 (setq itimer-timer-last-wakeup now 826 (setq itimer-timer-last-wakeup now)
823 sleep (itimer-run-expired-timers elapsed) 827 (unwind-protect
824 itimer-next-wakeup sleep 828 (setq sleep (itimer-run-expired-timers elapsed))
829 (and (null sleep) (add-timeout 1 'itimer-timer-driver nil nil)))
830 (setq itimer-next-wakeup sleep
825 itimer-timer (add-timeout sleep 'itimer-timer-driver nil nil)))) 831 itimer-timer (add-timeout sleep 'itimer-timer-driver nil nil))))
826 832
827 (defun itimer-driver-start () 833 (defun itimer-driver-start ()
828 (if (fboundp 'add-timeout) 834 (if (fboundp 'add-timeout)
829 (itimer-timer-start) 835 (itimer-timer-start)