home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / msgs-check.el < prev    next >
Encoding:
Text File  |  1991-03-30  |  7.2 KB  |  191 lines
  1. ; Path: utkcs2!emory!samsung!usc!rutgers!mcnc!xanth!talos!kjones
  2. ; >From: elves@magic-tree.keebler.com (Those Keebler Elves)
  3. ; Newsgroups: comp.emacs
  4. ; Subject: support for Berkeley msgs(1) under GNU Emacs
  5. ; Date: 25 Jul 90 18:42:28 GMT
  6. ; 
  7. ; The following file of Lisp code provides just enough support for
  8. ; the Berkeley msgs(1) bulletin system so that you can use existing
  9. ; mail tools under Emacs to read them.  Installation instructions
  10. ; are in the comments at the top of the file.
  11. ; 
  12. ; Once the package is installed, "M-x msgs-check", or (msgs-check)
  13. ; msgs(1) system, and display an indicator in the mode line if any
  14. ; such messages are found.
  15. ; 
  16. ; "M-x msgs-gobble-messages", or (setq msgs-auto-gobble-messages t)
  17. ; found in the msgs(1) system to the folder specified by the
  18. ; variable msgs-folder (default ~/MSGS).  ~/.msgsrc is updated to
  19. ; mark these messages as read.
  20. ; 
  21. ; The spool checker is driver by an interval timer, so my timer
  22. ; package must be installed for msgs-check to work.  The rest of
  23. ; the package can live without timers.  You can get the timer
  24. ; package from the OSU Emacs-Lisp archives or directly from me.
  25. ; 
  26. ; kyle jones   <kjones@talos.pm.com>   ...!uunet!talos!kjones
  27. ; 
  28. ; ----------------------------------------------------------------------
  29. ;;; Check for and/or gather new messages in the msgs(1) bulletin system.
  30. ;;; Copyright (C) 1990 Kyle E. Jones
  31. ;;;
  32. ;;; This program is free software; you can redistribute it and/or modify
  33. ;;; it under the terms of the GNU General Public License as published by
  34. ;;; the Free Software Foundation; either version 1, or (at your option)
  35. ;;; any later version.
  36. ;;;
  37. ;;; This program is distributed in the hope that it will be useful,
  38. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  39. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  40. ;;; GNU General Public License for more details.
  41. ;;;
  42. ;;; A copy of the GNU General Public License can be obtained from this
  43. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  44. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  45. ;;; 02139, USA.
  46. ;;;
  47. ;;; Send bug reports to kyle@cs.odu.edu.
  48.  
  49. ;; Save this package in a file named msgschk.el in a directory
  50. ;; that Emacs will search for Lisp libraries.  Byte-compile it.
  51. ;;
  52. ;; This package is autoloadable.  Use
  53. ;;    (autoload 'msgs-check "msgschk" nil t)
  54. ;;    (autoload 'msgs-gobble-messages "msgschk" nil t)
  55. ;; in your .emacs file.
  56. ;;
  57. ;; Once the package is installed, "M-x msgs-check", or
  58. ;; (msgs-check) from the .emacs will cause Emacs to check for new
  59. ;; messages in the msgs(1) system, and display an indicator in
  60. ;; the mode line if any such messages are found.
  61. ;;
  62. ;; "M-x msgs-gobble-messages", or (setq msgs-auto-gobble-messages t)
  63. ;; in the .emacs will cause emacs to append any new messages found
  64. ;; to the folder specified by the variable msgs-folder (default
  65. ;; ~/MSGS).  ~/.msgsrc is updated to mark these messages as read.
  66.  
  67. (require 'timer)
  68.  
  69. (provide 'msgs-check)
  70.  
  71. (defvar msgs-directory "/usr/msgs"
  72.   "*Directory where msgs(1) messages are spooled.")
  73.  
  74. (defvar msgs-rc "~/.msgsrc"
  75.   "*File that keeps track of what msgs(1) message you've read.")
  76.  
  77. (defvar msgs-check-interval 300
  78.   "*Number of seconds between checks for new messages.")
  79.  
  80. (defvar msgs-folder "~/MSGS"
  81.   "*Folder where message gathered from the msgs(1) system are stored.")
  82.  
  83. (defvar msgs-auto-gobble-messages nil
  84.   "*Non-nil value causes the msgs checker to automatically append any new
  85. messages posted to the msgs(1) bulletin board into the folder specified
  86. by the variable msgs-folder.  Your .msgsrc is updated to indicate
  87. that these new messages have been read.")
  88.  
  89. (defvar msgs-unread-messages-string nil)
  90.  
  91. (defun msgs-check ()
  92.   "Periodically check for new messages (see msgs(1)).
  93. If there are unread message, an indicator will apear in the mode
  94. line.  The variable msgs-check-interval controls how often the
  95. spool is checked for new messages."
  96.   (interactive)
  97.   ;; sanity check msgs-check-interval
  98.   (if (< msgs-check-interval 5)
  99.       (setq msgs-check-interval 5))
  100.   ;; install the display string
  101.   (or global-mode-string
  102.       (setq global-mode-string '("")))
  103.   (or (memq 'msgs-unread-messages-string global-mode-string)
  104.       (setq global-mode-string
  105.         (append global-mode-string '(msgs-unread-messages-string))))
  106.   ;; if the timer already exists, destroy it.
  107.   (and (get-timer "msgs-check") (delete-timer "msgs-check"))
  108.   ;; schedule the check function to be run immediately,
  109.   ;; then every msgs-check-interval seconds thereafter.
  110.   (start-timer "msgs-check" 'msgs-check-function 1 msgs-check-interval))
  111.  
  112. (defun msgs-check-function ()
  113.   (setq msgs-unread-messages-string nil)
  114.   (cond ((msgs-unread-messages-p)
  115.      (setq msgs-unread-messages-string " [new msgs] ")
  116.      (and msgs-auto-gobble-messages msgs-folder (msgs-gobble-messages)))
  117.     ((and msgs-folder (file-exists-p msgs-folder)
  118.           (not (zerop (nth 7 (file-attributes msgs-folder)))))
  119.      (setq msgs-unread-messages-string " [msgs] ")))
  120.   ;; Force mode line updates
  121.   (save-excursion (set-buffer (other-buffer)))
  122.   (set-buffer-modified-p (buffer-modified-p))
  123.   (sit-for 0))
  124.  
  125. (defun msgs-unread-messages-p ()
  126.   (let (last-msg-read min-msg max-msg)
  127.     (save-excursion
  128.       (set-buffer (get-buffer-create " *msgs check*"))
  129.       (erase-buffer)
  130.       (condition-case ()
  131.       (insert-file-contents msgs-rc)
  132.     (error (insert "0\n")))
  133.       (goto-char (point-max))
  134.       (condition-case ()
  135.       (insert-file-contents (concat msgs-directory "/bounds"))
  136.     (error (insert "0 0\n")))
  137.       (goto-char (point-min))
  138.       (setq last-msg-read (1- (msgs-read-number))
  139.         min-msg (msgs-read-number)
  140.         max-msg (msgs-read-number)))
  141.     (< last-msg-read max-msg)))
  142.  
  143. (defun msgs-gobble-messages ()
  144.   "Append any new messsages from msgs(1) to the file specifed by msgs-folder.
  145. This file should be considered a spool area.  If you're using VM or RMAIL
  146. to read mail under Emacs, it is advised that you not visit this file directly,
  147. Rather, you should set the appropriate mailer variables so that
  148. you mail reader will look for messages in this file in addition
  149. to your normal system mailbox."
  150.   (interactive)
  151.   (let (last-msg-read min-msg max-msg)
  152.     (save-excursion
  153.       (set-buffer (get-buffer-create " *msgs check*"))
  154.       (erase-buffer)
  155.       (condition-case ()
  156.       (insert-file-contents msgs-rc)
  157.     (error (insert "0\n")))
  158.       (goto-char (point-max))
  159.       (condition-case ()
  160.       (insert-file-contents (concat msgs-directory "/bounds"))
  161.     (error (insert "0 0\n")))
  162.       (goto-char (point-min))
  163.       (setq last-msg-read (1- (msgs-read-number))
  164.         min-msg (msgs-read-number)
  165.         max-msg (msgs-read-number))
  166.       (if (< last-msg-read max-msg)
  167.       (progn
  168.         (erase-buffer)
  169.         (goto-char (point-max))
  170.         (while (<= last-msg-read max-msg)
  171.           (setq last-msg-read (1+ last-msg-read))
  172.           (condition-case ()
  173.           (progn
  174.             (insert-file-contents
  175.              (concat msgs-directory "/" (int-to-string last-msg-read)))
  176.             (goto-char (point-max))
  177.             (insert "\n"))
  178.         (file-error nil)))
  179.         (write-region (point-min) (point-max) msgs-folder t 0)
  180.         (let (start)
  181.           (setq start (point))
  182.           (insert (int-to-string last-msg-read) "\n")
  183.           (write-region start (point) msgs-rc nil 0)))))))
  184.  
  185. (defun msgs-read-number ()
  186.   (condition-case ()
  187.       (read (current-buffer))
  188.     (error 0)))
  189.  
  190.  
  191.