home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / appt.el < prev    next >
Encoding:
Text File  |  1990-03-21  |  20.6 KB  |  539 lines
  1. ;From ark1!nems!mimsy!dftsrv!ukma!tut.cis.ohio-state.edu!JULIET.LL.MIT.EDU!neilm Wed Dec  6 12:18:20 1989
  2. ;Article 791 of gnu.emacs:
  3. ;Path: ark1!nems!mimsy!dftsrv!ukma!tut.cis.ohio-state.edu!JULIET.LL.MIT.EDU!neilm
  4. ;>From neilm@JULIET.LL.MIT.EDU
  5. ;Newsgroups: gnu.emacs
  6. ;Subject: Appointment notification in GNU emacs
  7. ;Message-ID: <8911291444.AA02912@horatio>
  8. ;Date: 29 Nov 89 14:44:52 GMT
  9. ;Sender: daemon@tut.cis.ohio-state.edu
  10. ;Distribution: gnu
  11. ;Organization: GNUs Not Usenet
  12. ;Lines: 525
  13. ;
  14. ;
  15. ;        appt.el is an appointment notification system, to be used
  16. ;        in conjunction Edward M. Reingold's calendar.el. It
  17. ;        will notify users of pending appointments based upon their
  18. ;        diary file (see calendar.el if your not sure about a diary
  19. ;        file). The header of the file below describes what needs
  20. ;        to be in your .emacs file in order to use this.
  21. ;
  22. ;
  23. ;==========================
  24. ;Neil Mager    <neilm@juliet.ll.mit.edu>
  25. ;Office        (617) 981-4803
  26. ;Dumb Quote
  27. ;"Necessity is the mother of invention...Laziness is the mother of necessity"
  28. ;
  29. ;############################## CUT HERE ########################################
  30. ;;
  31. ;; appt.el - visable and/or audible notification of
  32. ;;           appointments from ~/diary file generated from
  33. ;;           Edward M. Reingold's calendar.el.
  34. ;;           
  35. ;; This file is distributed in the hope that it will be useful,
  36. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  37. ;; accepts responsibility to anyone for the consequences of using it
  38. ;; or for whether it serves any particular purpose or works at all,
  39. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  40. ;; License for full details.
  41. ;;
  42. ;; Everyone is granted permission to copy, modify and redistribute
  43. ;; this file, but only under the conditions described in the
  44. ;; GNU Emacs General Public License.   A copy of this license is
  45. ;; supposed to have been given to you along with GNU Emacs so you
  46. ;; can know your rights and responsibilities.  It should be in a
  47. ;; file named COPYING.  Among other things, the copyright notice
  48. ;; and this notice must be preserved on all copies.
  49. ;;
  50. ;;
  51. ;;; This file will alert the user of a pending appointment based on their
  52. ;;; diary file.
  53. ;;;
  54. ;;; ******* It is necessary to invoke 'display-time' ********
  55. ;;; *******  and 'diary' for this to work properly.  ********
  56. ;;; 
  57. ;;; A message will be displayed in the mode line of the emacs buffer
  58. ;;; and (if the user desires) the terminal will beep and display a message
  59. ;;; from the diary in the mini-buffer, or the user may select to 
  60. ;;; have a message displayed in a new buffer.
  61. ;;;
  62. ;;; The variable 'appt-message-warning-time' allows the
  63. ;;; user to specify how much notice they want before the appointment. The 
  64. ;;; variable 'appt-issue-message' specifies whether the user wants
  65. ;;; to to be notified of a pending appointment.
  66. ;;; 
  67. ;;; In order to use, the following should be in your .emacs file in addition to
  68. ;;; creating a diary file and invoking calendar:
  69. ;;;
  70. ;;;    Set some options
  71. ;;; (setq view-diary-entries-initially t)
  72. ;;; (setq issue-appointments-message t)
  73. ;;;
  74. ;;;   The following three lines are required:
  75. ;;; (display-time)
  76. ;;; (autoload 'appt-make-list "appt.el" nil t)
  77. ;;; (setq list-diary-entries-hook 
  78. ;;;     (list 'appt-make-list 'prepare-fancy-diary-buffer))
  79. ;;;
  80. ;;; 
  81. ;;;  This is an example of what can be in your diary file:
  82. ;;; Monday
  83. ;;;   9:30am Coffee break
  84. ;;;  12:00pm Lunch        
  85. ;;; 
  86. ;;; Based upon the above lines in your .emacs and diary files, 
  87. ;;; the calendar and diary will be displayed when you enter
  88. ;;; emacs and your appointments list will automatically be created.
  89. ;;; You will then be reminded at 9:20am about your coffee break
  90. ;;; and at 11:50am to go to lunch. 
  91. ;;;
  92. ;;; Use describe-function on appt-check for a description of other variables
  93. ;;; that can be used to personalize the notification system.
  94. ;;;
  95. ;;;  In order to add or delete items from todays list, use appt-add
  96. ;;;  and appt-delete.
  97. ;;;
  98. ;;;  Additionally, the appointments list is recreated automatically
  99. ;;;  at 12:01am for those who do not logout every day or are programming
  100. ;;;  late.
  101. ;;;
  102. ;;; Brief internal description - Skip this if your not interested!
  103. ;;;
  104. ;;; The function appt-check is run from the 'loadst' process which is started
  105. ;;; by invoking (display-time). A function below modifies display-time-filter 
  106. ;;; (from original time.el) to include a hook which will invoke appt-check.
  107. ;;;
  108. ;;;  NOTE: If this is included in the gnuemacs distribution, the original
  109. ;;;        time.el should be modified.
  110. ;;;
  111. ;;; The function appt-make-list creates the appointments list which appt-check
  112. ;;; reads. This is all done automatically.
  113. ;;; It is invoked from the function list-diary-entries.
  114. ;;;
  115. (defvar appt-issue-message t
  116.   "*If T, the diary buffer is checked for appointments. For an
  117. appointment warning to be made, the time must be the first thing on
  118. the line.")
  119.  
  120. (defvar appt-message-warning-time 10
  121.   "*The amount of time in minutes before the meeting that the warning
  122. begins.")
  123.  
  124. (defvar appt-audible t
  125.   "*Variable used to determine if appointment is audible.")
  126.  
  127. (defvar appt-visable t
  128.   "*Variable used to determine if appointment message should be displayed
  129. in the mini-buffer.")
  130.  
  131. (defvar appt-display-mode-line t
  132.   "*Variable used to determine if minutes to appointment and time
  133. should be displayed on the mode line.")
  134.  
  135. (defvar appt-msg-window t
  136.  "*Variable used to determine if appointment message
  137. should temporarily appear in another window.")
  138.  
  139. (defvar appt-display-duration 5
  140.   "*The number of seconds an appointment message
  141. is displayed in another window.")
  142.  
  143. (defvar appt-time-msg-list nil
  144.   "The list of appointments for today. Use appt-add and appt-delete
  145. to add and delete appointments from list. The original list is generated
  146. from the today's diary-entries-list. The number before each time/message
  147. is the time in minutes from midnight.")
  148.  
  149. (defconst max-time 1439
  150.   "11:59pm in minutes - number of minutes in a day minus 1.")
  151.  
  152. (defun appt-check ()
  153.   "Check for an appointment and update the mode line and minibuffer if
  154. desired. Note: the time must be the first thing in the line in the diary
  155. for a warning to be issued.
  156.  
  157. The format of the time can be either 24 hour or am/pm.
  158. Example: 
  159.  
  160.                02/23/89
  161.                  18:00 Dinner
  162.             
  163.               Thursday
  164.                 11:45am Lunch meeting.
  165.  
  166. The following variables control the action of the notification:
  167.  
  168. appt-issue-message
  169.         If T, the diary buffer is checked for appointments.
  170.  
  171. appt-message-warning-time
  172.        Variable used to determine if appointment message
  173.         should be displayed.
  174.  
  175. appt-audible
  176.         Variable used to determine if appointment is audible.
  177.         Default is t.
  178.  
  179. appt-visable
  180.         Variable used to determine if appointment message should be
  181.         displayed in the mini-buffer. Default is t.
  182.  
  183. appt-msg-window
  184.        Variable used to determine if appointment message
  185.        should temporarily appear in another window. Mutually exclusive
  186.        to appt-visable.
  187.  
  188. appt-display-duration
  189.       The number of seconds an appointment message
  190.       is displayed in another window.
  191.  
  192. This function is run from the loadst process for display time.
  193. Therefore, you need to have (display-time) in your .emacs file."
  194.   
  195.   (if (and appt-issue-message appt-time-msg-list)
  196.       (let ((min-to-app -1)
  197.             (new-time ""))
  198.         (save-excursion
  199.           
  200.           ;; Get the current time and convert it to minutes
  201.           ;; from midnight. ie. 12:01am = 1, midnight = 0.
  202.           
  203.           (let* ((cur-hour(string-to-int 
  204.                            (substring (current-time-string) 11 13)))
  205.                  (cur-min (string-to-int 
  206.                            (substring (current-time-string) 14 16)))
  207.                  (cur-comp-time (+ (* cur-hour 60) cur-min)))
  208.             
  209.             ;; If the time is 12:01am, we should update our 
  210.             ;; appointments to todays list.
  211.             
  212.             (if (= cur-comp-time 1)
  213.                 (let* ((tmp-list-diary-entries-hook
  214.                         list-diary-entries-hook))
  215.                   (setq list-diary-entries-hook nil)
  216.                   (setq diary-entries-list (diary))
  217.                   (setq list-diary-entries-hook
  218.                         tmp-list-diary-entries-hook)
  219.                   (appt-make-list)))
  220.             
  221.             ;; Get the first time off of the list
  222.             ;; and calculate the number of minutes until
  223.             ;; the appointment.
  224.             
  225.             (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
  226.               (setq min-to-app (- appt-comp-time cur-comp-time))
  227.  
  228.               (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
  229.                 (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  230.                 (if appt-time-msg-list
  231.                     (setq appt-comp-time (car (car (car appt-time-msg-list))))))
  232.               
  233.               ;; If we have an appointment between midnight and
  234.               ;; 'appt-message-warning-time' minutes after midnight,
  235.               ;; we must begin to issue a message before midnight.
  236.               ;; Midnight is considered 0 minutes and 11:59pm is
  237.               ;; 1439 minutes. Therefore we must recalculate the minutes
  238.               ;; to appointment variable. It is equal to the number of 
  239.               ;; minutes before midnight plus the number of 
  240.               ;; minutes after midnight our appointment is.
  241.               
  242.               (if (and (< appt-comp-time appt-message-warning-time)
  243.                        (> (+ cur-comp-time appt-message-warning-time)
  244.                           max-time))
  245.                   (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
  246.                         appt-comp-time))
  247.               
  248.               ;; issue warning if the appointment time is 
  249.               ;; within appt-message-warning time
  250.               
  251.               (if (and (<= min-to-app appt-message-warning-time)
  252.                        (>= min-to-app 0))
  253.                   (progn
  254.                     (if appt-msg-window
  255.                         (progn
  256.                           (string-match
  257.                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
  258.                            display-time-string)
  259.                           
  260.                           (setq new-time (substring display-time-string 
  261.                                                     (match-beginning 0)
  262.                                                     (match-end 0)))
  263.                           (appt-disp-window min-to-app new-time
  264.                                             (car (cdr (car
  265.                                                        appt-time-msg-list)))))
  266.                       ;;; else
  267.  
  268.                       (if appt-visable
  269.                           (message "%s" (car (cdr (car appt-time-msg-list)))))
  270.                       
  271.                       (if appt-audible
  272.                           (beep 1)))
  273.  
  274.                       (if appt-display-mode-line
  275.                           (progn
  276.                             (string-match
  277.                              "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
  278.                              display-time-string)
  279.                             
  280.                             (setq new-time (substring display-time-string 
  281.                                                       (match-beginning 0)
  282.                                                       (match-end 0)))
  283.                             (setq display-time-string
  284.                                   (concat  "App't in "
  285.                                            min-to-app " min. " new-time " "))
  286.                           
  287.                             ;; force mode line updates - from time.el
  288.                             
  289.                             (save-excursion (set-buffer (other-buffer)))
  290.                             (set-buffer-modified-p (buffer-modified-p))
  291.                             (sit-for 0)))
  292.                                                             
  293.                     (if (= min-to-app 0)
  294.                         (setq appt-time-msg-list
  295.                               (cdr appt-time-msg-list)))))))))))
  296.  
  297.  
  298. (defun appt-disp-window (min-to-app new-time appt-msg)
  299. " Displays appointment message in a 
  300. seperate buffer."
  301.   (require 'electric)
  302.   (save-window-excursion
  303.  
  304.     ;; Make sure we're not in the minibuffer
  305.     ;; before splitting the window.
  306.  
  307.     (if (= (screen-height)
  308.            (nth 3 (window-edges (selected-window))))
  309.         nil
  310.       (select-lowest-window)
  311.       (split-window))
  312.  
  313.     (let* ((this-buffer (current-buffer))
  314.            (appt-disp-buf (set-buffer (get-buffer-create "appt-buf"))))
  315.       (setq mode-line-format 
  316.             (concat "-------------------- Appointment in "
  317.                     min-to-app " minutes. " new-time " %-"))
  318.       (pop-to-buffer appt-disp-buf)
  319.       (insert-string appt-msg)
  320.       (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf))
  321.       (set-buffer-modified-p nil)
  322.       (if appt-audible
  323.           (beep 1))
  324.       (sit-for appt-display-duration)
  325.       (if appt-audible
  326.           (beep 1))
  327.       (kill-buffer appt-disp-buf))))
  328.  
  329.  
  330. (defun select-lowest-window ()
  331.   " Determines which window is the lowest one being
  332. displayed and selectes that one."
  333.   (setq lowest-window (selected-window))
  334.   (let* ((bottom-edge (car (cdr (cdr (cdr (window-edges))))))
  335.          (last-window (previous-window))
  336.          (window-search t))
  337.     (while window-search
  338.       (let* ((this-window (next-window))
  339.              (next-bottom-edge (car (cdr (cdr (cdr 
  340.                                                (window-edges this-window)))))))
  341.         (if (< bottom-edge next-bottom-edge)
  342.             (progn
  343.               (setq bottom-edge next-bottom-edge)
  344.               (setq lowest-window this-window)))
  345.  
  346.         (select-window this-window)
  347.         (if (eq last-window this-window)
  348.             (progn
  349.               (select-window lowest-window)
  350.               (setq window-search nil)))))))
  351.  
  352.  
  353. (defun appt-add (new-appt-time new-appt-msg)
  354.   "Adds an appointment to the list of appointments for the day at TIME
  355. and issue MESSAGE. The time should be in either 24 hour format or
  356. am/pm format. "
  357.  
  358.   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
  359.   (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
  360.       nil
  361.     (error "Unacceptable time-string"))
  362.   
  363.   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
  364.          (appt-time (list (appt-convert-time new-appt-time)))
  365.          (time-msg (cons appt-time (list appt-time-string))))
  366.     (setq appt-time-msg-list (append appt-time-msg-list
  367.                                      (list time-msg)))
  368.     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
  369.  
  370.  
  371. (defun appt-delete ()
  372.   "Deletes an appointment from the list of appointments."
  373.   (interactive)
  374.   (let* ((tmp-msg-list appt-time-msg-list))
  375.     (while tmp-msg-list
  376.       (let* ((element (car tmp-msg-list))
  377.              (prompt-string (concat "Delete " 
  378.                                     (prin1-to-string (car (cdr element))) 
  379.                                     " from list? "))
  380.              (test-input (y-or-n-p prompt-string)))
  381.         (setq tmp-msg-list (cdr tmp-msg-list))
  382.         (if test-input
  383.             (setq appt-time-msg-list (delq element appt-time-msg-list)))
  384.         (setq tmp-appt-msg-list nil)))
  385.     (message "")))
  386.                  
  387.  
  388. (defun appt-make-list ()
  389.   "Create the appointments list from todays diary buffer.
  390. The time must be at the beginning of a line for it to be
  391. put in the appointments list.
  392.  
  393.                02/23/89
  394.                  12:00pm lunch
  395.  
  396.                 Wednesday
  397.                   10:00am group meeting"
  398.  
  399.   (setq appt-time-msg-list nil)
  400.  
  401.   (save-excursion
  402.     (fix-time)
  403.     (if diary-entries-list
  404.  
  405.         ;; Cycle through the entry-list (diary-entries-list)
  406.         ;; looking for entries beginning with a time. If 
  407.         ;; the entry begins with a time, add it to the
  408.         ;; appt-time-msg-list. Then sort the list.
  409.         
  410.         (let ((entry-list diary-entries-list)
  411.               (new-time-string ""))
  412.           (while (and entry-list 
  413.                       (calendar-date-equal 
  414.                        (calendar-current-date) (car (car entry-list))))
  415.             (let ((time-string (substring (prin1-to-string 
  416.                                            (cdr (car entry-list))) 2 -2)))
  417.               
  418.               (while (string-match
  419.                       "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" 
  420.                       time-string)
  421.                 (let* ((appt-time-string (substring time-string
  422.                                                     (match-beginning 0)
  423.                                                     (match-end 0))))
  424.  
  425.                   (if (< (match-end 0) (length time-string))
  426.                       (setq new-time-string (substring time-string 
  427.                                                        (+ (match-end 0) 1)
  428.                                                        nil))
  429.                     (setq new-time-string ""))
  430.                   
  431.                   (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
  432.                                 time-string)
  433.                     
  434.                   (let* ((appt-time (list (appt-convert-time 
  435.                                            (substring time-string
  436.                                                       (match-beginning 0)
  437.                                                       (match-end 0)))))
  438.                          (time-msg (cons appt-time
  439.                                          (list appt-time-string))))
  440.                     (setq time-string new-time-string)
  441.                     (setq appt-time-msg-list (append appt-time-msg-list
  442.                                                      (list time-msg)))))))
  443.             (setq entry-list (cdr entry-list)))))
  444.   (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
  445.  
  446.   ;; Get the current time and convert it to minutes
  447.   ;; from midnight. ie. 12:01am = 1, midnight = 0,
  448.   ;; so that the elements in the list
  449.   ;; that are earlier than the present time can
  450.   ;; be removed.
  451.   
  452.   (let* ((cur-hour(string-to-int 
  453.                    (substring (current-time-string) 11 13)))
  454.          (cur-min (string-to-int 
  455.                    (substring (current-time-string) 14 16)))
  456.          (cur-comp-time (+ (* cur-hour 60) cur-min))
  457.          (appt-comp-time (car (car (car appt-time-msg-list)))))
  458.  
  459.     (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
  460.       (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  461.       (if appt-time-msg-list
  462.           (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))
  463.   
  464.  
  465. (defun appt-sort-list (appt-list)
  466.   " Simple sort to put the appointments list in order.
  467. Scan the list for the smallest element left in the list.
  468. Append the smallest element left into the new list, and remove
  469. it from the original list."
  470.  
  471.   (let ((order-list nil))
  472.     (while appt-list
  473.       (let* ((element (car appt-list))
  474.              (element-time (car (car element)))
  475.              (tmp-list (cdr appt-list)))
  476.         (while tmp-list
  477.           (if (< element-time (car (car (car tmp-list))))
  478.               nil
  479.             (setq element (car tmp-list))
  480.             (setq element-time (car (car element))))
  481.           (setq tmp-list (cdr tmp-list)))
  482.         (setq order-list (append order-list (list element)))
  483.         (setq appt-list (delq element appt-list))))
  484.     order-list))
  485.  
  486.  
  487. (defun appt-convert-time (time2conv)
  488.   " Convert hour:min[am/pm] format to minutes from
  489.  midnight."
  490.  
  491.   (let ((conv-time 0)
  492.         (hr 0)
  493.         (min 0))
  494.  
  495.     (string-match ":[0-9][0-9]" time2conv)
  496.     (setq min (string-to-int 
  497.                (substring time2conv 
  498.                           (+ (match-beginning 0) 1) (match-end 0))))
  499.   
  500.     (string-match "[0-9]?[0-9]:" time2conv)
  501.     (setq hr (string-to-int 
  502.               (substring time2conv 
  503.                          (match-beginning 0)
  504.                          (match-end 0))))
  505.   
  506.     ;; convert the time appointment time into 24 hour time
  507.   
  508.     (if (and (string-match  "[p][m]" time2conv) (< hr 12))
  509.         (progn
  510.           (string-match "[0-9]?[0-9]:" time2conv)
  511.           (setq hr (+ 12 hr))))
  512.   
  513.     ;; convert the actual time
  514.     ;; into minutes for comparison
  515.     ;; against the actual time.
  516.   
  517.     (setq conv-time (+ (* hr 60) min))
  518.     conv-time))
  519.  
  520.  
  521. (defvar display-time-hook nil
  522.   "* List of functions to be called when the time is updated on the 
  523. mode line.")
  524.  
  525. (setq display-time-hook 'appt-check)
  526.  
  527. (defvar display-time-filter-initialized nil)
  528.  
  529. (defun fix-time()
  530. (if display-time-filter-initialized         ;; only do this stuff once!
  531.     nil
  532.   (fset 'old-display-time-filter            ;; we're about to redefine it...
  533.         (symbol-function 'display-time-filter))
  534.   (setq display-time-filter-initialized t)
  535.   (defun display-time-filter (proc string)  ;; ...here's the revised definition
  536.     "Revised version of the original function: this version calls a hook."
  537.       (old-display-time-filter proc string)
  538.       (run-hooks 'display-time-hook))))
  539.