home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / vm / info / 241 next >
Encoding:
Text File  |  1992-07-20  |  4.7 KB  |  148 lines

  1. Newsgroups: gnu.emacs.vm.info
  2. Sender: info-vm-request@uunet.uu.net
  3. Date: Tue, 21 Jul 92 05:01:41 MDT
  4. From: jerry@math.ep.utexas.edu (Jerry)
  5. Message-ID: <9207211101.AA12647@banach.math.ep.utexas.edu>
  6. Subject: vm-finger.el
  7. Path: sparky!uunet!wendy-fate.uu.net!info-vm
  8. Lines: 138
  9.  
  10. Enjoy.  -Jerry
  11.  
  12.                              Jerry Graves
  13.                           UTEP Math Sysadmin
  14.                        jerry@math.ep.utexas.edu
  15.  
  16. ;; ---------------- 8< ---- Cut Here ---- 8< ----------------
  17. ;;; vm-finger.el
  18. ;;;  finger a user in vm
  19.  
  20. (define-key vm-mode-map "i" 'vm-finger-message-author)
  21. ;; i = "I spy?"  Hell, choose your own binding.
  22.  
  23. ;; if you're in the habit of deleting the folder and leaving the summary
  24. ;; then you deserve the resulting error
  25. ;; Kyle could write this much better...  -Jerry
  26.  
  27. (defun vm-finger-message-author ()
  28.   "Run finger on the current author's address as given in message.
  29. May fail for a number of reasons:
  30.  host down, host unknown, connection refused, connection timed out, etc."
  31.   (interactive)
  32.   (vm-select-folder-buffer)
  33.   (let ((whotofinger
  34.      (string-remove-chars '(32 9 10 13 40 41)
  35.               (vm-su-from (car vm-message-pointer)))))
  36.     (finger whotofinger)))
  37.  
  38. ;; got this off the net -Jerry
  39. ;; (who wrote this? I'm sorry, can't attribute everyone!)
  40.  
  41. (defun string-remove-chars (list-of-chars a-string)
  42.   "Function: Removes the characters in LIST-OF-CHARS from A-STRING"
  43.   (cond ((zerop (length a-string)) a-string)
  44.     (t
  45.      (if (memq (string-to-char a-string) list-of-chars)
  46.          (string-remove-chars list-of-chars (substring a-string 1))
  47.        ;;;ELSE:
  48.        (concat 
  49.         (substring a-string 0 1)
  50.         (string-remove-chars
  51.          list-of-chars
  52.          (substring a-string 1)))))))
  53.  
  54. ;;; finger.el Original by:
  55. ;;;Bill Trost, Computer Research Labs, Tektronix
  56. ;;;trost@crl.labs.tek.com / tektronix!crl.labs!trost
  57. ;;;
  58. ;;; Modifyied by Bruce Krulwich, krulwich@ils.nwu.edu
  59. ;;;  6/21/90: Read in .MAILRC if necessary
  60. ;;;  5/29/90: Lookup names in mail-aliases also
  61. ;;;  11/7/89: lookup names in /ETC/ALIASES.  Done by GET-ALIAS
  62. ;;;  10/27/89: allow multiple host indirections
  63. ;;;
  64. ;;; Modified by Jerry (jerry@math.ep.utexas.edu)
  65. ;;;  ??/??/92: took out /etc/aliases lookup; don't use
  66. ;;;           it and don't like "file is read only" message
  67. ;;;           don't have time to improve it (Jamie?)
  68.  
  69. (defun finger (who)
  70.   "Display info about users"
  71.   (interactive "sFinger: ")
  72.   (if (and (not (string-match "@" who))
  73.        (not (string-equal who "")))
  74.       (let ((new-who (get-alias who)))
  75.     (cond ((null new-who))
  76.           ((string-match "," new-who)
  77.            (error "%s is an alias for a group: %s" who new-who))
  78.           (t ; else
  79.            (message "Treating %s as an alias for %s" who new-who)
  80.            (setq who new-who)))))
  81.   (let ((host who)
  82.     (at-index 0) )
  83.     (if (not (string-match "@" host))
  84.     (setq host "localhost"
  85.           at-index (length who))
  86.     (while (string-match "@" host)
  87.       (setq host (substring host (1+ (match-beginning 0)))
  88.         at-index (+ 1 at-index (match-beginning 0))) )
  89.     (setq at-index (1- at-index)) )
  90.     (let ((user (substring who 0 at-index)))
  91.       ;(message "FINGER: user is <%s>, host is <%s>" user host)
  92.       (with-output-to-temp-buffer "*finger*"
  93.     (let ((stream (open-network-stream
  94.                "finger" "*finger*"
  95.                host
  96.                "finger")))
  97.       (set-process-filter stream 'finger-process-filter)
  98.       (set-process-sentinel stream 'ignore)
  99.       (process-send-string stream
  100.                    (concat user "\n"))
  101.       )))))
  102.  
  103.  
  104. (defun finger-process-filter (process s)
  105.   (save-excursion
  106.     (set-buffer (process-buffer process))
  107.     (while (< 0 (length s))
  108.       (let ((l (string-match "\r" s)))
  109.     (insert (substring s 0 l))
  110.     (setq s (cond (l (substring s (1+ l)))
  111.               (t "")))))))
  112.  
  113.  
  114. ;;; I'm sure Jamie (jwz@lucid.com) has done this _much_ better
  115. ;; Hey, I'll install mail-abbrevs.el someday...
  116. (defun get-alias (name)
  117.   (interactive "sName: ")
  118.                     ; First gather info
  119.   (save-excursion
  120.     (let ((search-result nil) (alias nil))
  121. ;;;(if (file-exists-p "/etc/aliases")
  122. ;;;  (progn (find-file-read-only "/etc/aliases")
  123. ;;; (goto-char (point-min))
  124. ;;;(setq search-result
  125. ;;;     (re-search-forward (concat "\n" name) (point-max) t)) ))
  126.       (if (eq mail-aliases t)
  127.       (progn (setq mail-aliases nil) (build-mail-aliases)))
  128.                     ; Then get the alias
  129.       (cond ((setq alias (assoc name mail-aliases))
  130.          (setq alias (cdr alias)) )
  131.         ((not (null search-result))
  132.          (search-forward ":")
  133.          (let ((name-start (point)))
  134.            (end-of-line)
  135.            (setq alias (buffer-substring name-start (point)))
  136.            ))
  137.         (t;; else
  138.          (if (interactive-p)
  139.          (error "Don't know about user %s" name)
  140.            nil))
  141.         )
  142.                     ; Then clean up
  143.       (bury-buffer (get-buffer "aliases"))
  144.                     ; Finally return result
  145.       (if (interactive-p)
  146.       (message "%s is aliased to \"%s\"" name alias)
  147.     alias))))
  148.