XEmacs / lisp / itimer.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
;;; Interval timers for GNU Emacs
;;; Copyright (C) 1988, 1991, 1993, 1997, 1998 Kyle E. Jones
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to kyle_jones@wonderworks.com

(provide 'itimer)

;; `itimer' feature means Emacs-Lisp programmers get:
;;    itimerp
;;    itimer-live-p
;;    itimer-value
;;    itimer-restart
;;    itimer-function
;;    itimer-uses-arguments
;;    itimer-function-arguments
;;    set-itimer-value
;;    set-itimer-restart
;;    set-itimer-function
;;    set-itimer-uses-arguments
;;    set-itimer-function-arguments
;;    get-itimer
;;    start-itimer
;;    read-itimer
;;    delete-itimer
;;    activate-itimer
;;
;; Interactive users get these commands:
;;    edit-itimers
;;    list-itimers
;;    start-itimer
;;
;; See the doc strings of these functions for more information.

(defvar itimer-version "1.07"
  "Version number of the itimer package.")

(defvar itimer-list nil
  "List of all active itimers.")

(defvar itimer-process nil
  "Process that drives all itimers, if a subprocess is being used.")

(defvar itimer-timer nil
  "Emacs internal timer that drives the itimer system, if a subprocess
is not being used to drive the system.")

(defvar itimer-timer-last-wakeup nil
  "The time the timer driver function last ran.")

(defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1)
  "Interval used for scheduling an event a very short time in the future.
Used internally to make the scheduler wake up early.
Unit is seconds.")

;; This value is maintained internally; it does not determine
;; itimer granularity.  Itimer granularity is 1 second if your
;; Emacs doesn't support floats or your system doesn't have a
;; clock with microsecond granularity.  Otherwise granularity is
;; to the microsecond, although you can't possibly get timers to be
;; executed with this kind of accuracy in practice.  There will
;; be delays due to system and Emacs internal activity that delay
;; dealing with synchronous events and process output.
(defvar itimer-next-wakeup itimer-short-interval
  "Itimer process will wakeup to service running itimers within this
many seconds.")

(defvar itimer-edit-map nil
  "Keymap used when in Itimer Edit mode.")

(if itimer-edit-map
    ()
  (setq itimer-edit-map (make-sparse-keymap))
  (define-key itimer-edit-map "s" 'itimer-edit-set-field)
  (define-key itimer-edit-map "d" 'itimer-edit-delete-itimer)
  (define-key itimer-edit-map "q" 'itimer-edit-quit)
  (define-key itimer-edit-map "\t" 'itimer-edit-next-field)
  (define-key itimer-edit-map " " 'next-line)
  (define-key itimer-edit-map "n" 'next-line)
  (define-key itimer-edit-map "p" 'previous-line)
  (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field)
  (define-key itimer-edit-map "x" 'start-itimer)
  (define-key itimer-edit-map "?" 'itimer-edit-help))

(defvar itimer-inside-driver nil)

(defvar itimer-edit-start-marker nil)

;; macros must come first... or byte-compile'd code will throw back its
;; head and scream.

(defmacro itimer-decrement (variable)
  (list 'setq variable (list '1- variable)))

(defmacro itimer-increment (variable)
  (list 'setq variable (list '1+ variable)))

(defmacro itimer-signum (n)
  (list 'if (list '> n 0) 1
    (list 'if (list 'zerop n) 0 -1)))

;; Itimer access functions should behave as if they were subrs.  These
;; macros are used to check the arguments to the itimer functions and
;; signal errors appropriately if the arguments are not valid.

(defmacro check-itimer (var)
  "If VAR is not bound to an itimer, signal wrong-type-argument.
This is a macro."
  (list 'setq var
	(list 'if (list 'itimerp var) var
	      (list 'signal ''wrong-type-argument
		    (list 'list ''itimerp var)))))

(defmacro check-itimer-coerce-string (var)
  "If VAR is not bound to a string, look up the itimer that it names and
bind VAR to it.  Otherwise, if VAR is not bound to an itimer, signal
wrong-type-argument.  This is a macro."
  (list 'setq var
	(list 'cond
	      (list (list 'itimerp var) var)
	      (list (list 'stringp var) (list 'get-itimer var))
	      (list t (list 'signal ''wrong-type-argument
			    (list 'list ''string-or-itimer-p var))))))

(defmacro check-nonnegative-number (var)
  "If VAR is not bound to a number, signal wrong-type-argument.
If VAR is not bound to a positive number, signal args-out-of-range.
This is a macro."
  (list 'setq var
	(list 'if (list 'not (list 'numberp var))
	      (list 'signal ''wrong-type-argument
		    (list 'list ''natnump var))
	      (list 'if (list '< var 0)
		    (list 'signal ''args-out-of-range (list 'list var))
		    var))))

(defmacro check-string (var)
  "If VAR is not bound to a string, signal wrong-type-argument.
This is a macro."
  (list 'setq var
	(list 'if (list 'stringp var) var
	      (list 'signal ''wrong-type-argument
		    (list 'list ''stringp var)))))

;; Functions to access and modify itimer attributes.

(defun itimerp (obj)
  "Return t if OBJ is an itimer."
  (and (consp obj) (eq (length obj) 8)))

(defun itimer-live-p (obj)
  "Return non-nil if OBJ is an itimer and is active.
``Active'' means Emacs will run it when it expires.
`activate-timer' must be called on an itimer to make it active.
Itimers started with `start-itimer' are automatically active."
  (and (itimerp obj) (memq obj itimer-list)))

(defun itimer-name (itimer)
  "Return the name of ITIMER."
  (check-itimer itimer)
  (car itimer))

(defun itimer-value (itimer)
  "Return the number of seconds until ITIMER expires."
  (check-itimer itimer)
  (nth 1 itimer))

(defun itimer-restart (itimer)
  "Return the value to which ITIMER will be set at restart.
Return nil if this itimer doesn't restart."
  (check-itimer itimer)
  (nth 2 itimer))

(defun itimer-function (itimer)
  "Return the function of ITIMER.
This function is called each time ITIMER expires."
  (check-itimer itimer)
  (nth 3 itimer))

(defun itimer-is-idle (itimer)
  "Return non-nil if ITIMER is an idle timer.
Normal timers expire after a set interval.  Idle timers expire
only after Emacs has been idle for a specific interval.
``Idle'' means no command events occur within the interval."
  (check-itimer itimer)
  (nth 4 itimer))

(defun itimer-uses-arguments (itimer)
  "Return non-nil if the function of ITIMER will be called with arguments.
ITIMER's function is called with the arguments each time ITIMER expires.
The arguments themselves are retrievable with `itimer-function-arguments'."
  (check-itimer itimer)
  (nth 5 itimer))

(defun itimer-function-arguments (itimer)
  "Return the function arguments of ITIMER as a list.
ITIMER's function is called with these argument each time ITIMER expires."
  (check-itimer itimer)
  (nth 6 itimer))

(defun itimer-recorded-run-time (itimer)
  (check-itimer itimer)
  (nth 7 itimer))

(defun set-itimer-value (itimer value)
  "Set the timeout value of ITIMER to be VALUE.
Itimer will expire in this many seconds.
If your version of Emacs supports floating point numbers then
VALUE can be a floating point number.  Otherwise it
must be an integer.
Returns VALUE."
  (check-itimer itimer)
  (check-nonnegative-number value)
  (let ((inhibit-quit t))
    ;; If the itimer is in the active list, and under the new
    ;; timeout value would expire before we would normally
    ;; wakeup, wakeup now and recompute a new wakeup time.
    (or (and (< value itimer-next-wakeup)
	     (and (itimer-name itimer) (get-itimer (itimer-name itimer)))
	     (progn (itimer-driver-wakeup)
		    (setcar (cdr itimer) value)
		    (itimer-driver-wakeup)
		    t ))
	(setcar (cdr itimer) value))
    value))

;; Same as set-itimer-value but does not wakeup the driver.
;; Only should be used by the drivers when processing expired timers.
(defun set-itimer-value-internal (itimer value)
  (check-itimer itimer)
  (check-nonnegative-number value)
  (setcar (cdr itimer) value))

(defun set-itimer-restart (itimer restart)
  "Set the restart value of ITIMER to be RESTART.
If RESTART is nil, ITIMER will not restart when it expires.
If your version of Emacs supports floating point numbers then
RESTART can be a floating point number.  Otherwise it
must be an integer.
Returns RESTART."
  (check-itimer itimer)
  (if restart (check-nonnegative-number restart))
  (setcar (cdr (cdr itimer)) restart))

(defun set-itimer-function (itimer function)
  "Set the function of ITIMER to be FUNCTION.
FUNCTION will be called when itimer expires.
Returns FUNCTION."
  (check-itimer itimer)
  (setcar (nthcdr 3 itimer) function))

(defun set-itimer-is-idle (itimer flag)
  "Set flag that says whether ITIMER is an idle timer.
If FLAG is non-nil, then ITIMER will be considered an idle timer.
Returns FLAG."
  (check-itimer itimer)
  (setcar (nthcdr 4 itimer) flag))

(defun set-itimer-uses-arguments (itimer flag)
  "Set flag that says whether the function of ITIMER is called with arguments.
If FLAG is non-nil, then the function will be called with one argument,
otherwise the function will be called with no arguments.
Returns FLAG."
  (check-itimer itimer)
  (setcar (nthcdr 5 itimer) flag))

(defun set-itimer-function-arguments (itimer &optional arguments)
  "Set the function arguments of ITIMER to be ARGUMENTS.
The function of ITIMER will be called with ARGUMENTS when itimer expires.
Returns ARGUMENTS."
  (check-itimer itimer)
  (setcar (nthcdr 6 itimer) arguments))

(defun set-itimer-recorded-run-time (itimer time)
  (check-itimer itimer)
  (setcar (nthcdr 7 itimer) time))

(defun get-itimer (name)
  "Return itimer named NAME, or nil if there is none."
  (check-string name)
  (assoc name itimer-list))

(defun read-itimer (prompt &optional initial-input)
  "Read the name of an itimer from the minibuffer and return the itimer
associated with that name.  The user is prompted with PROMPT.
Optional second arg INITIAL-INPUT non-nil is inserted into the
minibuffer as initial user input."
  (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input)))

(defun delete-itimer (itimer)
  "Delete ITIMER.  ITIMER may be an itimer or the name of one."
  (check-itimer-coerce-string itimer)
  (setq itimer-list (delq itimer itimer-list)))

(defun start-itimer (name function value &optional restart
		     is-idle with-args &rest function-arguments)
  "Start an itimer.
Arguments are
  NAME, FUNCTION, VALUE &optional RESTART, IS-IDLE, WITH-ARGS, &rest FUNCTION-ARGUMENTS.
NAME is an identifier for the itimer.  It must be a string.  If an itimer
  already exists with this name, NAME will be modified slightly to make
  it unique.
FUNCTION should be a function (or symbol naming one).  It
  will be called each time the itimer expires with arguments of
  FUNCTION-ARGUMENTS.  The function can access the itimer that
  invoked it through the variable `current-itimer'.  If WITH-ARGS
  is nil then FUNCTION is called with no arguments.  This is for
  backward compatibility with older versions of the itimer
  package which always called FUNCTION with no arguments.
VALUE is the number of seconds until this itimer expires.
  If your version of Emacs supports floating point numbers then
  VALUE can be a floating point number.  Otherwise it
  must be an integer.
Optional fourth arg RESTART non-nil means that this itimer should be
  restarted automatically after its function is called.  Normally an itimer
  is deleted at expiration after its function has returned.
  If non-nil, RESTART should be a number indicating the value at which
  the itimer should be set at restart time.
Optional fifth arg IS-IDLE specifies if this is an idle timer.
  Normal timers expire after a set interval.  Idle timers expire
  only after Emacs has been idle for specific interval.
  ``Idle'' means no command events occur within the interval.
Returns the newly created itimer."
  (interactive
   (list (completing-read "Start itimer: " itimer-list)
	 (read (completing-read "Itimer function: " obarray 'fboundp))
	 (let (value)
	   (while (or (not (numberp value)) (< value 0))
	     (setq value (read-from-minibuffer "Itimer value: " nil nil t)))
	   value)
	 (let ((restart t))
	   (while (and restart (or (not (numberp restart)) (< restart 0)))
	     (setq restart (read-from-minibuffer "Itimer restart: "
						 nil nil t)))
	   restart)
	 ;; hard to imagine the user specifying these interactively
	 nil
	 nil ))
  (check-string name)
  (check-nonnegative-number value)
  (if restart (check-nonnegative-number restart))
  ;; Make proposed itimer name unique if it's not already.
  (let ((oname name)
	(num 2))
    (while (get-itimer name)
      (setq name (format "%s<%d>" oname num))
      (itimer-increment num)))
  (activate-itimer (list name value restart function is-idle
			 with-args function-arguments (list 0 0 0)))
  (car itimer-list))

(defun make-itimer ()
  "Create an unactivated itimer.
The itimer will not begin running until activated with `activate-itimer'.
Set the itimer's expire interval with `set-itimer-value'.
Set the itimer's function interval with `set-itimer-function'.
Once this is done, the timer can be activated."
  (list nil 0 nil 'ignore nil nil nil (list 0 0 0)))

(defun activate-itimer (itimer)
  "Activate ITIMER, which was previously created with `make-itimer'.
ITIMER will be added to the global list of running itimers,
its FUNCTION will be called when it expires, and so on."
  (check-itimer itimer)
  (if (memq itimer itimer-list)
      (error "itimer already activated"))
  (if (not (numberp (itimer-value itimer)))
      (error "itimer timeout value not a number: %s" (itimer-value itimer)))
  (if (<= (itimer-value itimer) 0)
      (error "itimer timeout value not positive: %s" (itimer-value itimer)))
  ;; If there's no itimer driver/process, start one now.
  ;; Otherwise wake up the itimer driver so that seconds slept before
  ;; the new itimer is created won't be counted against it.
  (if (or itimer-process itimer-timer)
      (itimer-driver-wakeup)
    (itimer-driver-start))
  ;; Roll a unique name for the timer if it doesn't have a name
  ;; already.
  (if (not (stringp (car itimer)))
      (let ((name "itimer-0")
	    (oname "itimer-")
	    (num 1))
	(while (get-itimer name)
	  (setq name (format "%s<%d>" oname num))
	  (itimer-increment num))
	(setcar itimer name))
    ;; signal an error if the timer's name matches an already
    ;; activated timer.
    (if (get-itimer (itimer-name itimer))
	(error "itimer named \"%s\" already existing and activated"
	       (itimer-name itimer))))
  (let ((inhibit-quit t))
    ;; add the itimer to the global list
    (setq itimer-list (cons itimer itimer-list))
    ;; If the itimer process is scheduled to wake up too late for
    ;; the itimer we wake it up to calculate a correct wakeup
    ;; value giving consideration to the newly added itimer.
    (if (< (itimer-value itimer) itimer-next-wakeup)
	(itimer-driver-wakeup))))

;; User level functions to list and modify existing itimers.
;; Itimer Edit major mode, and the editing commands thereof.

(defun list-itimers ()
  "Pop up a buffer containing a list of all itimers.
The major mode of the buffer is Itimer Edit mode.  This major mode provides
commands to manipulate itimers; see the documentation for
`itimer-edit-mode' for more information."
  (interactive)
  (let* ((buf (get-buffer-create "*Itimer List*"))
	 (opoint (point))
	 (standard-output buf)
	 (itimers (reverse itimer-list)))
    (set-buffer buf)
    (itimer-edit-mode)
    (setq buffer-read-only nil)
    (erase-buffer)
    (insert
"Name                  Value   Restart   Function            Idle   Arguments"
"\n"
"----                  -----   -------   --------            ----   --------")
    (if (null itimer-edit-start-marker)
	(setq itimer-edit-start-marker (point)))
    (while itimers
      (newline 1)
      (prin1 (itimer-name (car itimers)))
      (tab-to-tab-stop)
      (insert (itimer-truncate-string
	       (format "%5.5s" (itimer-value (car itimers))) 5))
      (tab-to-tab-stop)
      (insert (itimer-truncate-string
	       (format "%5.5s" (itimer-restart (car itimers))) 5))
      (tab-to-tab-stop)
      (insert (itimer-truncate-string
	       (format "%.19s" (itimer-function (car itimers))) 19))
      (tab-to-tab-stop)
      (if (itimer-is-idle (car itimers))
	  (insert "yes")
	(insert "no"))
      (tab-to-tab-stop)
      (if (itimer-uses-arguments (car itimers))
	  (prin1 (itimer-function-arguments (car itimers)))
	(prin1 'NONE))
      (setq itimers (cdr itimers)))
    ;; restore point
    (goto-char opoint)
    (if (< (point) itimer-edit-start-marker)
	(goto-char itimer-edit-start-marker))
    (setq buffer-read-only t)
    (display-buffer buf)))

(defun edit-itimers ()
  "Display a list of all itimers and select it for editing.
The major mode of the buffer containing the listing is Itimer Edit mode.
This major mode provides commands to manipulate itimers; see the documentation
for `itimer-edit-mode' for more information."
  (interactive)
  ;; since user is editing, make sure displayed data is reasonably up-to-date
  (if (or itimer-process itimer-timer)
      (itimer-driver-wakeup))
  (list-itimers)
  (select-window (get-buffer-window "*Itimer List*"))
  (goto-char itimer-edit-start-marker)
  (if itimer-list
      (progn
	(forward-sexp 2)
	(backward-sexp)))
  (message "type q to quit, ? for help"))

;; no point in making this interactive.
(defun itimer-edit-mode ()
  "Major mode for manipulating itimers.
Attributes of running itimers are changed by moving the cursor to the
desired field and typing `s' to set that field.  The field will then be
set to the value read from the minibuffer.

Commands:
TAB    move forward a field
DEL    move backward a field
s      set a field
d      delete the selected itimer
x      start a new itimer
?      help"
  (kill-all-local-variables)
  (make-local-variable 'tab-stop-list)
  (setq major-mode 'itimer-edit-mode
	mode-name "Itimer Edit"
	truncate-lines t
	tab-stop-list '(22 32 40 60 67))
  (abbrev-mode 0)
  (auto-fill-mode 0)
  (buffer-flush-undo (current-buffer))
  (use-local-map itimer-edit-map)
  (set-syntax-table emacs-lisp-mode-syntax-table))

(put 'itimer-edit-mode 'mode-class 'special)

(defun itimer-edit-help ()
  "Help function for Itimer Edit."
  (interactive)
  (if (eq last-command 'itimer-edit-help)
      (describe-mode)
    (message "TAB, DEL select fields, (s)et field, (d)elete itimer   (type ? for more help)")))

(defun itimer-edit-quit ()
  "End Itimer Edit."
  (interactive)
  (bury-buffer (current-buffer))
  (if (one-window-p t)
      (switch-to-buffer (other-buffer (current-buffer)))
    (delete-window)))

(defun itimer-edit-set-field ()
  (interactive)
  ;; First two lines in list buffer are headers.
  ;; Cry out against the luser who attempts to change a field there.
  (if (<= (point) itimer-edit-start-marker)
      (error ""))
  ;; field-value must be initialized to be something other than a
  ;; number, symbol, or list.
  (let (itimer field (field-value ""))
    (setq itimer (save-excursion
		  ;; read the name of the itimer from the beginning of
		  ;; the current line.
		  (beginning-of-line)
		  (get-itimer (read (current-buffer))))
	  field (save-excursion
		  (itimer-edit-beginning-of-field)
		  (let ((opoint (point))
			(n 0))
		    ;; count the number of sexprs until we reach the cursor
		    ;; and use this info to determine which field the user
		    ;; wants to modify.
		    (beginning-of-line)
		    (while (and (>= opoint (point)) (< n 6))
		      (forward-sexp 2)
		      (backward-sexp)
		      (itimer-increment n))
		    (cond ((eq n 1) (error "Cannot change itimer name."))
			  ((eq n 2) 'value)
			  ((eq n 3) 'restart)
			  ((eq n 4) 'function)
			  ((eq n 5) 'is-idle)
			  (t 'function-argument)))))
    (cond ((eq field 'value)
	   (let ((prompt "Set itimer value: "))
	     (while (not (natnump field-value))
	       (setq field-value (read-from-minibuffer prompt nil nil t)))))
	  ((eq field 'restart)
	   (let ((prompt "Set itimer restart: "))
	     (while (and field-value (not (natnump field-value)))
	       (setq field-value (read-from-minibuffer prompt nil nil t)))))
	  ((eq field 'function)
	   (let ((prompt "Set itimer function: "))
	     (while (not (or (and (symbolp field-value) (fboundp field-value))
			     (and (consp field-value)
				  (memq (car field-value) '(lambda macro)))))
	       (setq field-value
		     (read (completing-read prompt obarray 'fboundp nil))))))
	  ((eq field 'is-idle)
	   (setq field-value (not (itimer-is-idle itimer))))
	  ((eq field 'function-argument)
	   (let ((prompt "Set itimer function argument: "))
	     (setq field-value (read-expression prompt))
	     (cond ((not (listp field-value))
		    (setq field-value (list field-value))))
	     (if (null field-value)
		 (set-itimer-uses-arguments itimer nil)
	       (set-itimer-uses-arguments itimer t)))))
    ;; set the itimer field
    (funcall (intern (concat "set-itimer-" (symbol-name field)))
	     itimer field-value)
    ;; move to beginning of field to be changed
    (itimer-edit-beginning-of-field)
    ;; modify the list buffer to reflect the change.
    (let (buffer-read-only kill-ring)
      (kill-sexp 1)
      (kill-region (point) (progn (skip-chars-forward " \t") (point)))
      (prin1 field-value (current-buffer))
      (if (not (eolp))
	  (tab-to-tab-stop))
      (backward-sexp))))

(defun itimer-edit-delete-itimer ()
  (interactive)
  ;; First two lines in list buffer are headers.
  ;; Cry out against the luser who attempts to change a field there.
  (if (<= (point) itimer-edit-start-marker)
      (error ""))
  (delete-itimer
   (read-itimer "Delete itimer: "
	       (save-excursion (beginning-of-line) (read (current-buffer)))))
  ;; update list information
  (list-itimers))

(defun itimer-edit-next-field (count)
  (interactive "p")
  (itimer-edit-beginning-of-field)
  (cond ((> (itimer-signum count) 0)
	 (while (not (zerop count))
	   (forward-sexp)
	   ;; wrap from eob to itimer-edit-start-marker
	   (if (eobp)
	       (progn
		 (goto-char itimer-edit-start-marker)
		 (forward-sexp)))
	   (forward-sexp)
	   (backward-sexp)
	   ;; treat fields at beginning of line as if they weren't there.
	   (if (bolp)
	       (progn
		 (forward-sexp 2)
		 (backward-sexp)))
	   (itimer-decrement count)))
	((< (itimer-signum count) 0)
	 (while (not (zerop count))
	   (backward-sexp)
	   ;; treat fields at beginning of line as if they weren't there.
	   (if (bolp)
	       (backward-sexp))
	   ;; wrap from itimer-edit-start-marker to field at eob.
	   (if (<= (point) itimer-edit-start-marker)
	       (progn
		 (goto-char (point-max))
		 (backward-sexp)))
	   (itimer-increment count)))))

(defun itimer-edit-previous-field (count)
  (interactive "p")
  (itimer-edit-next-field (- count)))

(defun itimer-edit-beginning-of-field ()
  (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point)))
	(back (save-excursion (backward-sexp) (point))))
    (cond ((eq forw-back back) (backward-sexp))
	  ((eq forw-back (point)) t)
	  (t (backward-sexp)))))

(defun itimer-truncate-string (str len)
  (if (<= (length str) len)
      str
    (substring str 0 len)))

;; internals of the itimer implementation.

(defun itimer-run-expired-timers (time-elapsed)
  (let ((itimers (copy-sequence itimer-list))
	(itimer)
	(next-wakeup 600)
	(idle-time)
	(last-event-time)
	(recorded-run-time)
	;; process filters can be hit by stray C-g's from the user,
	;; so we must protect this stuff appropriately.
	;; Quit's are allowed from within itimer functions, but we
	;; catch them and print a message.
	(inhibit-quit t))
    (setq next-wakeup 600)
    (cond ((and (boundp 'last-command-event-time)
		(consp 'last-command-event-time))
	   (setq last-event-time last-command-event-time
		 idle-time (itimer-time-difference (current-time)
						   last-event-time)))
	  ((and (boundp 'last-input-time) (consp last-input-time))
	   (setq last-event-time (list (car last-input-time)
				       (cdr last-input-time)
				       0)
		 idle-time (itimer-time-difference (current-time)
						   last-event-time)))
	  ;; no way to do this under FSF Emacs yet.
	  (t (setq last-event-time '(0 0 0)
		   idle-time 0)))
    (while itimers
      (setq itimer (car itimers))
      (if (itimer-is-idle itimer)
	  (setq recorded-run-time (itimer-recorded-run-time itimer))
	(set-itimer-value-internal itimer (max 0 (- (itimer-value itimer)
						    time-elapsed))))
      (if (if (itimer-is-idle itimer)
	      (or (> (itimer-time-difference recorded-run-time
					     last-event-time)
		     0)
		  (< idle-time (itimer-value itimer)))
	    (> (itimer-value itimer) 0))
	  (setq next-wakeup
		(if (itimer-is-idle itimer)
		    (if (< idle-time (itimer-value itimer))
			(min next-wakeup (- (itimer-value itimer) idle-time))
		      (min next-wakeup (itimer-value itimer)))
		  (min next-wakeup (itimer-value itimer))))
	(and (itimer-is-idle itimer)
	     (set-itimer-recorded-run-time itimer (current-time)))
	;; itimer has expired, we must call its function.
	;; protect our local vars from the itimer function.
	;; allow keyboard quit to occur, but catch and report it.
	;; provide the variable `current-itimer' in case the function
	;; is interested.
	(unwind-protect
	    (condition-case condition-data
		(save-match-data
		  (let* ((current-itimer itimer)
			 (quit-flag nil)
			 (inhibit-quit nil)
			 ;; for FSF Emacs timer.el emulation under XEmacs.
			 ;; eldoc expect this to be done, apparently.
			 (this-command nil)
			 itimer itimers time-elapsed)
		    (if (itimer-uses-arguments current-itimer)
			(apply (itimer-function current-itimer)
			       (itimer-function-arguments current-itimer))
		      (funcall (itimer-function current-itimer)))))
	      (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer)
			      (prin1-to-string condition-data)))
	      (quit (message "itimer \"%s\" quit" (itimer-name itimer))))
	  ;; restart the itimer if we should, otherwise delete it.
	  (if (null (itimer-restart itimer))
	      (delete-itimer itimer)
	    (set-itimer-value-internal itimer (itimer-restart itimer))
	    (setq next-wakeup (min next-wakeup (itimer-value itimer))))))
      (setq itimers (cdr itimers)))
    ;; make another sweep through the list to catch any timers
    ;; that might have been added by timer functions above.
    (setq itimers itimer-list)
    (while itimers
      (setq next-wakeup (min next-wakeup (itimer-value (car itimers)))
	    itimers (cdr itimers)))
    ;; if user is viewing the timer list, update displayed info.
    (let ((b (get-buffer "*Itimer List*")))
      (if (and b (get-buffer-window b))
	  (save-excursion
	    (list-itimers))))
    next-wakeup ))

(defun itimer-process-filter (process string)
  ;; If the itimer process dies and generates output while doing
  ;; so, we may be called before the process-sentinel.  Sanity
  ;; check the output just in case...
  (if (not (string-match "^[0-9]" string))
      (progn (message "itimer process gave odd output: %s" string)
	     ;; it may be still alive and waiting for input
	     (process-send-string itimer-process "3\n"))
    ;; if there are no active itimers, return quickly.
    (if itimer-list
	(let ((wakeup nil))
	  (unwind-protect
	      (setq wakeup (itimer-run-expired-timers (string-to-int string)))
	    (and (null wakeup) (process-send-string process "1\n")))
	  (setq itimer-next-wakeup wakeup))
      (setq itimer-next-wakeup 600))
    ;; tell itimer-process when to wakeup again
    (process-send-string itimer-process
			 (concat (int-to-string itimer-next-wakeup)
				 "\n"))))

(defun itimer-process-sentinel (process message)
  (let ((inhibit-quit t))
    (if (eq (process-status process) 'stop)
	(continue-process process)
      ;; not stopped, so it must have died.
      ;; cleanup first...
      (delete-process process)
      (setq itimer-process nil)
      ;; now, if there are any active itimers then we need to immediately
      ;; start another itimer process, otherwise we can wait until the next
      ;; start-itimer call, which will start one automatically.
      (if (null itimer-list)
	  ()
	;; there may have been an error message in the echo area;
	;; give the user at least a little time to read it.
	(sit-for 2)
	(message "itimer process %s... respawning." (substring message 0 -1))
	(itimer-process-start)))))

(defun itimer-process-start ()
  (let ((inhibit-quit t)
	(process-connection-type nil))
    (setq itimer-process (start-process "itimer" nil "itimer"))
    (process-kill-without-query itimer-process)
    (set-process-filter itimer-process 'itimer-process-filter)
    (set-process-sentinel itimer-process 'itimer-process-sentinel)
    ;; Tell itimer process to wake up quickly, so that a correct
    ;; wakeup time can be computed.  Zero loses because of
    ;; underlying itimer implementations that use 0 to mean
    ;; `disable the itimer'.
    (setq itimer-next-wakeup itimer-short-interval)
    (process-send-string itimer-process
			 (format "%s\n" itimer-next-wakeup))))

(defun itimer-process-wakeup ()
  (interrupt-process itimer-process)
  (accept-process-output))

(defun itimer-timer-start ()
  (let ((inhibit-quit t))
    (setq itimer-next-wakeup itimer-short-interval
	  itimer-timer-last-wakeup (current-time)
	  itimer-timer (add-timeout itimer-short-interval
				    'itimer-timer-driver nil nil))))

(defun itimer-disable-timeout (timeout)
  ;; Disgusting hack, but necessary because there is no other way
  ;; to remove a timer that has a restart value from while that
  ;; timer's function is being run.  (FSF Emacs only.)
  (if (vectorp timeout)
      (aset timeout 4 nil))
  (disable-timeout timeout))

(defun itimer-timer-wakeup ()
  (let ((inhibit-quit t))
    (itimer-disable-timeout itimer-timer)
    (setq itimer-timer (add-timeout itimer-short-interval
				    'itimer-timer-driver nil 5))))

(defun itimer-time-difference (t1 t2)
  (let (usecs secs 65536-secs carry)
    (setq usecs (- (nth 2 t1) (nth 2 t2)))
    (if (< usecs 0)
	(setq carry 1
	      usecs (+ usecs 1000000))
      (setq carry 0))
    (setq secs (- (nth 1 t1) (nth 1 t2) carry))
    (if (< secs 0)
	 (setq carry 1
	       secs (+ secs 65536))
      (setq carry 0))
    (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry))
    ;; loses for interval larger than the maximum signed Lisp integer.
    ;; can't really be helped.
    (+ (* 65536-secs 65536)
       secs
       (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000)))))

(defun itimer-timer-driver (&rest ignored)
  ;; inhibit quit because if the user quits at an inopportune
  ;; time, the timer process won't be launched again and the
  ;; system stops working.  itimer-run-expired-timers allows
  ;; individual timer function to be aborted, so the user can
  ;; escape a feral timer function.
  (if (not itimer-inside-driver)
      (let* ((inhibit-quit t)
	     (itimer-inside-driver t)
	     (now (current-time))
	     (elapsed (itimer-time-difference now itimer-timer-last-wakeup))
	     (sleep nil))
	(setq itimer-timer-last-wakeup now
	      sleep (itimer-run-expired-timers elapsed))
	(itimer-disable-timeout itimer-timer)
	(setq itimer-next-wakeup sleep
	      itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5)))))

(defun itimer-driver-start ()
  (if (fboundp 'add-timeout)
      (itimer-timer-start)
    (itimer-process-start)))

(defun itimer-driver-wakeup ()
  (if (fboundp 'add-timeout)
      (itimer-timer-wakeup)
    (itimer-process-wakeup)))
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.