home *** CD-ROM | disk | FTP | other *** search
- Newsgroups: gnu.emacs.vm.info
- Sender: info-vm-request@uunet.uu.net
- Date: Tue, 21 Jul 92 05:01:41 MDT
- From: jerry@math.ep.utexas.edu (Jerry)
- Message-ID: <9207211101.AA12647@banach.math.ep.utexas.edu>
- Subject: vm-finger.el
- Path: sparky!uunet!wendy-fate.uu.net!info-vm
- Lines: 138
-
- Enjoy. -Jerry
-
- Jerry Graves
- UTEP Math Sysadmin
- jerry@math.ep.utexas.edu
-
- ;; ---------------- 8< ---- Cut Here ---- 8< ----------------
- ;;; vm-finger.el
- ;;; finger a user in vm
-
- (define-key vm-mode-map "i" 'vm-finger-message-author)
- ;; i = "I spy?" Hell, choose your own binding.
-
- ;; if you're in the habit of deleting the folder and leaving the summary
- ;; then you deserve the resulting error
- ;; Kyle could write this much better... -Jerry
-
- (defun vm-finger-message-author ()
- "Run finger on the current author's address as given in message.
- May fail for a number of reasons:
- host down, host unknown, connection refused, connection timed out, etc."
- (interactive)
- (vm-select-folder-buffer)
- (let ((whotofinger
- (string-remove-chars '(32 9 10 13 40 41)
- (vm-su-from (car vm-message-pointer)))))
- (finger whotofinger)))
-
- ;; got this off the net -Jerry
- ;; (who wrote this? I'm sorry, can't attribute everyone!)
-
- (defun string-remove-chars (list-of-chars a-string)
- "Function: Removes the characters in LIST-OF-CHARS from A-STRING"
- (cond ((zerop (length a-string)) a-string)
- (t
- (if (memq (string-to-char a-string) list-of-chars)
- (string-remove-chars list-of-chars (substring a-string 1))
- ;;;ELSE:
- (concat
- (substring a-string 0 1)
- (string-remove-chars
- list-of-chars
- (substring a-string 1)))))))
-
- ;;; finger.el Original by:
- ;;;Bill Trost, Computer Research Labs, Tektronix
- ;;;trost@crl.labs.tek.com / tektronix!crl.labs!trost
- ;;;
- ;;; Modifyied by Bruce Krulwich, krulwich@ils.nwu.edu
- ;;; 6/21/90: Read in .MAILRC if necessary
- ;;; 5/29/90: Lookup names in mail-aliases also
- ;;; 11/7/89: lookup names in /ETC/ALIASES. Done by GET-ALIAS
- ;;; 10/27/89: allow multiple host indirections
- ;;;
- ;;; Modified by Jerry (jerry@math.ep.utexas.edu)
- ;;; ??/??/92: took out /etc/aliases lookup; don't use
- ;;; it and don't like "file is read only" message
- ;;; don't have time to improve it (Jamie?)
-
- (defun finger (who)
- "Display info about users"
- (interactive "sFinger: ")
- (if (and (not (string-match "@" who))
- (not (string-equal who "")))
- (let ((new-who (get-alias who)))
- (cond ((null new-who))
- ((string-match "," new-who)
- (error "%s is an alias for a group: %s" who new-who))
- (t ; else
- (message "Treating %s as an alias for %s" who new-who)
- (setq who new-who)))))
- (let ((host who)
- (at-index 0) )
- (if (not (string-match "@" host))
- (setq host "localhost"
- at-index (length who))
- (while (string-match "@" host)
- (setq host (substring host (1+ (match-beginning 0)))
- at-index (+ 1 at-index (match-beginning 0))) )
- (setq at-index (1- at-index)) )
- (let ((user (substring who 0 at-index)))
- ;(message "FINGER: user is <%s>, host is <%s>" user host)
- (with-output-to-temp-buffer "*finger*"
- (let ((stream (open-network-stream
- "finger" "*finger*"
- host
- "finger")))
- (set-process-filter stream 'finger-process-filter)
- (set-process-sentinel stream 'ignore)
- (process-send-string stream
- (concat user "\n"))
- )))))
-
-
- (defun finger-process-filter (process s)
- (save-excursion
- (set-buffer (process-buffer process))
- (while (< 0 (length s))
- (let ((l (string-match "\r" s)))
- (insert (substring s 0 l))
- (setq s (cond (l (substring s (1+ l)))
- (t "")))))))
-
-
- ;;; I'm sure Jamie (jwz@lucid.com) has done this _much_ better
- ;; Hey, I'll install mail-abbrevs.el someday...
- (defun get-alias (name)
- (interactive "sName: ")
- ; First gather info
- (save-excursion
- (let ((search-result nil) (alias nil))
- ;;;(if (file-exists-p "/etc/aliases")
- ;;; (progn (find-file-read-only "/etc/aliases")
- ;;; (goto-char (point-min))
- ;;;(setq search-result
- ;;; (re-search-forward (concat "\n" name) (point-max) t)) ))
- (if (eq mail-aliases t)
- (progn (setq mail-aliases nil) (build-mail-aliases)))
- ; Then get the alias
- (cond ((setq alias (assoc name mail-aliases))
- (setq alias (cdr alias)) )
- ((not (null search-result))
- (search-forward ":")
- (let ((name-start (point)))
- (end-of-line)
- (setq alias (buffer-substring name-start (point)))
- ))
- (t;; else
- (if (interactive-p)
- (error "Don't know about user %s" name)
- nil))
- )
- ; Then clean up
- (bury-buffer (get-buffer "aliases"))
- ; Finally return result
- (if (interactive-p)
- (message "%s is aliased to \"%s\"" name alias)
- alias))))
-