home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / finger.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  3.7 KB  |  117 lines
  1. ;From utkcs2!emory!swrinde!cs.utexas.edu!mailrus!accuvax.nwu.edu!anaxagoras!krulwich Thu Jun 21 11:32:30 EDT 1990
  2. ;Article 4478 of comp.emacs:
  3. ;Path: utkcs2!emory!swrinde!cs.utexas.edu!mailrus!accuvax.nwu.edu!anaxagoras!krulwich
  4. ;>From: krulwich@ils.nwu.edu (Bruce Krulwich)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: Bug fix for FINGER.EL
  7. ;Message-ID: <923@anaxagoras.ils.nwu.edu>
  8. ;Date: 21 Jun 90 14:59:43 GMT
  9. ;Sender: news@anaxagoras.ils.nwu.edu
  10. ;Reply-To: krulwich@ils.nwu.edu (Bruce Krulwich)
  11. ;Organization: Institute for the Learning Sciences, Northwestern University, Evanston, IL 60201
  12. ;Lines: 101
  13. ;
  14. ;The following version of FINGER.EL fixes a bug that was reported to me.  The
  15. ;only change is in GET-ALIAS, but I've included the whole thing for anyone who
  16. ;missed the previous post.
  17.  
  18. ;;;  --------------------------------------------------------------------------
  19.  
  20. ;;;  FINGER: Finger a user
  21.  
  22.  
  23. ;;; Modifyied by Bruce Krulwich, krulwich@ils.nwu.edu
  24. ;;;  6/21/90: Read in .MAILRC if necessary
  25. ;;;  5/29/90: Lookup names in mail-aliases also
  26. ;;;  11/7/89: lookup names in /ETC/ALIASES.  Done by GET-ALIAS
  27. ;;;  10/27/89: allow multiple host indirections
  28.  
  29. ;;; Original by:
  30. ;;;Bill Trost, Computer Research Labs, Tektronix
  31. ;;;trost@crl.labs.tek.com / tektronix!crl.labs!trost
  32. ;;;(trost@reed.bitnet, but probably tektronix!reed!trost)
  33.  
  34.  
  35. (defun finger (who)
  36.   "Display info about users"
  37.   (interactive "sFinger: ")
  38.   (if (and (not (string-match "@" who))
  39.        (not (string-equal who "")))
  40.       (let ((new-who (get-alias who)))
  41.     (cond ((null new-who))
  42.           ((string-match "," new-who)
  43.            (error "%s is an alias for a group: %s" who new-who))
  44.           (t ; else
  45.            (message "Treating %s as an alias for %s" who new-who)
  46.            (setq who new-who)))))
  47.   (let ((host who)
  48.     (at-index 0) )
  49.     (if (not (string-match "@" host))
  50.     (setq host "localhost"
  51.           at-index (length who))
  52.     (while (string-match "@" host)
  53.       (setq host (substring host (1+ (match-beginning 0)))
  54.         at-index (+ 1 at-index (match-beginning 0))) )
  55.     (setq at-index (1- at-index)) )
  56.     (let ((user (substring who 0 at-index)))
  57.       ;(message "FINGER: user is <%s>, host is <%s>" user host)
  58.       (with-output-to-temp-buffer "*finger*"
  59.     (let ((stream (open-network-stream
  60.                "finger" "*finger*"
  61.                host
  62.                "finger")))
  63.       (set-process-filter stream 'finger-process-filter)
  64.       (set-process-sentinel stream 'ignore)
  65.       (process-send-string stream
  66.                    (concat user "\n"))
  67.       )))))
  68.  
  69.  
  70. (defun finger-process-filter (process s)
  71.   (save-excursion
  72.     (set-buffer (process-buffer process))
  73.     (while (< 0 (length s))
  74.       (let ((l (string-match "\r" s)))
  75.     (insert (substring s 0 l))
  76.     (setq s (cond (l (substring s (1+ l)))
  77.               (t "")))))))
  78.  
  79.  
  80. (defun get-alias (name)
  81.   (interactive "sName: ")
  82.                     ; First gather info
  83.   (save-excursion
  84.     (let ((search-result nil) (alias nil))
  85.       (if (file-exists-p "/etc/aliases")
  86.       (progn (find-file-read-only "/etc/aliases")
  87.          (goto-char (point-min))
  88.          (setq search-result 
  89.                (re-search-forward (concat "\n" name) (point-max) t)) ))
  90.       (if (eq mail-aliases t)
  91.       (progn (setq mail-aliases nil) (build-mail-aliases)))
  92.                     ; Then get the alias
  93.       (cond ((setq alias (assoc name mail-aliases))
  94.          (setq alias (cdr alias)) )
  95.         ((not (null search-result))
  96.          (search-forward ":")
  97.          (let ((name-start (point)))
  98.            (end-of-line)
  99.            (setq alias (buffer-substring name-start (point)))
  100.            ))
  101.         (t;; else
  102.          (if (interactive-p)
  103.          (error "Don't know about user %s" name)
  104.            nil))
  105.         )
  106.                     ; Then clean up
  107.       (bury-buffer (get-buffer "aliases"))
  108.                     ; Finally return result
  109.       (if (interactive-p)
  110.       (message "%s is aliased to \"%s\"" name alias)
  111.     alias))))
  112.  
  113.  
  114.  
  115.  
  116.  
  117.