LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031612. :SYSTEM-TYPE :LOGICAL :VERSION 11. :TYPE "LISP" :NAME "DEFINITIONS" :DIRECTORY ("REL3-SOURCE" "MAIL-READER") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758716370. :AUTHOR "REL3" :LENGTH-IN-BYTES 33795. :LENGTH-IN-BLOCKS 34. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ;;; -*- Mode:Common-Lisp; Package:ZWEI; Base:10 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.(defparameter *MESSAGE-ARRAY-INITIAL-SIZE* 100)(defparameter *MESSAGE-ARRAY-ADJUSTMENT* 50)(defflavor MESSAGE-SEQUENCE   ((message-array (make-array *message-array-initial-size* :fill-pointer 0))    (current-message-index -1); Numerical index (zero based) into inferiors of the current message    (summary-buffer nil); The summary buffer for this sequence or NIL    (mail-file-buffer nil)); The file buffer from which this sequence was made   (zmacs-buffer)  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  :outside-accessible-instance-variables  (:accessor-prefix buffer-))(defmethod (message-sequence :after :INIT) (ignore)  (setq undo-status :dont)  (setq saved-major-mode 'read-mail-mode)  (push (list 'read-mail-mode) saved-mode-list)  (send self :set-attribute :mode 'read-mail-mode)  (setf (get self :dont-sectionize) t)  (setf (get self 'zwei:inhibit-kill-buffer-cleanup) t)  ;prevent sticky minor modes from creeping in  (setq saved-mode-list nil))(defun MESSAGE-SEQUENCE-P (object)  "T if OBJECT is a message sequence."  (typep object 'message-sequence))(defmacro TOTAL-MESSAGES (buffer)  `(fill-pointer (buffer-message-array ,buffer)))(defmacro MESSAGE-LIST (buffer)  "Returns a list of all message in buffer."  `(node-inferiors ,buffer))(defflavor MAIL-FILE-BUFFER   ((mail-file-format :unknown); Format of associated mail file (:babyl :unix :tops ...)    (mail-options nil); List of babyl mail file properties    (subsequences nil)); A list of message sequences generated from this buffer via filters, etc.   (message-sequence)  (:method-combination (:case :base-flavor-last      :read-mail-file :read-mail-file-start :read-message :read-mail-file-end      :write-mail-file :write-mail-file-start :write-mail-file-end))  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  :outside-accessible-instance-variables  (:accessor-prefix buffer-))(defmethod (mail-file-buffer :after :INIT) (ignore)  (send self :set-mail-file-buffer self))(defun MAIL-FILE-BUFFER-P (object)  "T if OBJECT is a mail file buffer."  (typep object 'mail-file-buffer));;; The following are defined as macros so setf can be used on them(defmacro GET-MAIL-OPTION (buffer option &optional default)  `(getf (buffer-mail-options ,buffer) ,option ,default))(defflavor MAIL-SUMMARY-BUFFER   ((sequence-buffer nil)); The Message Sequence Buffer for this summary   (zmacs-buffer)  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  :outside-accessible-instance-variables  (:accessor-prefix buffer-))  (defmethod (mail-summary-buffer :after :INIT) (ignore)  (setq read-only-p t)  (setq undo-status :dont)  (setf (get self :dont-sectionize) t)  (setq saved-major-mode 'read-mail-mode)  (send self :set-major-mode 'read-mail-mode)  ;prevent sticky minor modes from creeping in  (setq saved-mode-list nil))(defun MAIL-SUMMARY-P (object)  "T if OBJECT is a mail summary."  (typep object 'mail-summary-buffer))       (defflavor FILTER-SUMMARY-BUFFER   ((filter-list))   (mail-summary-buffer)  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  :outside-accessible-instance-variables  (:accessor-prefix buffer-))(defun FILTER-SUMMARY-P (object)  "T if OBJECT is a filtered mail summary."  (typep object 'filter-summary-buffer))(defun MAIL-FILTER-BUFFER-P (object)  "T if OBJECT is a buffer generated by a mail filter."  (or     (and (typep object 'message-sequence) (not (typep object 'mail-file-buffer)))    (and (typep object 'mail-summary-buffer) (not (typep (buffer-sequence-buffer object) 'mail-file-buffer)))))(defun MAIL-READER-BUFFER-P (object)  "T if OBJECT is any kind of mail reader buffer."  (or (message-sequence-p object)      (mail-summary-p object)))(defun MAIL-FILE-BUFFER-OF (buffer)  "Return the mail file buffer associated with BUFFER, which may be asummary or message buffer."  (or     (cond ((mail-file-buffer-p buffer) buffer)  ((message-sequence-p buffer) (buffer-mail-file-buffer buffer))  ((mail-summary-p buffer) (buffer-mail-file-buffer (buffer-sequence-buffer buffer)))  (t (ferror 'mail-reader-error "~A is not any kind of mail buffer." buffer)))    (ferror 'mail-reader-error "Mail buffer ~A has no associated mail file." buffer)))(defun MESSAGE-SEQUENCE-OF (buffer)  "Return the message sequence associated with BUFFER, which may be a summary or message buffer."  (or     (cond ((message-sequence-p buffer) buffer)  ((mail-summary-p buffer) (buffer-sequence-buffer buffer))  (t (ferror 'mail-reader-error "~A is not any kind of mail buffer." buffer)))    (ferror 'mail-reader-error "Mail buffer ~A has no associated message sequence." buffer)))(defun MAIL-SUMMARY-OF (buffer &optional create-p)  "Return the summary associated with buffer, which may be a summary or message buffer.  Ifno summary exists and CREATE-P is T, create a summary and return it; otherwise return NIL."  (cond ((message-sequence-p buffer) (or (buffer-summary-buffer buffer) (and create-p (make-summary buffer))))((mail-summary-p buffer) buffer)(t (ferror 'mail-reader-error "~A is not any kind of mail buffer." buffer))))(defflavor MESSAGE-INTERVAL   ()   (message-node))(defflavor MESSAGE-NODE   ((original-headers nil); An interval containing the original header    (headers-end-bp); A BP pointing to the first line of text (past the header)    (attributes nil)    (keywords nil)    (reformatted-p nil); T if message has been reformatted    (summary-lines nil); List of lines which summarize this message in various buffers    (summary-parsed-p nil); T if message has been parsed for summary info    (parsed-p nil); T if message has been fully parsed (for reply, filters, etc.)    (status nil)); Complete message info (a property list)   ;;? would rather this be just "node", but want things like List Changed Sections to work   (section-node)    (:method-combination (:case :base-flavor-last      :read-message-start :read-message-header :read-message-text      :end-of-header-p :end-of-message-p :read-message-end      :write-message-start :write-message-headers :write-message-body :write-message-end))  :gettable-instance-variables  :settable-instance-variables  :initable-instance-variables  :outside-accessible-instance-variables  (:accessor-prefix message-))(defmethod (message-node :after :INIT) (ignore)  (setq undo-status :dont)  (setq read-only-p t)  (unless (and (variable-boundp name) name)    (setq name "")))(defun MESSAGEP (object)  "T if OBJECT is a mail message."  (typep object 'message-node));;; The following are defined as macros so setf can be used on them(defmacro MESSAGE-PROP (message property &optional default)  `(get ,message ,property ,default))(defmacro MESSAGE-NAME (message)  `(section-node-name ,message))(defmacro MESSAGE-FILE-BUFFER (message)  `(node-superior ,message))(defmacro MESSAGE-KEYWORDS-STRING (message)  `(get ,message :keywords-string ""))(defmacro MESSAGE-CHAR-COUNT (message)  `(get ,message :char-count 0))(defmacro MESSAGE-LINE-COUNT (message)  `(get ,message :line-count 0))(defsubst BP-MESSAGE (bp)  "Return the message object that BP points to or NIL if BP does not point to a message."  (bp-node bp))(defvar *MSG* nil  "The current message -- always a message object or nil")(defvar *MSGS* :unbound  "List of messages to process -- for apply.")(defvar *MAIL-BUFFER* nil "The current mail buffer -- always a message sequence object or nil");;; Forgive us our trespasses...(defmacro MEMEQ (item list)  `(member ,item (the list ,list) :test #'eq))(defmacro DELEQ (item list &optional (times -1))  (if (eql times -1)      `(delete ,item (the list ,list) :test #'eq)    `(delete ,item (the list ,list) :test #'eq :count ,times)));;;;;; Support for Mail Filters;;;(defvar *SYSTEM-MAIL-FILTER-LIST* nil  "Alist of user mail filters built by DEFINE-SYSTEM-MAIL-FILTER forms.")(defvar *USER-MAIL-FILTER-LIST* nil  "Alist of user mail filters built by DEFINE-MAIL-FILTER forms.")(defvar *FILTER-SUMMARY-FILTER-LIST* nil)(defvar *MAIL-FILTER-LIST* nil)(defvar *MAIL-FILTER-ITEM-LIST* nil)(defvar *MAIL-FILTER-COMPLETION-ALIST* nil)(defvar *DEFAULT-MAIL-FILTER* "Keywords")(defflavor SYSTEM-MAIL-FILTER   ((id);Used as unique identifier, esp. for building alist of all system filters    name;Used in building buffer names -- should be short and concise    function;Function to be called to determine if a message passes this filter    (args);List of args to pass to filter-function.  A message object is;  always the first arg; these follow.    (string-for-filter-summary);Used in filter summary -- may be long and descriptive.;(the following can go away -- not used by filter summary stuff)    (filter-summary-default-p);When T, include this filter in filter summaries by default    (string-for-menu);Used in filter menu -- if nil, filter will not appear in menu    (completion);Dotted list for inclusion in a ZMACS completion alist.    (menu-item);Menu item for a menu of mail filters.    (inverse);ID of another filter that does the inverse of this one    ;(invert-test-p);(not implemented) When T, result of applying function to msg is inverted     (dynamic-p);When T, FUNCTION is first called with no args (to prompt for args, etc);  and should return the "real" filter to use.    (documentation));documentation -- used in who line for filter menu   (si:property-list-mixin)  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  (:accessor-prefix "filter-")  :outside-accessible-instance-variables  (:init-keywords :flavor)  (:required-init-keywords :name :function))(defmethod (system-mail-filter :after :INIT) (ignore)  (when (and name id)    (setq completion (cons name id)))  (when string-for-menu    (setq menu-item  `(,string-for-menu :buttons ((nil :value ,id) (nil :value ,id) (nil :value (,id)))    :documentation (:mouse-any ,(or documentation "Select this filter.")       :mouse-l-1 "Filter all messages."       :mouse-r-1 "Filter current sequence only.")))))#|;;;?(defmethod (system-mail-filter :PRINT-SELF) (stream depth slashify)  (declare (ignore depth))  (if slashify      (format stream "#<~A ~S ~O>"      (type-of self) name (%pointer self))      (princ name stream)))|#(eval-when (load)  (unless (member '(define-system-mail-filter 2 t) *indent-not-function-superiors* :test #'equal)  (push '(define-system-mail-filter 2 t) *indent-not-function-superiors*)))(defmacro DEFINE-SYSTEM-MAIL-FILTER (id (&rest init-options &key flavor &allow-other-keys)     &optional documentation)    (declare (arglist symbol    (&key name function args string-for-menu inverse dynamic-p  string-for-filter-summary filter-summary-default-p)    &optional documentation))    ;;?(check-arg-type id symbol "a symbol")  (let ((init (append `(:id ,id :documentation ,documentation) init-options)))    `(eval-when (load eval)       (define-system-mail-filter-1 ',flavor ',init))))(defun DEFINE-SYSTEM-MAIL-FILTER-1 (flavor init-options &optional user-filter?)    (let* ((filter (apply #'make-instance (or flavor 'system-mail-filter) init-options)) (id (send filter :id)) (item (send filter :menu-item)))    (if user-filter?(setf (get id :user-mail-filter) filter)      (setf (get id :system-mail-filter) filter))    (cond ((if user-filter?; If not present on the appropriate list, push it, else NIL.       (if (not (memeq id *user-mail-filter-list*))   (push id *user-mail-filter-list*)   nil)       (if (not (memeq id *system-mail-filter-list*))   (push id *system-mail-filter-list*)   nil))   (push id *mail-filter-list*)   (when item     (when (null *mail-filter-item-list*)       (setq *mail-filter-item-list* (copy-list '(("NOT" :value :not :font tr12b)))))     (push-end item *mail-filter-item-list*))   (let ((completion (send filter :completion)))     (when completion       (push completion *mail-filter-completion-alist*))))  (t   (update-mail-filters))))  nil)(defmacro DEFINE-USER-MAIL-FILTER (id (&rest init-options &key flavor &allow-other-keys)     &optional documentation)   "For user-defined filters.  The first arg to the function will always be a message object.The other arguments come from the :ARGS option."  (declare (arglist symbol    (&key name function args string-for-menu inverse dynamic-p  string-for-filter-summary filter-summary-default-p)    &optional documentation))  (check-type id symbol)  (let ((init (append `(:id ,id :documentation ,documentation) init-options)))    `(eval-when (load eval)       (define-system-mail-filter-1 ',flavor ',init t))))(defmacro DEFINE-MAIL-FILTER (function-name filter-name-string doc-string &rest body)   "For user-defined filters, backwards compatible with Release 2.The body may refer to the variable MSG, which will be a message object."   (let ((name (string-capitalize (string function-name))))     `(define-system-mail-filter-1nil; Default flavor.`(:id ,',function-name  :name ,',name  :documentation ,',doc-string  :string-for-menu ,',name  :string-for-filter-summary ,',filter-name-string  :filter-summary-default-p t  :function ,#'(lambda (msg) ,@body))t)))(defun UPDATE-MAIL-FILTERS ()  (setq *mail-filter-item-list* nil)  (setq *mail-filter-completion-alist* nil)  (setq *filter-summary-filter-list* nil)  (setq *mail-filter-list* (append *system-mail-filter-list* *user-mail-filter-list*))  (dolist (id *mail-filter-list*)    (let* ((filter (or (get id :system-mail-filter) (get id :user-mail-filter)))   (item (send filter :menu-item)))      (when filter(when item  (push (send filter :menu-item) *mail-filter-item-list*))(push (send filter :completion) *mail-filter-completion-alist*))      (when (send filter :filter-summary-default-p)(push filter *filter-summary-filter-list*))))  (push (copy-list '("NOT" :value :not :font tr12b)) *mail-filter-item-list*));;;;;; Support for Mail Templates;;;(defvar *MAIL-TEMPLATE-LIST* nil  "A list of symbols that have defined mail templates.")(defvar *MAIL-TEMPLATE-ITEM-LIST* nil  "A list of menu items for mail template menu.")  (defvar *MAIL-TEMPLATE* 'default-mail-template  "Mail template used to send a new message.")(defvar *REPLY-TEMPLATE* 'default-reply-to-sender-template  "Mail template used when no prefix arg passed to the mail \"R\" command.")(defvar *REPLY-TEMPLATE-1* 'default-reply-to-all-template  "Mail template used when prefix arg of 1 passed to the mail \"R\" command.")(defvar *REPLY-TO-SENDER-TEMPLATE* 'default-reply-to-sender-template  "Mail template used to reply to sender only.") (defvar *REPLY-TO-ALL-TEMPLATE* 'default-reply-to-all-template  "Mail template used to reply to all recipients.")(defvar *FORWARD-TEMPLATE* 'default-forward-template  "Mail template used to forward a message to another user.")(defvar *RESEND-TEMPLATE* 'default-resend-template  "Mail template used to resend a message to another user.")(defvar *REPLY-TO-ALL-HEADER-TYPES* '(:to :resent-to :from :resent-from :cc :resent-cc :reply-to :resent-reply-to)  "Header types from which addresses are collected for reply to all.")(defvar *MAIL-TEMPLATE-HEADER-BODY-GOAL-COLUMN* 9  "Column to start body of headers inserted into mail templates.")(defmacro DEFINE-MAIL-TEMPLATE (symbol name-string type doc-string &rest body)  "Define a mail template to initialize the contents of a buffer for sending mail.SYMBOL is used as an identifier for the template.NAME-STRING is used for a menu of templates and buffer names (which may be changed by the template).TYPE specifies the usage of the template -- it should normally be :mail, :reply, :forward  or :bug-from-error-handler.DOC-STRING is used for who line documentation within the template menu."  ;;?(check-arg-type symbol symbol "a symbol")  ;;?(check-arg-type name-string string "a string")  ;;?(check-arg-type type symbol "a symbol")  ;;?(check-arg-type doc-string string "a string")  `(eval-when (load eval)     (define-mail-template-1 ',symbol ,name-string ',type ,doc-string)     (defun (:property ,symbol :mail-template-function) (&aux (zwei:*batch-undo-save* t))       ,doc-string       (make-mail-template-buffer ,name-string ,type t)       (progn . ,body)       (send *interval* :not-modified)       (discard-undo-information *interval*)       dis-text)))(defun DEFINE-MAIL-TEMPLATE-1 (symbol name-string type doc-string)  (setf (get symbol :mail-template-type) type)  (let ((item `(,name-string :value ,symbol :documentation (:mouse-any ,doc-string))))    (setf (get symbol :mail-template-item) item)    (cond ((not (memeq symbol *mail-template-list*))   (push symbol *mail-template-list*)   (push-end item *mail-template-item-list*))  (t   (setq *mail-template-item-list* nil)   (dolist (sym *mail-template-list*)     (push (get sym :mail-template-item) *mail-template-item-list*))))))(defvar *MAIL-APPLY-COMMAND-LIST* nil)(defvar *MAIL-APPLY-COMMAND-ITEM-LIST* nil)(defvar *MAIL-APPLY-COMMAND-COMPLETION-ALIST* nil)(defvar *DEFAULT-MAIL-APPLY-COMMAND* "Print")(defflavor MAIL-APPLY-COMMAND   ((id);Used as unique identifier, esp. for building alist of all system filters    name;Used for menu item and completion    function;Function to apply to message object(s).  Before calling, The special;  *MSGS* is bound to a list of messages to process and before each;  call the special *MSG* is bound to the current message to process.;  Calling and arg passing is also controlled by the next two variables.    (message-arg);Specifies special handing of passing the message(s) to process.; nil - no special handling; :MESSAGE - call function for each message, passing it as first arg.; :MESSAGE-LIST - call function once with list of messages as first arg.; :MESSAGE-REST - call function once passing all messages as a rest arg;    in this case the args variable (below) is ignored.; :ONCE - call function just once with no special 1st arg -- will use *msgs*    (args);List of args to pass to the function.  These follow message-arg if specified.    (completion);Dotted list for inclusion in a ZMACS completion alist.    (menu-item);Menu item for a menu of mail filters.    (documentation));documentation -- used in who line in menu   ()  :settable-instance-variables  :gettable-instance-variables  :initable-instance-variables  (:accessor-prefix "mail-apply-command-")  :outside-accessible-instance-variables  (:required-init-keywords :id :name :function))(defmethod (mail-apply-command :after :INIT) (ignore)  (setq menu-item `(,name :value ,id :documentation ,documentation))  (setq completion (cons name id)))#|;;;?(defmethod (mail-apply-command :PRINT-SELF) (stream depth slashify)  (declare (ignore depth))  (if slashify      (format stream "#<~A ~S ~O>"      (type-of self) name (%pointer self))      (princ name stream)))|#(defmethod (mail-apply-command :EXECUTE) (msg-list)    (let ((*msgs* msg-list))    (cond ((eq message-arg :message)   (dolist (msg msg-list)     (apply function msg args)))  ((eq message-arg :message-list)   (apply function msg-list args))  ((eq message-arg :message-rest)   (apply function msg-list))  ((eq message-arg :once)   (apply function args))  (t   (dolist (*msg* msg-list)     (apply function args))))))(eval-when (load)  (unless (member '(define-mail-apply-command 2 t) *indent-not-function-superiors* :test #'equal)    (push '(define-mail-apply-command 2 t) *indent-not-function-superiors*)))(defmacro DEFINE-MAIL-APPLY-COMMAND (id (&key name function message-arg args) documentation)  "Define command for use by the mail Apply feature.ID is a symbol used to record the definition.NAME is used for menus and completion.FUNCTION is applied to messages to perform the actual processing.MESSAGE-ARG specifies special argument passing for message objects.ARGS is a list of args to pass to the function -- these may come after MESSAGE-ARG (see below).Normally, the special *MSGS* is bound to a list of message objects then FUNCTIONis called once for each message with the special *MSG* bound to the currentmessage to process.  However, MESSAGE-ARG can specify different calling procedures.  It should be one of::MESSAGE - call function for each message, passing it as first arg.:MESSAGE-LIST - call function once with list of messages as first arg.:MESSAGE-REST - call function once passing all messages as a rest arg   in this case the ARGS is ignored.:ONCE - call function just once with no special 1st arg -- will use *msgs*."    ;;?(check-arg-type id symbol "a symbol")  ;;?(check-arg-type documentation string "a string")  `(eval-when (load eval)     (define-mail-apply-command-1 ',id ,name ',function ,message-arg ',args ,documentation)))(defun DEFINE-MAIL-APPLY-COMMAND-1 (id name function message-arg args documentation)    (let ((command (make-instance 'mail-apply-command :id id :name name :function function:message-arg message-arg :args args :documentation documentation)))        (setf (get id :mail-apply-command) command)    (cond ((not (memeq id *mail-apply-command-list*))   (push id *mail-apply-command-list*)   (push-end (send command :menu-item) *mail-apply-command-item-list*)   (push (send command :completion) *mail-apply-command-completion-alist*))  (t   (update-mail-apply-commands))))  id)(defun UPDATE-MAIL-APPLY-COMMANDS ()  (setq *mail-apply-command-item-list* nil)  (setq *mail-apply-command-completion-alist* nil)  (dolist (id *mail-apply-command-list*)    (let ((command (get id :mail-apply-command)))      (when command(push (send command :menu-item) *mail-apply-command-item-list*)(push (send command :completion) *mail-apply-command-completion-alist*)))))(defresource MAIL-TEMP-STRING (size)   :constructor (make-array size :element-type 'string-char :fill-pointer 0)   :matcher (>= (array-total-size object) size)   :initializer (setf (fill-pointer object) 0))(w:defwindow-resource MAIL-MULTIPLE-MENU ():make-window (tv:momentary-multiple-menu):initial-copies 1:reusable-when :deexposed)(defvar *READ-MAIL-CONTROL-X-COMTAB* nil)(defvar *READ-MAIL-COMTAB* nil)(defvar *READ-MAIL-COMTAB-LIST* nil)(defvar *DEBUG-MAIL-READER* nil  "When non-nil, do not trap errors -- enter the Error Handler.")(defvar *ALL-MAIL-BUFFERS* nil  "List of all mail file, message sequence, and mail summary buffers.")(defvar *UNSENT-MESSAGE-LIST* nil  "List of mail template buffers that have not been sent.")(defvar *SENT-MESSAGE-LIST* nil  "List of mail template buffers that have been sent.")(defvar *MAIL-MOUSE-COMMAND* nil)(defvar *IN-MAIL-READER-P* nil)(defvar *MAIL-BUFFER-SELECTION-MODE* nil)(defvar *PRESERVE-WINDOWS-DURING-SELECT* t)(defvar *VALID-INBOX-FORMATS* '(:lispm-inbox :unix :tops)  "List of mail file formats that can be read as inboxes.")(defvar *READABLE-MAIL-FILE-FORMATS* '(:babyl :unix :tops)  "List of mail file formats that can be read.")(defvar *WRITABLE-MAIL-FILE-FORMATS* '(:babyl :unix :text)  "List of mail file formats that can be written.")(defvar *DEFAULT-MAIL-FILE-FORMAT* :ask)(defvar *DONT-SAVE-ATTRIBUTE-LIST* '(:print :apply))(defvar *MAIL-ATTRIBUTE-LIST* '(:print :apply :filed :deleted :remind :unseen :recent :answered))(defvar *MAIL-ATTRIBUTE-COMPLETION-ALIST* (mapcar #'(lambda (sym) (cons (string sym) sym))  *mail-attribute-list*))(defvar *READING-INBOX-P* nil  "Bound to T while reading an inbox in case a mail file format requiresspecial treatment when read as an inbox instead of a mail file.")(defvar *ALL-MAIL-KEYWORDS* nil  "A list of all keywords encountered in all mail files.")(defvar *PREVIOUS-MAIL-KEYWORDS* nil  "List of keywords last assigned to a message.")(defvar *MAIL-KEYWORDS-COMPLETION-ALIST* nil  "An alist of (string . keyword) for completion when reading a keyword from the mini buffer.")(defvar *MAX-MESSAGE-NAME-LENGTH* 30  "Maximum length for message names taken from the subject line")(defvar *MAIL-TEMPLATE-COUNTER* 0  "Counter used for generating mail template buffer names.");(defvar *READ-MAIL-COMTAB* nil)(defvar *MAIL-COMTAB* nil)(defvar *MAIL-BACKGROUND-P* nil)(defconstant *BABYL-END-OF-MESSAGE-CHAR* #\Or  "Character that marks the end of a babyl message (ASCII Control-Underscore)")(defconstant *BABYL-START-OF-MESSAGE-CHAR* #\Page  "Character that marks the end of a babyl file header (ASCII Form Feed)");;; The following is to avoid lengthy package searches when interning attributes and keywords.(defvar *MAIL-UTILITY-PACKAGE* (find-package "KEYWORD")  "Package to intern mail related symbols in (keywords, attributes, etc.)This currently *must* be the keyword package for anything to really work.");; The following variables exist for mode line display.  They should not be used for any other purpose.(defvar *MESSAGE-NUMBER* "0")(defvar *MESSAGE-COUNT* "0")(defvar *MESSAGE-DELETED* "")(defvar *MESSAGE-UNSEEN* "")(defvar *MESSAGE-REMINDER* "")(defvar *MESSAGE-ANSWERED* "")(defvar *MESSAGE-FILED* "")(defvar *MESSAGE-APPLY* "")(defvar *MESSAGE-PRINT* "")(defvar *MESSAGE-KEYWORDS* "")(defvar *MESSAGE-KEYWORDS-CHECK* "")(defvar *MAIL-FILE-MODIFIED-P* "")(defvar *MAIL-READER-PARSE-TIME-FUNCTION* 'parse-time-for-summary  "Function to call to parse Date: line in header into a form suitable the summary.")(defvar *MAIL-SUMMARY-LINE-FUNCTION* 'default-mail-summary-line  "Function to call to generate a mail summary line")(defvar *MAIL-SUMMARY-HEADING-FUNCTION* 'default-mail-summary-heading  "Function to call to generate mail summary heading")(defvar *MAIL-SUMMARY-HEADING-FUNCTION* 'default-summary-heading  "Function to call to generate mail summary heading")(defparameter *mail-filter-alist* '()  "Global list of currently defined filters -- items are added by macros define-mail-filter and define-mail-filter-from-keywords")(defconstant *system-mail-filter-alist* '(("ALL MESSAGES" nil)   ("UNSEEN MESSAGES"  unseen-messages-filter)   ("RECENT MESSAGES"  recent-messages-filter)   ("DELETED MESSAGES"  deleted-messages-filter)   ("UNANSWERED MESSAGES"  not-answered-messages-filter)   ("REMINDER MESSAGES"  reminder-messages-filter)   )  "A list of system-defined filters. Note that first entry must always be (\"ALL MESSAGES\")")(defvar *VALID-HEADER-LIST*'(  ("BCC" . :bcc)  ("BFCC" . :bfcc)  ("CC" . :cc)  ("Date" . :date)  ("Draft-Composition-Date" . :draft-composition-date)  ("Expiration-date" . :expiration-date)  ("Expires" . :expiration-date)  ("FCC" . :fcc)  ("Fonts" . :fonts)  ("From" . :from)  ("FTo" . :fto)  ("In-reply-to" . :in-reply-to)  ("Mail-from" . :mail-from)  ("Message-ID" . :message-id)  ("Redistributed-by" . :redistributed-by)  ("Redistributed-date" . :redistributed-date)  ("Redistributed-to" . :redistributed-to)  ("References" . :references)  ("Remailed-by" . :remailed-by)  ("Remailed-date" . :remailed-date)  ("Remailed-to" . :remailed-to)  ("Reply-to" . :reply-to)  ("Resent-cc" . :resent-cc)  ("Resent-date" . :resent-date)  ("Resent-from" . :resent-from)  ("Resent-reply-to" . :resent-reply-to)  ("Resent-sender" . :resent-sender)  ("Resent-to" . :resent-to)  ("Return-path" . :return-path)  ("Return-Path" . :return-path)    ("Sender" . :sender)  ("Subject" . :subject)  ("Subj" . :subject)  ("Supersedes" . :supersedes)  ("To" . :to)  ("Re" . :subject)   ) "A list of all elements that are legal in a babyl mail file header");;;;;; Add mail reader to system menu and set up system M to select mail reader;;;(defun DEFAULT-MAIL-FILE ()    (let ((file *user-default-mail-file*))    (cond ((null file)   (setq *user-default-mail-file* (send (fs:user-homedir-pathname) :new-pathname       :name "BABYL"       :canonical-type :text       :version :newest)))  ((or (stringp file)       (pathnamep file))   (setq file (fs:merge-pathname-defaults file))   (setq *user-default-mail-file* (send file :new-version :newest)))  (t   file))))(defun DEFAULT-OTHER-MAIL-FILE ()  (cond ((null *default-other-mail-file*) (setq  *default-other-mail-file* (default-mail-file)))((stringp *default-other-mail-file*) (setq *default-other-mail-file* (fs:merge-pathname-defaults *default-other-mail-file*))))  *default-other-mail-file*);;;;;; Some top level forms to start the mail reader from various places.;;;(defun READ-MAIL (&optional mail-file &key (selectp t))  "Find a zmacs window and read MAIL-FILE (default is user's personal mail file).  Select the zmacs window is SELECTP is non-nil."    ;;(fs:force-user-to-login)  ;causes prompt in KBD Sys process... let get-mail-file do it.  (cond (selectp (let* ((sheet (find-or-create-idle-zmacs-window)))   (funcall sheet :force-kbd-input    `(:execute get-mail-file ,mail-file))   (send sheet :select)    (tv:await-window-exposure)   sheet))(t (load-mail-file (or mail-file (default-mail-file))))));;;? This should be globalized?(defun MAIL (&optional user text edit subject other-headers)  "Send TEXT as mail to USER.  USER should be a string of the form\"username@hostname\".  Multiple recipients separated by commas arealso allowed.  TEXT may be a string, a stream, or any printable object.If either USER or TEXT are nil or EDIT is non-nil, enter the editor tocompose the mail.  Also see MAIL:SUBMIT-MAIL"    (cond ((or (null user)     (null text)     edit)   (let ((sheet (find-or-create-idle-zmacs-window)))     (tv:await-window-exposure)     (send sheet :force-kbd-input   `(:execute mail-thing ,user ,text ,subject ,other-headers))     (send sheet :select)))(t  (mail:submit-mail (if (or (stringp text)    (streamp text))text      (format nil "~%~A~%" text))    :to (if (consp user) user (list user))    :subject subject    :other-headers other-headers))))(defun preload-mail-file (&optional (mail-files (default-mail-file)))  "In background load mail files into a buffer for use by the mail reader"    (fs:force-user-to-login)    ;; Setup default.  (unless mail-files    (setf mail-files (default-mail-file)))    ;; Force it into a list  (if (not (listp mail-files))      (setf mail-files (list mail-files)))     (process-run-function '(:name "Preload mail file" :priority -20)#'(lambda ()    (let ((*mail-background-p* t))      (dolist (mail-file mail-files)(load-mail-file mail-file t))))))(defvar *PRELOAD-MAIL-FILE-P* nil  "Preload mail file in background upon login (when set by Profile).")(defvar *KILL-MAIL-BUFFERS-AT-LOGOUT-P* nil "If T, Kill mail buffers at logout")(defun KILL-MAIL-BUFFERS-AT-LOGOUT () "Kill mail buffers at logout"    (dolist (buff *zmacs-buffer-list*)    (when (mail-reader-buffer-p buff)      (kill-buffer buff))));;; Used in suggestions menu building(defun MAIL-SHORT-DOCUMENTATION (command)  (let ((doc (documentation command 'function)))    (if doc(let ((first-cr (position #\Newline (the string (string doc))  :test #'char-equal)))  (if first-cr      (nsubstring doc 0 first-cr)    doc))      "")))(defun HANDLE-CONDITION-P (condition &rest not-these-conditions)  (and (not (send condition :debugging-condition-p))       (not (send condition :dangerous-condition-p))       (if not-these-conditions   (not (condition-typep condition (cons 'or not-these-conditions))) (not (condition-typep condition 'sys:abort)))));;;(add-initialization "Initialize user default mail file" '(setf *user-default-mail-file*;;;       (send (fs:user-homedir-pathname);;;     :new-pathname;;;     :name "BABYL";;;     :canonical-type :text;;;     :version :newest)) :login)(add-initialization "Add mail system key"    '(tv:add-system-key #\m '(read-mail)"Mail Reader - manage electronic mail messages." t)    '(:once :now))(add-initialization "Add mail to system menu"    '(tv:add-to-system-menu-column :programs "Mail" '(read-mail)   "Manage electronic mail messages.")    '(:once :now))(add-initialization "Mail reader logout" '(mail-reader-logout) :logout)(defun MAIL-READER-LOGOUT ()  (setq *user-default-mail-file* nil)  (setq *default-other-mail-file* nil)  (setq *user-mail-filter-list* nil)  (update-mail-filters)  (setq *mail-summary-template* *default-mail-summary-template*)  (setq *in-reply-to-template* *default-in-reply-to-template*))-arg*)))      (cond ((null *msg*)     (com-mail-up-real-line)     (return-from com-previous-message-screen dis-bps))    (t     (delete-message-attribute :apply *msg*)     (delete-message-attribute :print *msg*))))    (values dis-none dis-bps)))))  (t   ;; must be in the message buffer   (recenter-window-relative *window* (if *numeric-arg-p*  (- *numeric-arg*)(- *next-screen-context-lines*   (window-n-plines *window*))))   (values dis-text dis-none)))))(defcom COM-VIEW-MESSAGE"View message in separate window."()  (in-mail-context (:require-message t)    ;; In 2 window mode, just allow current message to     ;; become the selected one, which requires no action here.    (cond ((two-mail-reader-windows-p *mail-buffer*)   (values dis-text dis-none))  (t   (with-open-stream (stream (interval-stream *msg*))     (view-stream stream))   (delete-message-attribute :unseen *msg*)   (values dis-none dis-none)))))(defcom COM-CHANGE-MESSAGE-