[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Update to personal alias hack
- To: SLUG@WARBUCKS.AI.SRI.COM
- Subject: Update to personal alias hack
- From: "J. Scott Penberthy" <JSP@ibm.com>
- Date: Thu, 8 Sep 88 17:18:00 EDT
- Character-type-mappings: (1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") (2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")
- Fonts: CPTFONT, CPTFONTCB, CPTFONTI
I've been waiting for this hack for quite a while... thanks! I also like
to use personal names in my mail messages, so I hacked the function so
that it supports these.
(in-package 'zwei)
(defun1 personal-alias-hook0 (recipients te &aux thing translated-name)
te
(dolist (recipient recipients)
(when (setq translated-name (maybe-translate-alias recipient))
2;; 7.2 bug fix kludge -- give it an array leader
0 (setq translated-name (lisp:make-array (string-length translated-name)
:element-type 'lisp:string-char
:initial-contents translated-name
:leader-length 10))
(setq thing
(car (parse-driver (rdtbl-lexer rfc733 translated-name
0 translated-name (cl:length translated-name))
(GET 'ADDRESSES 'PARSE-GRAMMAR))))
(unless (and (member :name thing) (member :host thing))
(error "Unable to expand personal mail alias. Please consult maintainer at TMC."))
(setf (cadr (member :name recipient)) (cadr (member :name thing)))
(setf (cadr (member :host recipient)) (cadr (member :host thing)))
2;;; hack for personal names
0 1(when (member :personal-name thing)
(if (member :personal-name recipient)
(setf (cadr (member :personal-name recipient)) (cadr (member :personal-name thing)))
(rplacd (last recipient)
`(:personal-name ,(cadr (member :personal-name thing))))))
0 ))
:continue-message-transmit)