LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031618. :SYSTEM-TYPE :LOGICAL :VERSION 12. :TYPE "LISP" :NAME "FILE" :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 2758716452. :AUTHOR "REL3" :LENGTH-IN-BYTES 51113. :LENGTH-IN-BLOCKS 50. :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.;;;;;; Manipulation of mail files and inboxes.;;;;; Just in case someone tries to resectionize.(defmethod (message-sequence :RESECTIONIZE) (&optional &rest ignore)  t)(defun GET-MAIL-FILE-FORMAT (pathname &optional (error-p t))  "Return the mail file format of PATHNAME.  If ERROR-P is nil, returnnil if format unknown; :file-not-found if PATHNAME does not exists (anyother open errors are signaled).  Does not guarantee that the fileexists, but if it was necessary to open and read the file to determinethe format, a second value of T is returned."    (unless (pathnamep pathname)    (setq pathname (parse-namestring pathname)))  (let ((generic (send pathname :generic-pathname)))    (or (get generic :mail-file-format)(with-open-file-case (stream pathname)  (fs:file-not-found   :file-not-found)  (:no-error   (values (get-mail-file-format-from-stream stream error-p)   (send stream :truename)))))))(defun GET-MAIL-FILE-FORMAT-FROM-STREAM (stream &optional (error-p t))  "Given STREAM, return the mail file format based on the first line ofinput and/or the system type of the host.  If ERROR-P is non-nil and thefile is of unknown format, generate an error; otherwise return NIL.  Ifthe variable *mail-prev-line* is bound, the first line of the file issaved in it, otherwise the first line is lost."    (declare (special *mail-prev-line*))  (let* ((line (read-line-with-leader stream nil nil t)) (path (send stream :send-if-handles :pathname)) (sys (send path :send-if-handles :system-type)) format)        (setq format  (cond ((null line) (setq *mail-prev-line* :empty))((string-equal "BABYL OPTIONS:" line :end2 14) :babyl)((unix-start-of-message-p line) :unix)((tops-start-of-message-p line) :tops)((string-equal "-*- Mode: Text -*-" line :end2 18.) :text);; There is no special pattern at the beginning of a lispm inbox, so check;;  system type and whether the first non blank line looks like a header field.((and (mail:header-line-p line)      (member sys '(:lispm :its :lmfs) :test #'eq)) :lispm-inbox)(t (if error-p     (ferror nil "Unknown mail file format in ~A" (or path stream))     nil))))    (when path      (setq path (send path :generic-pathname))      (setf (get path :mail-file-format) format))    (when (boundp '*mail-prev-line*)      (setq *mail-prev-line* line))    format))(defun NEW-MAIL-FILE-FORMAT (pathname)    (if (eq *default-mail-file-format* :ask)      (mail-file-format-query *writable-mail-file-formats* "Create ~A using what mail file format? " pathname)      *default-mail-file-format*))(defun MAIL-FILE-FORMAT-QUERY (file-format-list &optional format-string format-args)  (let ((choices (loop for format in file-format-list       collecting (list (list format (string format)) (char (string format) 0)))))    (fquery `(:fresh-line t :type :tyi :list-choices t :select t  :choices ,choices) format-string format-args)));;;;;;  READING MAIL FILES;;;(defun LOAD-MAIL-FILE (pathname &optional quietly-p (read-inboxes t))  "Read PATHNAME into a mail buffer, read inboxes for new mail, andpre-create a summary if the default viewing mode requires one."    (let ((buffer (find-mail-file pathname nil quietly-p))(config (default-mail-window-configuration)))    (when (mail-file-buffer-p buffer)      (when read-inboxes(get-new-mail buffer quietly-p))      (when (or (eq config :summary)(eq config :both))(mail-summary-of buffer t))      buffer)))(defun FIND-MAIL-FILE (pathname &optional (select-p t) quietly-p verbose-p)    (if (stringp pathname)      (setq pathname (fs:merge-pathname-defaults pathname)))  ;; Ignore verbose and select options unless inside ZMACS  (unless (and (boundp '*window*)       *window*)    (setq verbose-p nil)    (setq select-p nil))  (cond    ((send pathname :wild-p)     (send pathname :wildcard-map 'find-mail-file-1 nil nil   (send pathname :version) select-p quietly-p))    (t     (let ((buffer (find-file-buffer pathname)))       (cond ((and buffer (not (mail-reader-buffer-p buffer)))  (beep)  (format *query-io* "There is already a buffer visiting ~A that is not a mail buffer." buffer)  (when select-p    (make-buffer-current buffer))  buffer) (buffer  (when select-p    (make-mail-buffer-current buffer))  buffer) (t  (if verbose-p      (read-mail-file-verbose pathname)      (setq buffer (make-instance 'mail-file-buffer :name nil))      (or (revert-mail-file-buffer buffer pathname t nil quietly-p)   (return-from find-mail-file nil))      (send buffer :activate t)      (when select-p(make-mail-buffer-current buffer))      (must-redisplay-mail-buffer buffer dis-text dis-text)      buffer)))))))(defun FIND-MAIL-FILE-1 (pathname wild-pathname-version &optional (select-p t) quietly-p)  (find-mail-file (if (eq wild-pathname-version ':newest) (send pathname ':new-version ':newest) pathname)     select-p quietly-p))(defun READ-MAIL-FILE-VERBOSE (pathname)     (let ((old-buffer *interval*)buffer success)    (multiple-value-bind (nil pathname-string)(editor-file-name pathname)      (setq buffer (make-instance 'mail-file-buffer :name  pathname-string)))    (unwind-protect(block nil  (send buffer :activate t)  (unless (mail-reader-buffer-p old-buffer)    (make-mail-buffer-current buffer :message))  (setq *msg* nil)  (redisplay *window*)  (redisplay-mode-line)  (let ((*after-read-message-hook* 'print-message-count-while-reading))    (declare (special *after-read-message-hook* ))    (setq success (revert-mail-file-buffer buffer pathname t nil nil))))      (cond (success     (format *query-io* "Done.")     (make-mail-buffer-current buffer       (if (not (mail-reader-buffer-p old-buffer))   (default-mail-window-configuration))))    (t     ;; Following causes error now that ZMACS nukes buffer contents during kill     ;;(send old-buffer :select)     old-buffer; avoid compiler warning     )))))(defun PRINT-MESSAGE-COUNT-WHILE-READING (msg)  (let ((count (total-messages (message-file-buffer msg))))    (if (= count 10)(format *query-io* "Reading message 10...")(if (= (mod count 10) 0)    (format *query-io* "~D..." count)))))(defprop read-mail-mode revert-mail-file-buffer MAJOR-MODE-REVERT-FUNCTION)(defun REVERT-MAIL-FILE-BUFFER (buffer &optional(pathname (buffer-pathname buffer))(connect-p (buffer-file-id buffer))select-pquietly-p)  "Read mail file file PATHNAME, or BUFFER's visited file into BUFFER.  BUFFER must be a flavor of type MAIL-FILE-BUFFER.CONNECT-P non-NIL means mark BUFFER as visiting the file. This may change the buffer's name. It defaults non-NIL if BUFFER is visiting a file now.SELECT-P is ignored at this time (i.e. *find-file-early-select* is yet supported)QUIETLY-P means do not print a message about reading a file."  (declare (ignore select-p))      (let ((seq (message-sequence-of buffer)))    (when (and (not (mail-file-buffer-p seq))       (get seq :filters-used))      (return-from revert-mail-file-buffer(revert-filter-buffer buffer))))  (setq buffer (mail-file-buffer-of buffer))  (unless (or (buffer-file-id buffer) pathname)    (barf "The buffer ~A is not associated with a file and no pathname provided." (buffer-name buffer)))    (let* ((*mail-prev-line* nil) (*undo-save-small-changes* nil) (new-buffer-p (null (buffer-file-id buffer))) (kill-buffer-on-error-p new-buffer-p) success pathname-string format)    (declare (special *mail-prev-line*))        (unwind-protect (block reading-file  (with-buffer-lock (buffer)    (with-read-only-suppressed (buffer)            (multiple-value-setq (pathname pathname-string) (editor-file-name pathname))      (cond (connect-p     (setf (buffer-name buffer) pathname-string)     (setf (buffer-pathname buffer) pathname)     (setf (buffer-generic-pathname buffer) (send pathname :generic-pathname))))            ;; Open mail file      (with-open-file-case (stream pathname)(fs:file-not-found ;; If old buffer, the associated mail file has disappeared! (when (not new-buffer-p)   (utter nil "~&~A no longer exists!~%Suggest you save this buffer immediately."  pathname)   (return-from reading-file)) (cond ((y-or-n-p "~&Mail file ~a not found, create it?" pathname)(setup-new-mail-file buffer pathname)(not-modified buffer))       (t(return-from reading-file))));; Open succeeded -- determine format and read it in.(:no-error (setq format (get-mail-file-format-from-stream stream)) (cond ((eq format :empty)(utter nil "~A is an empty file" (send pathname :truename)))       (t(setf (buffer-mail-file-format buffer) format)(or quietly-p (format *query-io* "~&Reading mail in ~A~%" (send pathname :truename)));; if error occurs now, don't leave trashed or partial buffers around.(setf kill-buffer-on-error-p t);;? if not new buffer, should preserve point(clear-mail-file-buffer buffer)(when (mail-summary-of buffer)  (send (mail-summary-of buffer) :kill))(send buffer :read-mail-file (buffer-mail-file-format buffer) stream)))  (setf (buffer-tick buffer) (tick)) (setf (buffer-file-read-tick buffer) *tick*) (when connect-p   (set-buffer-file-id buffer (send stream :info))) (not-modified buffer)))            ;; Buffer is now in a reasonably sane state, don't kill on error      (setf success t)      (setf kill-buffer-on-error-p nil)            ;; Add probes to find new mail for this mail file.      (when mail:*probe-for-new-mail-p*(dolist (inbox-pathname (get-mail-option buffer :mail))  (unless (stringp inbox-pathname)    (mail:add-mail-inbox-probe inbox-pathname))))))  buffer)      ;; Cleanup forms for unwind-protect      (cond ((and (not success)  kill-buffer-on-error-p  (not *debug-mail-reader*))     ;; Must be sure another buffer is selected before :kill because ZMACS now nukes buffers upon killing     (let ((old-buffer (and (boundp '*interval*)    (eq *interval* buffer)    (previous-buffer buffer))))       (when old-buffer (send  old-buffer :select))       (send buffer :kill))     nil)    (t     buffer)))))(defun SETUP-NEW-MAIL-FILE (buffer pathname)    (if (fs:pathname-equal pathname (default-mail-file))      (setf (get-mail-option buffer :mail)    (list (send pathname:new-pathname :name "MAIL":canonical-type :text:version :newest))))  (set-buffer-file-id buffer t)    (setf (buffer-mail-file-format buffer) :babyl)  (setf (buffer-current-message-index buffer) -1)  (clear-mail-file-buffer buffer))(defun CLEAR-MAIL-FILE-BUFFER (buffer)    (clear-message-sequence buffer)  (setf (buffer-mail-options buffer) '())  (setf (get buffer :old-inbox-truenames) nil)  (setf (get buffer :inboxes-read) nil))  (defmethod (mail-file-buffer :READ-MAIL-FILE) (file-format stream)  "Read a mail file of type FILE-FORMAT from STREAM into a buffer."  (declare (special *after-read-message-hook* ))  (let (message status)    (with-read-only-suppressed (self)      ;; Any non-nil return value indicates special handling.      (setq status (send self :read-mail-file-start file-format stream))      (unless status(loop   ;; Create new message object   (setq message (make-instance 'message-node :superior self))  (with-read-only-suppressed (message)    ;; Consume one message    (setq status  (or    (send message :read-message-start file-format stream)    (send message :read-message-headers file-format stream)    (send message :read-message-body file-format stream)    (send message :read-message-end file-format stream))))  (add-message-to-buffer message self (not *reading-inbox-p*))  (when (and (boundp '*after-read-message-hook*) *after-read-message-hook*)    (funcall *after-read-message-hook* message))  (when status    (return)))(or (send self :read-mail-file-end file-format stream)    status)))))(defmethod (mail-file-buffer :READ-MAIL-FILE-START) (file-format stream)  "Default method for handling the start of a mail file.  Does nothing."  (declare (ignore file-format stream))    nil)(defmethod (mail-file-buffer :case :READ-MAIL-FILE-START :babyl) (stream)  "Babyl method to read beginning of mail file.  Parse and save off all babyl options.Returns :EOF if end-of-file encountered."  (declare (special *mail-prev-line*))    (let ((alphabetic-case-affects-string-comparison nil))    (loop      (multiple-value-bind (line eof) (send stream :line-in t)    (cond    ;; Check EOF before proceeding    (eof (return :eof))    ;; Look for end of header section    ((and (> (length line) 0)  (char-equal (char line 0) *babyl-end-of-message-char*))     ;; Get status line of first message     (setq *mail-prev-line* (read-line-with-leader stream nil))     (return (if (null *mail-prev-line*) :eof nil)))        ;; Inbox pathnames    ((mail:header-line-type-p "Mail" line)     (setf (get-mail-option self :mail) (parse-pathname-list (mail:header-line-body-string line))))        ;; Babyl version number.    ((mail:header-line-type-p "Version" line)     (setf (get-mail-option self :version) (or (parse-number (mail:header-line-body-string line)) 5)))        ;; Append/Prepend new mail    ((mail:header-line-type-p "Append" line)     (setf (get-mail-option self :append) (or (parse-number (mail:header-line-body-string line)) 1)))    ((string-equal line "Append")     (setf (get-mail-option self :append) 1))    ;; Babyl owner(s)    ((mail:header-line-type-p "Owner" line)     (setf (get-mail-option self :owner) (mail:header-line-body-string line)))        ;; Reformat headers?    ((or (string-equal line "No Reformation") (mail:header-line-type-p "No Reformation" line))     (setf (get-mail-option self :no-reformation) t))    ;;  Save old headers after reformatting?    ((or (string-equal line "No Original") (mail:header-line-type-p "No Original" line))     (setf (get-mail-option self :no-original) t))        ;; Labels    ((mail:header-line-type-p "Labels" line)     (setf (get-mail-option self :labels)   (delimited-string-to-list (mail:header-line-body-string line) #\, 0 nil nil     *mail-utility-package* *upcase-message-keywords-p*)))        ;; Filter-Alist -- List of filters which the user has chosen to use    ;; Format is '((filter-name-string function-symbol arg1 arg2...) ...)    ((mail:header-line-type-p "Filter-Alist" line)     (setf (get-mail-option self :filter-alist)         (append (get-mail-option self :filter-alist)   (parse-filter-alist (mail:header-line-body-string line))))     (loop       for filter in (get-mail-option self :filter-alist)       with filter-function = (and (consp filter) (second filter))       when filter-function       do       (setf (second filter)     (intern (nstring-upcase       (symbol-name filter-function)) 'ZWEI))))    ;; Unknown babyl options    (t     (when (not (mail:string-blank-p line))       (push-end line (get-mail-option self :unknown-options)))))  (if eof :eof nil)))))(defmethod (mail-file-buffer :case :READ-MAIL-FILE-START :unix) (stream)  "Unix method to read beginning of mail file.  Does nothing except add inboxes to thebuffer if *unix-inbox-pathname* is set and this is the user default mail file."  (declare (ignore stream))    (when (and (not *reading-inbox-p*)     (null (get-mail-option self :mail))     *unix-inbox-pathname*     (fs:pathname-equal pathname (default-mail-file)))    (setf (get-mail-option self :mail) (if (consp *unix-inbox-pathname*)   *unix-inbox-pathname* (list *unix-inbox-pathname*))))  nil)(defun READ-MESSAGE (input-stream)  "Read STREAM until eof and return a message object with the contents."  (with-open-stream (stream input-stream)    (let ((msg (make-instance 'message-node))  (*mail-prev-line* nil))      (declare (special *mail-prev-line*))      (send msg :read-message-start nil stream)      (send msg :read-message-headers nil stream)      (send msg :read-message-body nil stream)      (send msg :read-message-end nil stream)      msg)))(defmethod (message-node :READ-MESSAGE-START) (file-format stream)  "Default method to handle the start of a new message.  Does nothing."  (declare (ignore file-format stream))  nil)(defmethod (message-node :case :READ-MESSAGE-START :lispm-inbox) (stream)  "LispM-Inbox method to handle the start of a new message."  (declare (ignore stream))  (add-message-attribute :unseen self)  (add-message-attribute :recent self)  nil)(defmethod (message-node :case :READ-MESSAGE-START :unix) (stream)  "Unix method to handle the start of a new message.  Save off the unix \"From \" line."  (declare (special *mail-prev-line*)   (ignore stream))  (setf (message-prop self :unix-start-of-message-line) *mail-prev-line*)  (when *reading-inbox-p*    (add-message-attribute :unseen self)    (add-message-attribute :recent self))  (setq *mail-prev-line* nil)  nil)(defmethod (message-node :case :READ-MESSAGE-START :babyl) (stream)  "Babyl method to handle the start of a new message.  Parse the status line and save offoriginal header if present."  (declare (special *mail-prev-line*))    ;; parse the status line  (let ((status-line *mail-prev-line*))    (setq *mail-prev-line* nil)    (when status-line      (parse-babyl-status-line self status-line)))  (setf (message-keywords-string self) (make-message-keyword-string keywords))    ;; Check for reformatted header and gather it into an interval if exists.  (loop    for line = (read-line-with-leader stream nil nil t)    until (or (null line) (string= "*** EOOH ***" line :end2 12))    do    (unless original-headers      (setq original-headers (make-instance 'interval)))    (setf (line-node line) self)    (splice-line-into-interval line (bp-line (interval-last-bp original-headers)))    finally (unless original-headers      (setq reformatted-p nil))    finally (return (if (null line) :eof nil))));;; Parse babyl status line at start of message.  Format is:;;; <status-line>  ::= <reformed-flag> "," <attributes> "," <keywords>;;; <attributes> ::= (<attribute> ",")*;;; <keywords>  ::= (<keyword> ",")*(defun PARSE-BABYL-STATUS-LINE (msg line)    (setf (message-reformatted-p msg) (not (string-equal line "0" :start1 0 :end1 1)))  (let ((split (lisp:search ",," line)))    (when split      (when  (> split 1)(setf (message-attributes msg)      (delimited-string-to-list line #\, 2 split nil *mail-utility-package* *upcase-message-keywords-p*)))      (set-message-keywords (delimited-string-to-list line #\, (+ split 2) nil nil      *mail-utility-package* *upcase-message-keywords-p*)    msg))));;; Each message in a Tops/T(w)enex mail file is separated by a status line of the form;;; <received-date>,<byte-count>;bits    E.g.;;; 30-Jan-81 16:53:05-EST,129;000000000001;;; The bits can be mapped to what we call attributes as follows (in octal):;;; Unseen1 - actual meaning is "seen", hence must be inverted.;;; Deleted2;;; Reminder4;;; Answered10(defmethod (message-node :case :READ-MESSAGE-START :tops) (stream)  "Tops message to handle the start of a new message.  Saves off thebyte count and parse the bit flags for attributes."  (declare (special *mail-prev-line*)   (ignore stream))    (let ((line *mail-prev-line*))    (setq *mail-prev-line* nil)    ;; Setup in case we fail in parsing the first line    (add-message-attribute :unseen self)    (add-message-attribute :recent self)        ;; Locate the position of the comma and semicolon within the first line    (let* ((comma-index (position #\, line))   (semi-index (and comma-index    (position #\; line :start comma-index)))   attribute-bits   tops-length)            ;; Extract length and attribute bits if delimiters found       (when (and (numberp comma-index) (numberp semi-index))(setq tops-length (parse-number line (+ 1 comma-index) semi-index 10 t))(setq attribute-bits (parse-number line (+ 1 semi-index) (+ 13 semi-index) 8 t)))            ;; Warn if no delimiters or no numbers between delimiters      (cond ((not (and (numberp tops-length)       (numberp attribute-bits)))     (utter t "~&Warning: malformed start-of-message line for Tops inbox.")     (setf (get self :tops-length) -1))    (t     ;; Account for first line in length     (setf (get self :tops-length) (- tops-length (length line)))     ;; LSBit = 1 if seen... invert it so that 1 => "unseen"      (setq attribute-bits (logxor attribute-bits 1))     (setq attributes '())          ;; Assign attributes to message equivilent to the attributes bits      (do* ((attr '(:unseen :deleted :remind :answered) (cdr attr))   (index 0 (+ 1 index))   (attr-bit (ldb (byte 1 index) attribute-bits)     (ldb (byte 1 index) attribute-bits)))  ((null attr))       (when (not (zerop attr-bit)) (add-message-attribute (car attr) self)))          (when (memeq :unseen attributes)       (add-message-attribute :recent self))))))  nil)(defmethod (message-node :READ-MESSAGE-HEADERS) (file-format stream)  "Default method to Read and process one message header."  (declare (special *mail-prev-line*))    (let ((line (or *mail-prev-line* (read-line-with-leader stream nil))))    (setq *mail-prev-line* nil)        (loop      (when (or (null line)(send self :end-of-message-p file-format line stream));; premature end (either EOF or end of message before reaching end of header);; add one blank line(let ((new-line (create-line 'art-string 0 self)))  (add-line-to-message new-line self)  (setq headers-end-bp (create-bp new-line 0)))(setq *mail-prev-line* line);; Don't signal EOF yet even if hit... other methods may need to initialize this message.(return))            ;; Tuck away enough info so that a summary can be generated without parsing message.      (add-line-to-message line self)      (cond ((string-equal "Subject" line :end2 7)     (let ((start-index (mail:header-line-body-index line)))       (setq name (subseq line start-index  (min (line-length line)       (+ start-index *max-message-name-length*))))       (setf (get self :summary-subject) (nsubstring line start-index))))    ((string-equal "From" line :end2 4)     (setf (get self :summary-from) (nsubstring line (mail:header-line-body-index line))))    ((string-equal "Date" line :end2 4)     (setf (get self :summary-date-string) (nsubstring line (mail:header-line-body-index line))))    ((and (eq file-format :unix)  (not *reading-inbox-p*)  (string-equal "Status" line :end2 6))     (unless (position #\R line :start 7)        (add-message-attribute :unseen self)))    (t     (when (send self :end-of-header-p file-format line stream)       (setq headers-end-bp (create-bp line 0))       (return))))      (setq line (read-line-with-leader stream nil))))  (setq summary-parsed-p t)  nil)(defmethod (message-node :END-OF-HEADER-P) (file-format line stream)  "Default method for determining whether LINE indicates the end of a header."  (declare (ignore file-format stream))    (mail:string-blank-p line))(defmethod (message-node :READ-MESSAGE-BODY) (file-format stream)  "Default method to read the body (text) of one message."  (declare (special *mail-prev-line*))    (let ((line (or *mail-prev-line* (read-line-with-leader stream nil))))    (setq *mail-prev-line* nil)    (loop      (cond ((null line)     (return))    ((send self :end-of-message-p file-format line stream)     (setq *mail-prev-line* line)     (return))    (t     (add-line-to-message line self)     (setq line (read-line-with-leader stream nil)))))    (if (null line) :eof nil)))(defmethod (message-node :END-OF-MESSAGE-P) (file-format line stream)  "Default method to check for end of message."  (declare (ignore file-format stream))  (and (> (length line) 0)       (char-equal *babyl-end-of-message-char* (char line 0))))  (defmethod (message-node :case :END-OF-MESSAGE-P :unix) (line stream)  "Method for determining end of message in a Unix mail file."  (declare (ignore stream))    (unix-start-of-message-p line))(defun UNIX-START-OF-MESSAGE-P (line)    ;; Syntax is --> From <return-path>  Mon Feb  3 09:45:35 1986  ;; So the (simple-minded) matching algorithm is:  ;;  - must start with "From "  ;;  - must be 2 colons with only 2 characters in between which must be a number  ;;  - must be a 4 digit number at the end  ;;  - line must be over 32 characters long  ;; Of course we could call parse-time too, but life is too short...    (when (string= "From " line :end2 5)    ;; check for a date-type-thing toward the end of line    (let* ((colon2 (position #\: line :from-end t))   (colon1 (and colon2(position #\: line :end colon2 :from-end t)))   (year-index (and colon2 (> (length line) (+ colon2 7))    (+ colon2 4))))      (and colon1 colon2 year-index (= (- colon2 colon1) 3) (>= (length line) 30)   (parse-number line (+ colon1 1) colon2 10. t)   (parse-number line year-index nil 10. t)))))(defmethod (message-node :case :END-OF-MESSAGE-P :tops) (line stream)  "Method for determining end of message in a Tops mail file."  (declare (ignore stream))    ;; Check length counter against total length of this message as  ;; recorded in the tops message header.  The line count times 2 is  ;; factored in to account for losing a CRLF pair for each line we read.  ;; Also, 80 is added to the current length out of  ;; paranoia because we DO NOT under any circumstances want to miss the  ;; start of message indicator.  (when (>= (+ (+ (message-char-count self) (* (message-line-count self) 2)) 80); infix -> #chars + (#lines * 2) + 80     (get self :tops-length))    ;; Check if we have a Tops style start of message line.     (tops-start-of-message-p line)))(defun TOPS-START-OF-MESSAGE-P (line)  "Returns T if LINE resembles a tops format start of message"    (let* ((comma-index (position #\, line)) (semi-index (and comma-index  (position #\; line :start comma-index))))        (and comma-index semi-index ;; Looks a lot like a message starter.  Clinch it by checking whether a ligitimate number ;; lies between the comma and semicolon.  (parse-number line (+ 1 comma-index) semi-index 10. t))))(defmethod (message-node :READ-MESSAGE-END) (file-format stream)  "Default method to handle the end of a message.  Does nothing."  (declare (ignore file-format stream))  nil)(defmethod (message-node :case :READ-MESSAGE-END :lispm-inbox) (stream)  "Lispm-Inbox method to handle end of message.  Discard the Control-_ line and check for end of file."  (declare (special *mail-prev-line*))  (if (null (setq *mail-prev-line* (read-line-with-leader stream nil nil t)))      :eof      nil))(defmethod (message-node :case :READ-MESSAGE-END :babyl) (stream)  "Babyl method to handle end of message.  Discard the Control-_ line and check for end of file."  (declare (special *mail-prev-line*))    (if (null (setq *mail-prev-line* (read-line-with-leader stream nil)))      :eof      nil))(defmethod (mail-file-buffer :READ-MAIL-FILE-END) (file-format stream)  "Default method to handle the end of a mail file.  Does nothing."  (declare (ignore file-format stream))  nil);;;;;;  READING INBOXES ;;;(defun READ-INBOXES (buffer &optional force-read-old-inboxes-p)  "Read this mail file's inboxes and add messages to the mail file.Returns the number of new message read."    (let ((old-msg-count (total-messages buffer)))    (dolist (inbox (get-mail-option buffer :mail))      (catch 'give-up-on-inbox;; Leave unparseable pathnames alone(when (pathnamep inbox)  (condition-resume    `(error :give-up-on-inbox handle-condition-p ("Give up reading inbox ~A" ,inbox)    (lambda (ignore)      (throw 'give-up-on-inbox nil)))    (condition-case (condition)(let ((old-inbox (make-old-inbox-pathname (buffer-mail-file-format buffer) inbox)))    ;; Check if old-inboxes should be read  (when (or force-read-old-inboxes-p    (not (memeq inbox (get buffer :inboxes-read))))    ;; Dont waste time doing a directory list if no wildcards    (if (send old-inbox :wild-p)(send old-inbox :wildcard-map #'read-inbox nil nil buffer nil nil t)      (read-inbox old-inbox buffer nil nil t)))    (setq old-inbox (send old-inbox :new-version :newest))  (if (send inbox :wild-p)      (send inbox :wildcard-map #'read-inbox nil nil buffer t old-inbox)    (read-inbox inbox buffer t old-inbox)))      (sys:abort       (format *query-io* "~&Aborted reading inbox ~A" inbox)))))))    (- (total-messages buffer) old-msg-count)))(defun READ-INBOX (pathname buffer &optional delete-after-read-p backup-pathname old-inbox-p)    (let ((*reading-inbox-p* t)(*mail-prev-line* nil)(*batch-undo-save* t)(*undo-save-small-changes* nil)(old-msg-count (length (message-list buffer)))file-format status backup-truename)    (declare (special *mail-prev-line*))    ;;  Check for stupidity.    (when (fs:pathname-equal (buffer-pathname buffer) pathname)      (beep)      (utter t "~&Mail file ~A cannot have itself as in inbox." (buffer-pathname buffer))      (return-from read-inbox 0))        ;; Check if file exists and check file format     (with-open-file (in-stream pathname :error nil)      (when (errorp in-stream)(when (and (condition-typep in-stream 'fs:file-not-found)   (not old-inbox-p))  ;; At least know host responding, directory exists, etc.  Consider it read.  (pushnew pathname (get buffer :inboxes-read)))(return-from read-inbox 0))      (setq file-format (get-mail-file-format-from-stream in-stream nil))      (cond ((eq file-format :empty)     (return-from read-inbox 0))    ((null file-format)     (beep)     (utter t "~&Cannot determine file format of inbox ~A.  Please examine.~%" pathname)     (return-from read-inbox 0))    ((not (memeq file-format *valid-inbox-formats*))     (beep)     (utter t "~&Inbox ~A is a ~A format mail file.  It cannot be used as an inbox.~%" pathname file-format)     (return-from read-inbox 0)))      (cond (backup-pathname     (with-open-file (backup-stream backup-pathname    :direction :output :if-exists :append :if-does-not-exist :create :error nil)       (cond ((not (errorp backup-stream))      (setq backup-truename (send backup-stream :truename))      (format backup-stream "~A~%" (or *mail-prev-line* ""))      (setq status (send buffer :read-mail-file file-format (make-echo-stream in-stream backup-stream))))     (t      ;; Without a saftey net...      (utter t "~&~%Cannot open inbox backup file ~A -- ~A.~%Proceeding to read inbox without backup."     backup-pathname (send backup-stream :report-string))      (setq status (send buffer :read-mail-file file-format in-stream))))))    (t      (when old-inbox-p       (setq backup-truename (send in-stream :truename)))     (setq status (send buffer :read-mail-file file-format in-stream))))      (cond ((neq status :eof)     (utter t "~&~%Inbox not completely read.  Status = ~A" status))    (t     (when backup-truename       (pushnew backup-truename (get buffer :old-inbox-truenames)))     (when (not old-inbox-p)       (pushnew pathname (get buffer :inboxes-read)))     (when delete-after-read-p       (close in-stream)       (let ((outcome (send pathname :delete nil))) (if (and (errorp outcome)  (not (condition-typep outcome 'fs:open-deleted-file))  (not (condition-typep outcome 'fs:file-not-found)))     (utter t "~&~%Warning: Could not delete inbox ~A -- ~A~%This may cause duplicate messages later."    pathname outcome)   (if (send pathname :undeletable-p)       (send pathname :expunge :error nil))))))))        (- (length (message-list buffer)) old-msg-count)));; This could be made system and file format dependant if need be...(defun MAKE-OLD-INBOX-PATHNAME (file-format pathname)  (declare (ignore file-format))  (send pathname :new-pathname :type "_ZMAIL_TEMP"))(defun DELETE-OLD-INBOXES (buffer)  "Delete old inboxes that have been previously read by BUFFER."    (let ((old-inboxes (get buffer :old-inbox-truenames)))    (dolist (path old-inboxes)      (let ((outcome (send path :delete nil)))(if (errorp outcome)    (utter t "Warning: Could not delete old inbox ~A.~%~A" path outcome)  (setf (get buffer :old-inbox-truenames)(deleq path (get buffer :old-inbox-truenames)))  (if (send path :undeletable-p)      (send path :expunge :error nil)))))));;;;;;  WRITING MAIL FILES;;;(defun MAYBE-SAVE-MAIL-BUFFER-IN-BACKGROUND (buffer &optional (option *save-mail-file-in-background*))    (setq buffer (mail-file-buffer-of buffer))  (when (and (buffer-needs-saving-p buffer)     (neq option :never)     (memeq (buffer-mail-file-format buffer) *writable-mail-file-formats*))    ;; Check if background save already in progress and whether buffer has changed since save began    (when (or (not (numberp (node-tick buffer)))      (not (numberp (get buffer :start-mail-file-save-tick)))      (> (node-tick buffer) (get buffer :start-mail-file-save-tick)))      (when (or (eq option :always);; Only ask if buffer has changed since last query.(let ((last-query (get buffer :last-save-query-tick)))  (setf (get buffer :last-save-query-tick) *tick*)  (if (or (not (numberp last-query))  (> (node-tick buffer) last-query))      (y-or-n-p "Save changes in mail file?"))))(write-mail-file-buffer nil buffer t)))))    (defprop read-mail-mode write-mail-file-buffer MAJOR-MODE-WRITE-FUNCTION)(defun WRITE-MAIL-FILE-BUFFER (pathname buffer &optional (in-background *numeric-arg-p*))  "Write mail BUFFER to PATHNAME in the style specified by the mail buffer's file format.  If IN-BACKGROUND is T,write the file using a separate process."    (setq buffer (mail-file-buffer-of buffer))  (unless (memeq (buffer-mail-file-format buffer) *writable-mail-file-formats*)    (barf "~A is a ~A format mail file.~%This format can be read but not written."  buffer (buffer-mail-file-format buffer)))  (let ((owner (get-mail-option buffer :owner)))    (unless (or (null owner)(lisp:search user-id owner :test #'string-equal))      (barf "~&This mail file belongs to ~A.  Not writing." owner))); Maybe just ask for confirmation?  (unless pathname    (setq pathname (buffer-pathname buffer)))  (when (and (null (buffer-file-id buffer)) (null pathname))    (barf "The buffer ~A is not associated with a file." (buffer-name buffer)))  (when (stringp pathname)    (setq pathname (parse-namestring pathname)))    (let ((process (get buffer :background-save-process)))    (when process      (cond ((yes-or-no-p "~&A background save is in progress for ~A~%Do you want to abort the background process?"  buffer)     ;; Kill the process and wait fot its unwind protects to run.     (send process :reset :always)     (unless        (process-wait-with-timeout "Background Cleanup" (* 60 60)  #'(lambda (buffer) (null (get buffer :background-save-process)))  buffer)       ;; After a minute, Nuke it and continue.       (send process :kill))     (format *query-io* "~&Background save aborted."))    (t     (format *query-io* "~&Cannot do save until background process is complete or aborted.")     (return-from write-mail-file-buffer)))))    ;; Always open the file in foreground -- want errors to happen now, not in background.  (let ((close-flag :abort)(file-format (buffer-mail-file-format buffer))out-stream)    (when (eq (send pathname :version) :unspecific); Versionless filesystem, eg, Unix.      ;;  Append to the right-hand end, wherever it is.      (let ((rename-pathname (if (eq (send pathname :type) :unspecific) (send pathname :new-name (string-append (send pathname :name) *backup-file-append-string*)) (send pathname :new-type (string-append (send pathname :type) *backup-file-append-string*)))))(condition-case (err)    (multiple-value-bind (nil new-path nil)(rename-file pathname rename-pathname)      (format *query-io* "~&Existing mail file renamed to ~A" new-path))  ((sys:network-error fs:file-error)   (format *query-io* "~&Couldn't make a backup by renaming:  ~A." err)   (unless (yes-or-no-p "Save mail file anyway?")     (format *query-io* "Save aborted.")     (return-from write-mail-file-buffer))))))    (unwind-protect(progn  (file-retry-new-pathname (pathname fs:file-lookup-error system:network-error)    (setq out-stream (open pathname :direction :output :if-exists :new-version :characters t)))    (cond (in-background (setf (get buffer :background-save-process)       (process-run-function '(:name "Save Mail File" :priority -5)     #'mail-stream-out file-format buffer pathname out-stream t)) (setq close-flag :dont) (format *query-io* "~&Proceed.  Writing ~A in background." (send out-stream :truename)))(t (mail-stream-out file-format buffer pathname out-stream) (setq close-flag :dont) (print-file-written out-stream))))      (when (and (streamp out-stream) (neq close-flag :dont))(close out-stream :abort close-flag)))))(defun MAIL-STREAM-OUT (file-format buffer pathname out-stream &optional in-background)    (let ((close-flag :abort)(tick *tick*)(*mail-background-p* in-background))    (unwind-protect(progn  ;; Save off current tick so we know if buffer changes while saving  (setf (get buffer :start-mail-file-save-tick) tick)  (with-buffer-lock (buffer)    (send buffer :write-mail-file-start file-format out-stream))  (dolist (msg (message-list buffer))    (with-message-lock (msg)      (send msg :write-message-start file-format out-stream)      (send msg :write-message-headers file-format out-stream)      (send msg :write-message-body file-format out-stream)      (send msg :write-message-end file-format out-stream)))  (send buffer :write-mail-file-end file-format out-stream)  (close out-stream)  (setq close-flag :dont)  ;; writing to another file will not cause buffer name to change  (when (eq pathname (buffer-pathname buffer))    ;;(set-buffer-pathname pathname buffer)    (set-buffer-file-id buffer (send out-stream :info)))  ;; We set the file tick at the time save began in case user modified buffer  ;; since then (e.g. during background save)  (setf (buffer-tick buffer) tick)  (delete-old-mail-files pathname)  (delete-old-inboxes buffer))      (when (and (streamp out-stream) (neq close-flag :dont))(setf (get buffer :start-mail-file-save-tick nil))(send out-stream :close close-flag))      (setf (get buffer :background-save-process) nil))))(defun DELETE-OLD-MAIL-FILES (pathname)    ;; Limit the number of undeleted babyl files per user option  (when (and (numberp *mail-file-versions-kept*);non-number means leave alone     (> *mail-file-versions-kept* 1);small number means leave alone     (eq (send pathname :version) :newest));dangerous to do clean up if anything except newest was written;or if version is :unspecified (indicating a versionless file sys)    (let ((dirlist (fs:directory-list (send pathname :new-version :wild) :sorted :deleted :noerror)))      (when (listp dirlist);; Elimitate the directory entry from list(setq dirlist (deleq (assoc nil dirlist) dirlist))(dotimes (x (- (length dirlist) *mail-file-versions-kept*))  (let ((path (car (nth x dirlist))))    (send path :delete nil)    ;; Expunge if it is allowed.    (when (send path :undeletable-p)      (send path :expunge :error nil))))))))(defmethod (mail-file-buffer :WRITE-MAIL-FILE-START) (file-format out-stream)  "Default method for writing the start of a mail file.  Does nothing."  (declare (ignore file-format out-stream))  nil)(defun (:property :babyl :INITIALIZE-NEW-MAIL-FILE-FUNCTION) (stream)  (format stream "BABYL OPTIONS:~%Version: 5~%~C" *babyl-end-of-message-char*))(defmethod (mail-file-buffer :case :WRITE-MAIL-FILE-START :babyl) (out-stream)  "Write the start of a babyl mail file."  ;; Write the required information.  (write-line "BABYL OPTIONS:" out-stream)  (format out-stream "Version: ~D~%" (or (get-mail-option self :version) #10r5))   (loop for (option value) on mail-options by #'cddrdo(select option  (:mail   (when (and value (listp value))     (format out-stream "Mail: ~{~A~^, ~}~%" value)))    (:owner   (when value     (format out-stream "Owner: ~A~%" value)))    (:no-reformation   (when value     (format out-stream "No Reformation~%")))    (:no-original   (when value     (format out-stream "No Original~%")))    (:labels   (when (and value (listp value))     (format out-stream "Labels: ~{~A~^, ~}~%" value)))    (:filter-alist   (when (and value (listp value))     (format out-stream "Filter-Alist: ~{~S~^, ~}~%" value)))  (:append   (format out-stream "Append: ~D~%" value))  (:unknown-options   (dolist (option value)     (format out-stream "~A~%" option)))))   (format out-stream "~C" *babyl-end-of-message-char*))(defun (:property :text :initialize-new-mail-file-function) (stream)   (write-line "-*- Mode: Text -*-" stream))(defmethod (mail-file-buffer :case :write-mail-file-start :text) (out-stream)   (write-line "-*- Mode: Text -*-" out-stream));;; For external use(defun WRITE-MESSAGE (msg file-format stream)  "Write MSG to STREAM in the specified FILE-FORMAT."  (send msg :write-message-start file-format stream)  (send msg :write-message-headers file-format stream)  (send msg :write-message-body file-format stream)  (send msg :write-message-end file-format stream))(defmethod (message-node :case :WRITE-MESSAGE-START :babyl) (out-stream)    ;; Write start-of-message indicator  (format out-stream "~C~%" *babyl-start-of-message-char*)    ;; Write status line (extra spaces needed to keep slimy ZMAIL out of the infinite EH)  (let ((save-attrs (if (some #'dont-save-attribute-p attributes)(set-difference attributes *dont-save-attribute-list*)      attributes)))    (format out-stream "~D,~{ ~A,~},~{ ~A,~}~%" (if reformatted-p 1 0) save-attrs keywords))    ;; Write unreformatted header  (when original-headers    (stream-copy-until-eof (interval-stream original-headers nil t nil t) out-stream))  (write-line "*** EOOH ***" out-stream)    nil)(defun DONT-SAVE-ATTRIBUTE-P (attribute)  (memeq attribute *dont-save-attribute-list*))(defmethod (message-node :case :WRITE-MESSAGE-START :unix) (out-stream)    (let ((start (get self :unix-start-of-message-line)))    (if start(write-line start out-stream)      (assure-message-parsed self t)      (let ((rtn-path (or (get-message-header self :return-path :header)  (get-message-header self :from :header)  (get-message-header self :reply-to :header)  (get-message-header self :sender :header)))    (date (get-message-header self :date :universal-time)))(princ "From " out-stream)(setq rtn-path (car (send rtn-path :address-list)))(if (null rtn-path)    (princ "unknown" out-stream)  (princ (send rtn-path :address-string) out-stream))(princ "  " out-stream)(if (null date)    (princ "Sun Jan 1 00:00:00 1980" out-stream)  (multiple-value-bind (sec min hour date month year day)      (time:decode-universal-time date)    (format out-stream "~A ~A ~2D ~2,48D:~2,48D:~2,48D ~D"    (time:day-of-the-week-string day :short)    (time:month-string month :short)    date hour min sec year)))(terpri out-stream)))))(defmethod (message-node :case :write-message-start :text) (out-stream)   (write-char #\clear-screen out-stream)   (terpri out-stream))(defmethod (message-node :case :WRITE-MESSAGE-HEADERS :babyl) (out-stream)     (stream-copy-until-eof (interval-stream first-bp headers-end-bp nil t) out-stream)   nil)(defmethod (message-node :case :WRITE-MESSAGE-HEADERS :text) (out-stream)   (stream-copy-until-eof (interval-stream first-bp headers-end-bp nil t) out-stream)   nil)(defmethod (message-node :WRITE-MESSAGE-HEADERS) (file-format out-stream)  "Default method for writing headers of message.  Writes the original header, not the reformatted one."  (declare (ignore file-format))    (if (null original-headers)      (stream-copy-until-eof (interval-stream first-bp headers-end-bp nil t) out-stream)    (stream-copy-until-eof (interval-stream original-headers nil t nil t) out-stream))  nil)(defmethod (message-node :WRITE-MESSAGE-BODY) (file-format out-stream)  (declare (ignore file-format))    (let* ((stop-line (interval-last-non-blank-line self)) (stop-bp (create-bp stop-line (line-length stop-line))))    (stream-copy-until-eof (interval-stream headers-end-bp stop-bp nil t) out-stream))  (terpri out-stream)  (delete-message-attribute :recent self)  nil)(defmethod (message-node :WRITE-MESSAGE-END) (file-format out-stream)  (declare (ignore file-format out-stream))  nil)(defmethod (message-node :case :WRITE-MESSAGE-END :unix) (out-stream)    (terpri out-stream)  (terpri out-stream)  nil)(defmethod (message-node :case :WRITE-MESSAGE-END :babyl) (out-stream)  (format out-stream "~C" *babyl-end-of-message-char*))(defmethod (mail-file-buffer :WRITE-MAIL-FILE-END) (file-format out-stream)  (declare (ignore file-format out-stream))  nil);(defmethod (mail-file-buffer :case :WRITE-MAIL-FILE-END :babyl) (out-stream);  (declare (ignore out-stream));  (terpri out-stream);  nil);;;;;; Some helper functions.;;;(defun PARSE-PATHNAME-LIST (pathname-line)  "Return a list of pathnames from a line read from the mail: property of a babyl file.PATHNAME-LIST is of the form \"pathname,pathname,...\".  If any pathnames do not parse or arenot fully specified, it is stored on the returned list as a string."    (unless (mail:string-blank-p pathname-line)        (do* ((start 0 (+ 1 end))  (len (length pathname-line))  end list path) ((>= start len) list)            (setq end (or (position #\, pathname-line :start start) len))            ;; Pathname parsing is very liberal about what will parse because a "hostless" pathname      ;; defaults to the local host.  But we want to leave alone anything that is not a fully      ;; specifed LispM pathname so as not to muck with pathnames from other systems.  So      ;; fs:parse-pathname-find-colon is used first to ensure we have something with a known      ;; host specified in LispM syntax.      ;; Also, the ignore-errors form should be replaced with a condition-call as soon as      ;; pathname parsing starts returning understandable condition-objects for parse errors (grrr).            (if (and (fs:parse-pathname-find-colon pathname-line start end)       (setq path (ignore-errors (fs:parse-namestring pathname-line nil nil :start start :end end))))  ;;? breaks right now for unix pathnames in Rel3   ;;(push-end (send path :new-version :newest) list)  (push-end path list)  (push-end (subseq pathname-line start end) list)))))(defun READ-LINE-WITH-LEADER (&optional (stream *standard-input*) (eof-error-p t) eof-value       skip-blank-lines)  "Read lines from stream until a non blank line is found"    (loop    (multiple-value-bind (line eof) (send stream :line-in line-leader-size )      (cond (eof     (setf line eof-value)     (if eof-error-p       (ferror 'fs:end-of-file "End of file on ~S." stream)       (return (values line eof))))        (skip-blank-lines     (when (not (mail:string-blank-p line))       ;; Non blank line found, return it.       (return (values line eof))))    (t     (return (values line eof)))))))(defun FIND-MAIL-BUFFER (pathname)  "Return the mail buffer visiting PATHNAME, or NIL if none."  (setf pathname (fs:parse-namestring pathname))  (setf pathname (send pathname :new-version :newest))  (setf pathname (send pathname :translated-pathname))  (dolist (buffer *zmacs-buffer-list*)    (and (fs:pathname-equal pathname (buffer-pathname buffer)) (mail-file-buffer-p buffer) (return buffer))))(defun PREPARE-MAIL-FILE-FOR-APPEND (pathname &optional default-format)    (unless (pathnamep pathname)    (setq pathname (parse-namestring pathname)))    (let* ((generic (send pathname :generic-pathname)) (format (get generic :mail-file-format)) new-file init stream)    (unless format      (with-open-file-case (stream pathname)(fs:file-not-found (unless (y-or-n-p "~&Mail file ~a not found, create it?" pathname)   (barf "Aborted.")) (setq format (or default-format (new-mail-file-format pathname))) (setf (get generic :mail-file-format) format) (setq new-file t))(:no-error (setq format (get-mail-file-format-from-stream stream nil)) (cond ((null format)(barf "Unknown mail file format in ~A" pathname))       ((eq format :empty)(format *query-io* "~&~A is an empty file." pathname)(setq format (new-mail-file-format pathname))(setq new-file t))))))    (cond (new-file   (setq stream (open pathname :direction :output :if-does-not-exist :create))   (and (setq init (get format :initialize-new-mail-file-function))(funcall init stream))   (values stream format))  (t   (values (open pathname :direction :output :if-exists :append :if-does-not-exist :create)   format)))));;; do I use this?  does it work?#|(defun buffer-file-current (buffer &optional stream)    (let ((file-id (buffer-file-id buffer))(pathname (buffer-pathname buffer))file-file-id)    (or (symbolp file-id)(equal file-id       (if stream   (setq file-file-id (send stream :info))   (with-open-file (stream pathname '(:probe :ascii))     (and (not (errorp stream))  (setq file-file-id (send stream :info))))))(values nil(format nil "When you last read or wrote ~A~@        it was ~A,~@        but now it is ~A.~%"pathname(describe-file-id file-id)(if file-file-id (describe-file-id file-file-id) "deleted"))))))|#th this mail file."()  (in-mail-context (:require-buffer t)    (let* ((buffer (curr