Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume8/pcmail/part04

Text File | 1989-11-03 | 37.2 KB | 967 lines

Newsgroups: comp.sources.misc
subject: v08i112: pcmail part 04 of 08
From: [e-mail] (Brandon S. Allbery - comp.sources.misc)
Reply-To: [e-mail] (Croaker the Physician)

Posting-number: Volume 8, Issue 112
Submitted-by: [e-mail] (Croaker the Physician)
Archive-name: pcmail/part04

#--------------------------------CUT HERE-------------------------------------
#! /bin/sh
#
# This is a shell archive.  Save this into a file, edit it
# and delete all lines above this comment.  Then give this
# file to sh by executing the command "sh file".  The files
# will be extracted into the current directory owned by
# you with default permissions.
#
# The files contained herein are:
#
# -rw-rw-r--  1 markl       24644 Nov  1 13:33 pcmailattr.el
# -rw-rw-r--  1 markl       10900 Oct 31 11:50 pcmailmove.el
#
echo 'x - pcmailattr.el'
if test -f pcmailattr.el; then echo 'shar: not overwriting pcmailattr.el'; else
sed 's/^X//' << '________This_Is_The_END________' > pcmailattr.el
X;;;; GNU-EMACS PCMAIL mail reader
X
X;;  Written by Mark L. Lambert
X;;  Architecture Group, Network Products Division
X;;  Oracle Corporation
X;;  20 Davis Dr,
X;;  Belmont CA, 94002
X;;
X;;  internet: [e-mail] or [e-mail]
X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
X
X;; Copyright (C) 1989 Mark L. Lambert
X
X;; This file is not officially part of GNU Emacs, but is being
X;; donated to the Free Software Foundation.  As such, it is
X;; subject to the standard GNU-Emacs General Public License,
X;; referred to below.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;;; global variables
X
X(defvar pcmail-attribute-obarray (make-vector 47 0)
X  "An attribute obarray used for completion in attribute-manipulation
Xcommands.")
X
X;; note the inclusion of pcmail-defined attributes here.  In order to
X;; conform to Babyl, these attributes must also be present in the user-defined
X;; labels section of a babyl mail file header.  Normally this would
X;; automatically load them into the obarray at folder-open time.
X;; Unfortunately some older pcmail mail files won't have them, so we provide
X;; them here for backward compatibility
X
X(mapcar '(lambda (a) (intern a pcmail-attribute-obarray))
X    (append pcmail-babyl-defined-attributes
X        '("printed" "copied" "edited" "timely" "expired"
X          "undigestified" "archived" "precious")))
X
X;;; sticky defaults
X
X(defvar pcmail-last-attr nil
X  "The name of the last attribute given to an attribute command.")
X
X(defvar pcmail-last-priority nil
X  "The last priority assigned a message.")
X
X;;;; priority setting commands
X
X(defun pcmail-change-message-priority (priority)
X  "Change the current message's priority.
XArgs: (priority)
X  Change the current message's priority.  A priority is represented by a
Xnon-zero number, the lower the number the higher the priority; messages can
Xbe sorted by priority using the \\[pcmail-sort-folder\\] command.
XInput defaults to last priority given a message."
X  (interactive
X   (if current-prefix-arg
X       '(nil)
X     (let ((p (pcmail-read-string-default "Message priority: "
X                      pcmail-last-priority t)))
X       (or (> (string-to-int p) 0)
X       (error "Priority must be a number greater than zero."))
X       (list (string-to-int (setq pcmail-last-priority p))))))
X  (pcmail-change-message-priority-1 priority pcmail-current-subset-message 1)
X  (pcmail-update-folder-mode-line pcmail-current-subset-message))
X
X(defun pcmail-change-priority-subset (priority)
X  "Change the current message subset's priority.
XArgs: (priority)
X  Change the current subset's priority.  A priority is represented by a
Xnon-zero number, the lower the number the higher the priority; messages can
Xbe sorted by priority using the \\[pcmail-sort-folder\\] command.
XInput defaults to last priority given a message."
X  (interactive
X   (if current-prefix-arg
X       '(nil)
X     (let ((p (pcmail-read-string-default "Message priority: "
X                      pcmail-last-priority t)))
X       (or (> (string-to-int p) 0)
X       (error "Priority must be a number greater than zero."))
X       (list (string-to-int (setq pcmail-last-priority p))))))
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-priority-1 priority 1 (pcmail-current-subset-length))
X  (pcmail-update-folder-mode-line pcmail-current-subset-message))
X
X(defun pcmail-change-message-priority-1 (p start len)
X  "Change message priorities to P starting with START for LEN subset messages.
XArgs: (p start len)"
X  (pcmail-barf-if-empty-folder)
X  (let ((i start))
X    (unwind-protect
X    (while (< i (+ start len))
X      (pcmail-set-priority (pcmail-make-absolute i) p)
X      (and (zerop (% (- (setq i (1+ i)) start) pcmail-progress-interval))
X           (message "Setting priorities...%d" (- i start))))
X      (pcmail-update-folder-mode-line pcmail-current-subset-message))
X    (and (>= (- i start) pcmail-progress-interval)
X     (message "Setting priorities...done (%d message%s)"
X          (- i start) (pcmail-s-ending (- i start))))))
X
X;;;; attribute-changing operations: deletion, undeletion, general attribute
X;;;; setting and clearing.
X
X(defun pcmail-change-message-attr (attr mode)
X  "Toggle a named attribute of the current message.
XArgs: (attr mode)
X  Toggle a named attribute of the current message.  Completion on input is
Xpermitted; input defaults to last attribute given to an attribute command.
XWith a prefix arg, don't toggle.  If the arg is positive, set the attribute;
Xif negative, clear the attribute."
X  (interactive (list (pcmail-read-attr
X              (concat
X               (cond ((null current-prefix-arg) "Toggle")
X                 ((>= current-prefix-arg 0) "Set")
X                 (t "Clear"))
X               " attribute: "))
X             current-prefix-arg))
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-attr-1 attr
X                (cond ((null mode) 'toggle)
X                      ((>= mode 0) t))
X                pcmail-current-subset-message 1))
X
X(defun pcmail-change-attr-subset (attr mode)
X  "Toggle a named attribute in each message of the current message subset.
XArgs: (attr mode)
X  Toggle a named attribute in each message of the current message subset.
XCompletion on input is permitted; input defaults to last attribute given to
Xan attribute command.  With a prefix arg, don't toggle.  If the arg is
Xpositive, set the attribute; if negative, clear the attribute."
X  (interactive (list (pcmail-read-attr
X              (concat
X               (cond ((null current-prefix-arg) "Toggle")
X                 ((>= current-prefix-arg 0) "Set")
X                 (t "Clear"))
X               " message subset attribute: "))
X             current-prefix-arg))
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-attr-1 attr
X                (cond ((null mode) 'toggle)
X                      ((>= mode 0) t))
X                1 (pcmail-current-subset-length)))
X
X(defun pcmail-change-message-attr-1 (attr state start len)
X  "Munge message attributes in the current message subset.
XArgs: (attr state start len)
X  Set attribute ATTR to STATE for all messages in the current subset from START
Xfor LEN messages.  If STATE is 'toggle, toggle the current attribute state."
X  (let ((i start))
X    (unwind-protect
X    (while (< i (+ start len))
X      (pcmail-set-attribute (pcmail-make-absolute i) attr state)
X      (and (zerop (% (- (setq i (1+ i)) start) pcmail-progress-interval))
X           (message "%sing %s attribute...%d"
X            (cond ((eq state 'toggle) "Toggl")
X                  (state "Sett")
X                  (t "Clear"))
X            attr (- i start))))
X      (pcmail-update-folder-mode-line pcmail-current-subset-message))
X    (and (>= (- i start) pcmail-progress-interval)
X     (message "%sing %s attribute...done (%d message%s)"
X          (cond ((eq state 'toggle) "Toggl")
X            (state "Sett")
X            (t "Clear"))
X          attr (- i start) (pcmail-s-ending (- i start))))))
X
X(defun pcmail-undelete-previous-message ()
X  "Looking backward from the current message, clear the first deleted
Xmessage's delete attribute.
XArgs: none"
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (let ((n (pcmail-next-subset-message-of-type
X        nil nil 'include-current 'pcmail-has-attribute-p "deleted")))
X    (cond (n
X        (pcmail-set-attribute (pcmail-make-absolute n) "deleted" nil)
X        (pcmail-goto-message n))
X      (t
X        (message "No previous deleted message in the current subset.")))))
X
X(defun pcmail-undelete-subset ()
X  "Undelete all messages in the current message subset.
XArgs: none"
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-attr-1 "deleted" nil 1
X                (pcmail-current-subset-length)))
X
X(defun pcmail-delete-message (&optional dont-skip)
X  "Delete this message and move to the next interesting message.
XArgs: (&optional dont-skip)
XDelete this message and move to the next interesting message.  Deleted
Xmessages remain in the folder until the \\[pcmail-expunge-folder] command
Xis given.  With a prefix argument, delete and move to the next message in the
Xcurrent subset whether or not it is interesting."
X  (interactive "P")
X  (pcmail-barf-if-empty-folder)
X  (let ((n pcmail-current-subset-message))
X    (pcmail-set-attribute (pcmail-make-absolute n) "deleted" t)
X    (pcmail-next-message dont-skip)
X    (and (= n pcmail-current-subset-message)
X     (pcmail-update-folder-mode-line n))))
X
X(defun pcmail-delete-message-backward (&optional dont-skip)
X  "Delete this message and move to the previous interesting message.
XArgs: (&optional dont-skip)
X  Delete this message and move to the previous interesting message.
XDeleted messages remain in the folder until the \\[pcmail-expunge-folder]
Xcommand is given.  With a prefix argument, delete and move to the previous
Xmessage in the current subset whether or not it is interesting."
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (let ((n pcmail-current-subset-message))
X    (pcmail-set-attribute (pcmail-make-absolute n) "deleted" t)
X    (pcmail-previous-message dont-skip)
X    (and (= n pcmail-current-subset-message)
X     (pcmail-update-folder-mode-line n))))
X
X(defun pcmail-delete-subset ()
X  "Delete all messages in the current message subset.
XArgs: none
X  Delete all messages in the current message subset.  Deleted messages remain
Xin the folder until the \\[pcmail-expunge-folder] command is given."
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-attr-1 "deleted" t 1 (pcmail-current-subset-length)))
X
X(defun pcmail-zap-to-message ()
X  "Delete all messages in the current subset from the current message forward.
XArgs: none
X  Delete all messages in the current subset from the current message forward.
XDeleted messages remain in the folder until the \\[pcmail-expunge-folder]
Xcommand is given."
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (pcmail-change-message-attr-1 "deleted" t pcmail-current-subset-message
X                (1+ (- (pcmail-current-subset-length)
X                       pcmail-current-subset-message))))
X
X(defun pcmail-kill-message-later (n date)
X  "Arrange for something to happen to a message some time in the future.
XArgs: (n date)
X  If called interactively, read a date of the form dd-mmm-yy from the
Xminibuffer.  N is current message.  If called as a function, supply an
Xabsolute message number and a date string in the form dd-mmm-yy.  Set
Xmessage N's \"timely\" attribute.  Insert an expires: field in the message
Xheader.  When the current date is greater than a message's expiration date,
Xapply the hook pcmail-expiration-hook to the message.  With a prefix argument
X(called interactively) or a DATE value of NIL (called as a function), remove
Xthe expired field and clear the message's \"timely\" attribute, effectively
Xunexpiring the message."
X  (interactive
X   (list (pcmail-make-absolute pcmail-current-subset-message)
X     (if current-prefix-arg
X         nil
X       (let ((expiration))
X         (while
X                 ; string-to-date triple validates date format
X           (not (pcmail-string-to-date-triple
X               (setq expiration
X                 (pcmail-read-string-default
X                  "Expiration date (dd-mmm-yy): " nil t))))
X           (message "Date not dd-mmm-yy.") (ding) (sit-for 2))
X         expiration))))
X  (pcmail-set-message-expiration n date)
X  (pcmail-set-attribute n "timely" (and date t))
X  (pcmail-update-folder-mode-line pcmail-current-subset-message))
X
X;;;; attribute-hacking utilities
X
X;;; two functions that work on messages with relative numbers.  A relative
X;;; message number is that message's index within the current subset.  Its
X;;; absolute number is its index within the entire folder.
X
X(defun pcmail-update-folder-mode-line (n)
X  "Display message information in the mode line.
XArgs: (n)
X  Set pcmail-display-info to string describing message with relative number N.
XThe string is formatted by the directives in pcmail-folder-mode-line-format.
XSee description of that variable for details.  The formatted string will be
Xdisplayed in the mode line."
X  (setq pcmail-display-info
X    (pcmail-format-string
X     pcmail-folder-mode-line-format
X     (list (list "s" '(lambda (n) n) n)
X           (list "S" '(lambda () (pcmail-current-subset-length)))
X           (list "e" '(lambda ()
X                (if (eq major-mode 'pcmail-edit-mode)
X                "Editing "
X                  "")))
X           (list "E" '(lambda (n)
X                (let ((abs (pcmail-make-absolute n)) (exp))
X                  (if (and (pcmail-has-attribute-p abs "timely")
X                       (setq exp
X                         (pcmail-message-expiration abs)))
X                  (concat "Expires: " exp)
X                "")))
X             n)
X           (list "n"
X             '(lambda (n)
X            (cond ((or (/= (pcmail-current-subset-length)
X                       pcmail-total-messages)
X                   (/= n (pcmail-make-absolute n)))
X                   (format "[%d/%d]" (pcmail-make-absolute n)
X                       pcmail-total-messages))
X                  (t
X                   ""))) n)
X           (list "f" '(lambda () pcmail-folder-name))
X           (list "a"
X             '(lambda (n)
X            (let ((attrs (aref pcmail-attr-vector
X                       (pcmail-make-absolute n))))
X              (if attrs
X                  (mapconcat 'identity attrs ", ")
X                "[no attributes]"))) n)
X           (list "l"
X             '(lambda (n)
X            (pcmail-message-line-count (pcmail-make-absolute n)))
X             n)
X           (list "c"
X             '(lambda (n)
X            (pcmail-message-char-count (pcmail-make-absolute n)))
X             n)
X           (list "p"
X             '(lambda (n)
X            (let ((p (pcmail-message-priority
X                  (pcmail-make-absolute n))))
X              (if (= p 1) ""
X                (format "Priority: %d" p))))
X             n))))
X  (and (= n pcmail-current-subset-message)
X       (pcmail-force-mode-line-update)))
X
X(defun pcmail-next-subset-message-of-type (forward-p invert-p include-current-p
X                       pred &rest args)
X  "Return the number of the next message that satisfies a predicate.
XArgs: (forward-p invert-p include-current-p pred &rest args)
X  Starting with the current subset message if INCLUDE-CURRENT-P is non-nil,
Xthe first message after/before current otherwise, return the number of the
Xfirst subset message that satisfies PRED applied to ARGS, or if INVERT-P is
Xnon-NIL, does not satisfy PRED applied to ARGS.  Search forward
Xif FORWARD-P is non-nil, backward else.  If no such message is found,
Xreturn NIL."
X  (let ((found) (current pcmail-current-subset-message))
X    (or include-current-p
X    (setq current (funcall (if forward-p '1+ '1-) current)))
X    (while (and (not found)
X        (funcall (if forward-p '<= '>=) current
X             (if forward-p (pcmail-current-subset-length) 1)))
X      (and (if invert-p
X           (not (apply pred (pcmail-make-absolute current) args))
X         (apply pred (pcmail-make-absolute current) args))
X       (setq found current))
X      (setq current (funcall (if forward-p '1+ '1-) current)))
X    found))
X
X;;; all following routines deal with absolute-numbered messages
X
X(defun pcmail-hack-timely-messages (tl)
X  "Given a list of timely messages, figure out what to do with them.
XArgs: (tl)
X  TL is a list of message numbers, corresponding to messages with the
X\"timely\" attribute set.  If any of these messages has an expired: header
Xfield earlier than the current date, apply pcmail-expiration-hook to
Xthe message number."
X  (let ((now-days (pcmail-date-triple-to-ndays
X           (pcmail-string-to-date-triple))))
X    (mapcar
X     '(lambda (n)
X    (let ((expiration (pcmail-message-expiration n)))
X      (cond ((and expiration
X              pcmail-expiration-hook
X              (not (pcmail-has-attribute-p n "expired"))
X              (setq expiration
X                (pcmail-string-to-date-triple expiration))
X              (setq expiration
X                (pcmail-date-triple-to-ndays expiration))
X              (<= expiration now-days))
X         (funcall pcmail-expiration-hook n)
X         (pcmail-set-attribute n "expired" t)
X         (pcmail-set-attribute n "timely" nil)))))
X     tl)))
X
X(defun pcmail-set-message-expiration (n date)
X  "Set message absolute-numbered N's expiration to DATE.
XArgs: (n date)
X N is an absolute message number, DATE is a date string dd-mmm-yy.
XRemove N's expires: field if it has one.  If DATE is non-nil, place its
Xentries in a new expires: field."
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-unpruned-header n)
X      (goto-char (point-min))
X      (let ((buffer-read-only nil)
X        (case-fold-search t))
X    (and (re-search-forward "^expires:.*\n\\([ \t]+.*\n\\)*" nil t)
X         (replace-match ""))
X    (and date (insert "Expires: " date "\n"))))))
X
X(defun pcmail-message-expiration (n)
X  "Return message absolute-numbered N's expiration date as a date string
XArgs: (n)
X  If N has a a valid expired: field in the form \"dd mm yy\", return it,
Xelse return NIL."
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-unpruned-header n)
X      (goto-char (point-min))
X      (mail-fetch-field "expires"))))
X
X(defun pcmail-interesting-p (n)
X  "Return non-NIL if message absolute-numbered N is interesting, NIL else.
XArgs: (n)
X  Return non-NIL if message absolute-numbered N is interesting, NIL else.
XMessage N is interesting if pcmail-interesting-hook returns non-NIL
Xwhen applied to N.  If pcmail-interesting-hook is NIL, all messages
Xare interesting."
X  (if pcmail-interesting-hook
X      (funcall pcmail-interesting-hook n)
X    t))
X
X(defun pcmail-has-attribute-p (n attr)
X  "Check an attribute's membership in a message attribute list.
XArgs: (n attr)
X  Return T if ATTR is a member of message absolute-numbered N's attribute
Xlist, NIL else."
X  (pcmail-in-sequence-p attr (aref pcmail-attr-vector n)))
X
X(defun pcmail-set-attribute (n attr state)
X  "Set, clear, or toggle a message attribute.
XArgs: (n attr state)
X  Set message absolute-numbered N's attribute ATTR to STATE.  If STATE is
X'toggle, toggle the attribute's state.  If ATTR is \"deleted\", do not
Xset state to non-NIL if N already has the \"precious\" attribute"
X  (pcmail-barf-if-empty-folder)
X  (or (pcmail-attribute-p attr)
X      (error "No attribute named %s." attr))
X  (let ((curstate (pcmail-babyl-attr-present-p n attr)))
X    (cond ((and curstate (or (eq state 'toggle) (not state)))
X       (pcmail-remove-from-message-attribute-list n attr)
X       (pcmail-remove-babyl-attr n attr))
X      ((and (not curstate) state
X        (if (and (pcmail-has-attribute-p n "precious")
X             (string= attr "deleted"))
X            nil
X          t))
X       (pcmail-add-to-message-attribute-list n attr)
X       (pcmail-add-babyl-attr n attr))))
X
X  ; this may have screwed up the region around the current message.  Fix it.
X  (pcmail-narrow-to-message
X   (pcmail-make-absolute pcmail-current-subset-message))
X  state)
X
X(defun pcmail-priority-less-than-p (a b)
X  "Args: (a b)
XReturn T is message A's priority is higher (less than) B's, NIL else."
X  (< (pcmail-message-priority a) (pcmail-message-priority b)))
X
X(defun pcmail-message-priority (n)
X  "Return specified message's Priority: field contents as a number.
XArgs: (n)
X  First search the pcmail-priority-vector cache for a priority number.  If
Xnone is found, get message N's Priority: field and turn it into a number.
XIf no priority exists, return the highest priority, 1."
X  (or (aref pcmail-priority-vector n)
X      (aset pcmail-priority-vector n
X        (cond ((zerop n)
X           1)
X          (t
X            (save-excursion
X              (save-restriction
X            (let ((case-fold-search t))
X              (pcmail-narrow-to-unpruned-header n)
X              (let ((p (mail-fetch-field "priority")))
X                (if p (string-to-int p) 1))))))))))
X
X(defun pcmail-set-priority (n p)
X  "Set message absolute-numbered N's priority to P.  Kill priority if P is NIL.
XArgs: (n p)"
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-unpruned-header n)
X      (goto-char (point-min))
X      (let ((buffer-read-only nil)
X        (case-fold-search t))
X    (and (re-search-forward "^priority:.*\n\\([ \t]+.*\n\\)*" nil t)
X         (replace-match ""))
X    (and p
X         (insert "Priority: " (int-to-string p) "\n"))
X    (aset pcmail-priority-vector n (or p 1))))))
X
X;; sort routines for sort by from or to fields.  Shouldn't be here, but I
X;; can't think of a better place to put them
X
X(defun pcmail-from-field-less-than-p (a b)
X  "Return t if message A's from field is lexicographically less than B's
XArgs: (a b)"
X  (let ((afrom) (bfrom))
X    (save-excursion
X      (save-restriction
X    (pcmail-narrow-to-unpruned-header a)
X    (setq afrom (mail-strip-quoted-names
X             (or (mail-fetch-field "resent-from")
X             (mail-fetch-field "resent-sender")
X             (mail-fetch-field "from")
X             (mail-fetch-field "sender")
X             "")))))
X    (save-excursion
X      (save-restriction
X    (pcmail-narrow-to-unpruned-header b)
X    (setq bfrom (mail-strip-quoted-names
X             (or (mail-fetch-field "resent-from")
X             (mail-fetch-field "resent-sender")
X             (mail-fetch-field "from")
X             (mail-fetch-field "sender")
X             "")))))
X    (string< afrom bfrom)))
X
X(defun pcmail-to-field-less-than-p (a b)
X  "Return t if message A's to field is lexicographically less than B's
XArgs: (a b)"
X  (let ((ato) (bto))
X    (save-excursion
X      (save-restriction
X    (pcmail-narrow-to-unpruned-header a)
X    (setq ato (mail-strip-quoted-names
X           (or (mail-fetch-field "resent-to")
X               (mail-fetch-field "resent-apparently-to")
X               (mail-fetch-field "to")
X               (mail-fetch-field "apparently-to") ;uck
X               "")))))
X    (save-excursion
X      (save-restriction
X    (pcmail-narrow-to-unpruned-header b)
X    (setq bto (mail-strip-quoted-names
X           (or (mail-fetch-field "resent-to")
X               (mail-fetch-field "resent-apparently-to")
X               (mail-fetch-field "to")
X               (mail-fetch-field "apparently-to") ;uck
X               "")))))
X    (string< ato bto)))
X
X;;; utilities which know how folder attribute names are stored.  All
X;;; the following are internal to pcmailattr.el
X;;;
X;;; system-defined attributes are interned in a completion obarray at load
X;;; time.  New user-defined attributes are interned into the obarray as
X;;; needed, as well as installed in the current folder's babyl header
X;;; labels: field.  Old user-defined attributes are read from labels: fields
X;;; and interned into the obarray as folders are opened for the first time
X
X(defun pcmail-add-to-message-attribute-list (n attr)
X  "Add an attribute to a message's attribute list.
XArgs (n attr)
X  Add attribute string ATTR to message absolute-numbered N's attribute list."
X  (aset pcmail-attr-vector n
X    (cons attr (aref pcmail-attr-vector n))))
X
X(defun pcmail-remove-from-message-attribute-list (n attr)
X  "Remove an attribute from a message's attribute list.
XArgs: (n attr)
X  Remove attribute string ATTR from message absolute-numbered N's attribute
Xlist."
X  (let ((attrs (aref pcmail-attr-vector n))
X    (temp))
X    (while attrs
X      (or (string= attr (car attrs))
X      (setq temp (cons (car attrs) temp)))
X      (setq attrs (cdr attrs)))
X    (aset pcmail-attr-vector n temp)))
X
X(defun pcmail-read-attr (prompt)
X  "Read an attribute from the minibuffer.
XArgs: (prompt)
X  Read an attribute from the minibuffer, prompting with PROMPT.  Blank input
Xcauses the value of pcmail-last-attr to be used.  Non-blank input completes
Xoff pcmail-attribute-obarray, setting pcmail-last-attr to be the input just
Xreceived.  If the attribute is not in the obarray ask if it should be put
Xthere as well as in the current folder's Babyl header labels: field."
X  (or (pcmail-attribute-p pcmail-last-attr)
X      (setq pcmail-last-attr nil))
X  (let ((a (pcmail-completing-read prompt pcmail-attribute-obarray
X                   pcmail-last-attr)))
X    (or (pcmail-attribute-p a)
X    (if (y-or-n-p "Undefined attribute; install? ")
X        (pcmail-install-attribute a)
X      (error "Aborted.")))
X    (setq pcmail-last-attr a)))
X
X(defun pcmail-attribute-p (a)
X  "Return non-NIL if A is a valid attribute, NIL else.
XArgs: (a)"
X  (and (stringp a) (intern-soft a pcmail-attribute-obarray)))
X
X(defun pcmail-legal-attribute-name-p (a)
X  "Return non-NIL if A is a legal attribute string, NIL else.
XArgs: (a)"
X  (not (string-match "," a)))
X
X(defun pcmail-load-user-defined-attributes ()
X  "Intern user-defined labels.
XArgs: none"
X  (mapcar '(lambda (x) (intern x pcmail-attribute-obarray))
X      (pcmail-user-defined-babyl-attr-list)))
X
X(defun pcmail-install-attribute (attr)
X  "Install a user-defined message attribute.
XArgs: (attr)
X  Place attribute ATTR in the completion obarray pcmail-attribute-obarray."
X  (or (pcmail-legal-attribute-name-p attr)
X      (error "%s is not a legal attribute name."))
X  (pcmail-insert-user-defined-babyl-attr attr)
X  (intern attr pcmail-attribute-obarray))
X
X(provide 'pcmailattr)
X
________This_Is_The_END________
if test `wc -c < pcmailattr.el` -ne 24644; then
    echo 'shar: pcmailattr.el was damaged during transit (should have been 24644 bytes)'
fi
fi        ; : end of overwriting check
echo 'x - pcmailmove.el'
if test -f pcmailmove.el; then echo 'shar: not overwriting pcmailmove.el'; else
sed 's/^X//' << '________This_Is_The_END________' > pcmailmove.el
X;;;; GNU-EMACS PCMAIL mail reader
X
X;;  Written by Mark L. Lambert
X;;  Architecture Group, Network Products Division
X;;  Oracle Corporation
X;;  20 Davis Dr,
X;;  Belmont CA, 94002
X;;
X;;  internet: [e-mail] or [e-mail]
X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
X
X;; Copyright (C) 1989 Mark L. Lambert
X
X;; This file is not officially part of GNU Emacs, but is being
X;; donated to the Free Software Foundation.  As such, it is
X;; subject to the standard GNU-Emacs General Public License,
X;; referred to below.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;;; movement and display commands within a single folder
X
X;;; movement commands
X
X(defun pcmail-beginning-of-message ()
X  "Move to the beginning of the current message.
XArgs: none"
X  (interactive)
X  (pcmail-barf-if-empty-folder)
X  (pcmail-goto-message pcmail-current-subset-message))
X
X(defun pcmail-goto-message (&optional n)
X  "Move to message number N of the current subset and display it.
XArgs: (&optional n)
XDisplay message N in the current folder's curent subset.  If called
Xinteractively, N is specified by a numeric prefix argument.  If not
Xspecified, N defaults to the first message in the subset."
X  (interactive "p")
X  (pcmail-display-subset-message (or n (setq n 1))))
X
X(defun pcmail-last-message (&optional dont-skip)
X  "Move to the last interesting message in the current subset and display it.
XArgs: (&optional dont-skip)
X  Display the last interesting message in the current folder's current subset.
Xpcmail-interesting-p returns non-NIL when applied to an interesting message.
XIf called interactively, a prefix argument means move to the last message in
Xthe subset whether interesting or not."
X  (interactive "P")
X  (pcmail-barf-if-empty-folder)
X  (let ((n))
X    (cond (dont-skip
X        (setq n (pcmail-current-subset-length)))
X      (t
X        (let ((pcmail-current-subset-message
X            (pcmail-current-subset-length)))
X          (setq n (pcmail-next-subset-message-of-type
X            nil nil 'include-current 'pcmail-interesting-p)))))
X    (cond (n
X       (pcmail-goto-message n))
X      (t
X       (pcmail-goto-message 1)
X       (message "No interesting messages in this folder")))))
X
X(defun pcmail-next-message (&optional dont-skip)
X  "Move to the next interesting message in the current subset and display it.
XArgs: (&optional dont-skip)
X  Display the next interesting message in the current folder's current subset.
Xpcmail-interesting-p returns non-NIL when applied to an interesting message.
XIf called interactively, a prefix argument means move to the next message in
Xthe subset whether interesting or not."
X  (interactive "P")
X  (pcmail-barf-if-empty-folder)
X  (let ((n))
X    (cond (dont-skip
X        (setq n (1+ pcmail-current-subset-message)))
X      (t
X        (setq n (pcmail-next-subset-message-of-type
X              'forward nil nil 'pcmail-interesting-p))))
X    (cond (n
X        (pcmail-goto-message n))
X      (t
X        (message "No further interesting messages.")))))
X
X(defun pcmail-next-message-of-type (filter-name)
X  "Move to the next message in the current subset that satisfies a predicate.
XArgs: (filter)
X  If called interactively, read a filter name from the minibuffer, use
Xit to read that filter's arguments and get the filter predicate.  If called
Xas a function, supply a valid filter name.  Move to and display the next
Xsuch message."
X  (interactive
X   (list (pcmail-read-filter-name "Show next message in filter: ")))
X  (pcmail-barf-if-empty-folder)
X  (let ((i (1+ pcmail-current-subset-message))
X    (found)
X    (pred (pcmail-get-filter filter-name))
X    (pcmail-current-tested-message)) ;inherited by predicates
X    (while (and (not found) (<= i (pcmail-current-subset-length)))
X      (setq pcmail-current-tested-message (pcmail-make-absolute i))
X      (and (eval pred)
X       (setq found i))
X      (setq i (1+ i)))
X    (cond (found
X       (pcmail-goto-message found))
X      (t
X       (error "No more such messages in the current subset.")))))
X
X(defun pcmail-previous-message (&optional dont-skip)
X  "Move to the previous interesting message in the current subset and display.
XArgs: (&optional dont-skip)
X  Display the previous interesting message in the current folder's current
Xsubset.  pcmail-interesting-p returns non-NIL when applied to an interesting
Xmessage.  If called interactively, a prefix argument means move to the
Xprevious message in the subset whether interesting or not."
X  (interactive "P")
X  (pcmail-barf-if-empty-folder)
X  (let ((n))
X    (cond (dont-skip
X        (setq n (1- pcmail-current-subset-message)))
X      (t
X        (setq n (pcmail-next-subset-message-of-type
X              nil nil nil 'pcmail-interesting-p))))
X    (cond (n
X        (pcmail-goto-message n))
X      (t
X        (message "No previous interesting messages.")))))
X
X
X(defun pcmail-previous-message-of-type (filter-name)
X  "Move to the previous message in the current subset satisfying a predicate.
XArgs: (filter)
X  If called interactively, read a filter name from the minibuffer, use
Xit to read that filter's arguments and get the filter predicate.  If called
Xas a function, supply a valid filter name.  Move to and display the first
Xprevious such message."
X  (interactive
X   (list (pcmail-read-filter-name "Show previous message in filter: ")))
X  (pcmail-barf-if-empty-folder)
X  (let ((i (1- pcmail-current-subset-message))
X    (found)
X    (pred (pcmail-get-filter filter-name))
X    (pcmail-current-tested-message)) ;inherited by predicates
X    (while (and (not found) (>= i 1))
X      (setq pcmail-current-tested-message (pcmail-make-absolute i))
X      (and (eval pred)
X       (setq found i))
X      (setq i (1- i)))
X    (cond (found
X       (pcmail-goto-message found))
X      (t
X       (error "No previous such messages in the current subset.")))))
X
X;;; movement utility routines
X
X(defun pcmail-display-subset-message (n)
X  "Display the Nth message in the current subset.
XArgs: (n)"
X  (let ((msg)
X    (absolute))
X    (cond ((< n 1)
X       (setq n (min 1 (pcmail-current-subset-length))
X         msg "Beginning of folder")
X       (setq pcmail-current-subset-message 1))
X      ((> n (pcmail-current-subset-length))
X       (setq n (pcmail-current-subset-length)
X         msg "End of folder")
X       (setq pcmail-current-subset-message
X         (pcmail-current-subset-length)))
X      (t
X        (setq pcmail-current-subset-message n)))
X    (setq absolute (pcmail-make-absolute n))
X    (or (pcmail-header-pruned-p absolute)
X    (pcmail-prune-header absolute))
X    (and (pcmail-has-attribute-p absolute "unseen")
X     (pcmail-set-attribute absolute "unseen" nil))
X    (pcmail-narrow-to-message absolute)
X    (pcmail-update-folder-mode-line n)
X    (and msg (message msg))))
X
X(defun pcmail-message-char-count (n)
X  "Return number of characters in message absolute-numbered N.
XArgs: (n)"
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-message n)
X      (- (point-max) (point-min)))))
X
X(defun pcmail-message-line-count (n)
X  "Return number of lines in message absolute-numbered N.
XArgs: (n)"
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-message n)
X      (count-lines (point-min) (point-max)))))
X
X(defun pcmail-message-contents (n)
X  "Return message N's contents
XArgs: (n)
X  Returns contents of message absolute-numbered N, including all Babyl header
Xand trailer information, as a string."
X  (save-restriction
X    (widen)
X    (buffer-substring (pcmail-msgbeg n) (pcmail-msgend n))))
X
X(defun pcmail-maybe-set-message-vectors ()
X  "Reset message vectors if any are NIL.
XArgs: none"
X  (or (and pcmail-total-messages
X       pcmail-current-subset-message
X       pcmail-attr-vector
X       pcmail-message-vector)
X      (pcmail-set-message-vectors)))
X
X(defun pcmail-set-message-vectors (&optional start)
X  "Scan folder, setting up message information vectors.
XArgs: (&optional start)
X  Set up current buffer's message information vectors.  Build current
Xsubset using default filter name.  Deal with expired messages.  Message
Xscan begins at buffer position START, if present.  If start is not present,
Xflush old message counters before scan, otherwise append new information
Xto old counters.  See also pcmail-scan-babyl-messages."
X  (let ((total-messages 0)
X    (i 0)
X    (case-fold-search)
X    (timely-list)
X    (messages-list)
X    (filter)
X    (filter-start)
X    (attr-list))
X    (unwind-protect
X    (progn
X      (cond ((null start)        ;new?
X         (and (vectorp pcmail-message-vector)
X              (while (< i (length pcmail-message-vector))
X            (move-marker (aref pcmail-message-vector i) nil)
X            (setq i (1+ i))))
X         (setq pcmail-message-vector
X               (make-vector 1
X                    (save-restriction
X                      (widen)
X                      (point-min-marker)))
X               pcmail-current-subset-message 1
X               pcmail-attr-vector nil
X               pcmail-total-messages -1
X               pcmail-date-vector (make-vector 1 nil)
X               pcmail-priority-vector (make-vector 1 nil)
X               pcmail-summary-vector (make-vector 1 nil)
X               filter (pcmail-filter-description
X                   pcmail-default-filter-name)))
X        (t            ;or append?
X         (setq filter-start (1+ pcmail-total-messages)
X               filter pcmail-current-filter-description)))
X      (pcmail-scan-babyl-messages start))
X      (setq pcmail-message-vector
X        (vconcat pcmail-message-vector (apply 'vector messages-list))
X        pcmail-attr-vector
X        (vconcat pcmail-attr-vector (apply 'vector attr-list))
X        pcmail-date-vector
X        (vconcat pcmail-date-vector (make-vector total-messages nil))
X        pcmail-priority-vector
X        (vconcat pcmail-priority-vector (make-vector total-messages nil))
X        pcmail-summary-vector
X        (vconcat pcmail-summary-vector (make-vector total-messages nil))
X        pcmail-total-messages (+ pcmail-total-messages total-messages))
X      (pcmail-build-subset-membership filter filter-start)
X      (pcmail-hack-timely-messages timely-list)
X      (and (>= total-messages pcmail-progress-interval)
X       (message "Counting messages in %s...done (%d message%s)"
X            pcmail-folder-name total-messages
X            (pcmail-s-ending total-messages))))))
X
X(defun pcmail-msgbeg (n)
X  "Return marker position of beginning of message absolute-numbered N.
XArgs: none"
X  (aref pcmail-message-vector n))
X
X(defun pcmail-msgend (n)
X  "Return marker position of end of message absolute-numbered N.
XArgs: none"
X  (aref pcmail-message-vector (1+ n)))
X
X(provide 'pcmailmove)
________This_Is_The_END________
if test `wc -c < pcmailmove.el` -ne 10900; then
    echo 'shar: pcmailmove.el was damaged during transit (should have been 10900 bytes)'
fi
fi        ; : end of overwriting check
exit 0