Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume8 / pcmail / part07 < prev next >

Wrap

Text File | 1989-11-03 | 50.0 KB | 1,290 lines

Newsgroups: comp.sources.misc subject: v08i115: pcmail part 07 of 08 From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Reply-To: markl@oracle.com (Croaker the Physician) Posting-number: Volume 8, Issue 115 Submitted-by: markl@oracle.com (Croaker the Physician) Archive-name: pcmail/part07 #--------------------------------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 17622 Oct 30 16:57 pcmailsub.el # -rw-rw-r-- 1 markl 30775 Oct 30 15:47 pcmailsysdep.el # echo 'x - pcmailsub.el' if test -f pcmailsub.el; then echo 'shar: not overwriting pcmailsub.el'; else sed 's/^X//' << '________This_Is_The_END________' > pcmailsub.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: markl@oracle.com or markl%oracle.com@apple.com 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;;; system-defined globals X X(defvar pcmail-key-alist X '(("date" pcmail-date-less-than-p) X ("priority" pcmail-priority-less-than-p) X ("from" pcmail-from-field-less-than-p) X ("to" pcmail-to-field-less-than-p)) X "Completion list of sort types.") X X(defvar pcmail-filter-alist X '(("string" (pcmail-contains-string-p pcmail-last-search) X (setq pcmail-last-search X (pcmail-read-string-default "Search string (regexp): " X pcmail-last-search))) X ("address" (pcmail-has-address-p pcmail-last-addresses) X (setq pcmail-last-addresses X (pcmail-read-string-default "Addresses: " X pcmail-last-addresses))) X ("attribute" (pcmail-contains-attribute-p pcmail-last-filter-attr) X (setq pcmail-last-filter-attr X (pcmail-read-attr "Attribute: "))) X ("numeric-range" (pcmail-within-numeric-range-p pcmail-last-numeric-range) X (setq pcmail-last-numeric-range X (pcmail-read-numeric-range))) X ("date-range" (pcmail-within-date-range-p pcmail-last-date-range) X (setq pcmail-last-date-range (pcmail-read-date-range))) X ("interesting" (pcmail-subset-interesting-message-p)) X ("unseen" (pcmail-contains-attribute-p "unseen")) X ("unanswered" (not (pcmail-contains-attribute-p "answered"))) X ("todays" (pcmail-within-date-range-p (list pcmail-today pcmail-today)) X (setq pcmail-today (pcmail-string-to-date-triple))) X ("all" t)) X "List of filter names, expressions, and setup functions. When using Xa particular filter, the setup function (if non-NIL) is run through Xeval to set up any arguments needed by the filter. Then each message Xin the folder is applied to the filter expression. The variable Xpcmail-current-tested-message is bound to the absolute number of the Xmessage being tested before the function is called. This allows the Xfunction to access the current absolute message number without Xrequiring that it do so. The filter expression is run through eval Xbecause the expression arguments must be evaluated at filter time and Xcan change on successive applications of the filter. For each message Xrun through the filter, if the filter expression evaluates non-NIL, Xthe message is included in the resulting subset.") X X;;; defaults X X(defvar pcmail-current-filter-description t X "Current filter expression.") X X(defvar pcmail-last-search nil X "The last regular expression given to a search command.") X X(defvar pcmail-last-addresses nil X "The last comma-separated list of addresses given to an address command.") X X(defvar pcmail-last-numeric-range nil X "The last numeric range given to a numeric range command. A numeric range Xis a list of two numbers, low end and high end.") X X(defvar pcmail-last-date-range nil X "The last date range given to a date range command. A date range is a pair Xof triples (day month year), low end and high end.") X X(defvar pcmail-last-filter-name nil X "The last filter name given to a filter command.") X X(defvar pcmail-last-key nil X "The last key name given a sort command.") X X;;;; subset maintenance commands and utilities X X;;; subset commands X X(defun pcmail-filter-folder (filter-name) X "Run the current folder through a specified filter. XArgs: (filter-name) X Get a filter name and associated arguments from the minibuffer. Completion Xof input is permitted; input defaults to last filter name requested. Apply Xthe filter's predicate to each message in the current folder. Messages Xwhich pass through the filter comprise the current subset and are the only Xaccessible messages in the current folder. If the desired subset is Xempty, do nothing. User-defined filters are defined in your emacs Xstartup file using the pcmail-define-filter function." X (interactive (list (pcmail-read-filter-name))) X (cond ((pcmail-build-subset-membership (pcmail-get-filter filter-name)) X (pcmail-goto-message 1) X (pcmail-maybe-resummarize-folder)) X (t X (error "Desired subset is empty.")))) X X(defun pcmail-expand-subset () X "Expand the current subset to include all messages in the current folder. XArgs: none" X (interactive) X (let ((n (pcmail-make-absolute pcmail-current-subset-message))) X (pcmail-build-subset-membership t) X (pcmail-goto-message n) X (pcmail-maybe-resummarize-folder))) X X(defun pcmail-sort-folder (key-name) X "Sort the current subset by one of several keys. XArgs: (key-name) X Sort the current subset by one of several keys. If called interactively, Xspecifiy a key in the minibuffer. Completion on input is permitted; input Xdefaults to last key given this command." X (interactive X (list (pcmail-completing-read "Key name: " pcmail-key-alist X pcmail-last-key))) X (let ((key-entry (pcmail-search-entry-list key-name pcmail-key-alist)) X (subset) (i 0)) X (or key-entry X (error "Unknown sort key.")) X (setq pcmail-last-key key-name) X (message "Sorting %s by %s..." pcmail-folder-name key-name) X X ;; convert subset vector to a list since sort works only on lists X (while (< i (length pcmail-current-subset-vector)) X (setq subset (cons (aref pcmail-current-subset-vector i) subset)) X (setq i (1+ i))) X (setq pcmail-current-subset-vector X (apply 'vector (sort (nreverse subset) (nth 1 key-entry)))) X (pcmail-maybe-resummarize-folder) X (message "Sorting %s by %s...done" pcmail-folder-name key-name))) X X(defun pcmail-define-filter (name sexp input-fn) X "Install a user-defined filter. XArgs: (name sexp input-fn) X Create a filter entry named NAME with description SEXP and argument-input Xfunction INPUT-FN, and install it in the assoc list pcmail-filter-alist. XIf a filter by that name already exists, ask for overwrite permission unless Xthe name is the special filter named \"all\", in which case overwriting is not Xpermitted." X (and (string= name "all") X (error "Cannot overwrite the \"all\" filter")) X (let ((ent)) X (and (setq ent (pcmail-filter-exists-p name)) X (if (y-or-n-p "Filter exists; overwrite? ") X (setq pcmail-filter-alist (delq ent pcmail-filter-alist)) X (error "Aborted."))) X (setq pcmail-filter-alist X (cons (list name sexp input-fn) pcmail-filter-alist)))) X X;;; subset utility routines X X(defun pcmail-build-subset-membership (pred &optional start) X "Create a subset of messages that satisfy PRED XArgs: (pred &optional start) X Using filter description PRED, build a vector of messages that Xsatisfy that description. If START is NIL, begin at message 1, replacing Xthe current subset with the subset generated by this function (unless it is Xof zero length). If START is non-NIL, begin membership testing at message XSTART, appending any new members to the current subset." X (condition-case nil X (let ((pcmail-current-tested-message (or start 1)) X (subset)) X (while (<= pcmail-current-tested-message pcmail-total-messages) X (and (eval pred) X (setq subset (cons pcmail-current-tested-message subset))) X (and (zerop (% (- (setq pcmail-current-tested-message X (1+ pcmail-current-tested-message)) X (or start 1)) X pcmail-progress-interval)) X (message "Checking filter membership...%d" X pcmail-current-tested-message))) X (and (>= (- pcmail-current-tested-message (or start 1)) X pcmail-progress-interval) X (message "Checking filter membership...done (%d message%s)" X (length subset) (pcmail-s-ending (length subset)))) X (and (or subset (eq pred t)) X (setq pcmail-current-filter-description pred X pcmail-current-subset-vector X (vconcat (if start X pcmail-current-subset-vector X (make-vector 1 0)) X (apply 'vector (nreverse subset))))) X subset) X (quit X nil))) X X(defun pcmail-fix-expunged-subset (map) X "Remove expunged messages from the current subset XArgs: (map) X MAP is a vector pcmail-total-messages long, with entries that are either Xa message's post-expunge message number, or NIL if the message was expunged. XThis function updates the current subset vector's message numbers to their Xpost-expunged values." X (let ((new-subset) X (map-ent) X (i 0)) X (unwind-protect X (while (< i (length pcmail-current-subset-vector)) X (setq map-ent (aref map (aref pcmail-current-subset-vector i))) X (and map-ent X (setq new-subset (cons map-ent new-subset))) X (setq i (1+ i))) X (setq pcmail-current-subset-vector X (apply 'vector (nreverse new-subset)))))) X X(defun pcmail-make-absolute (n) X "Return Nth subset message's absolute message number XArgs: (n) X Convert relative message number N into an absolute number by indexing into Xthe current subset membership vector. If N is larger than the current Xsubset length, return last subset message's absolute number. If no absolute Xexists, return 0." X (setq n (min n (pcmail-current-subset-length))) X (or (aref pcmail-current-subset-vector n) 0)) X X(defun pcmail-filter-description (name) X "Return named filter's description. Signal an error if filter not found XArgs: (name)" X (let ((ent (pcmail-filter-exists-p name))) X (or ent X (error "No filter named %s" name)) X (nth 1 ent))) X X(defun pcmail-filter-exists-p (name) X "If NAME is a valid filter, return its assoc list entry, else NIL. XArgs: (name)" X (pcmail-search-entry-list name pcmail-filter-alist)) X X(defun pcmail-current-subset-length () X "Return the number of messages in the current subset. XArgs: none" X (1- (length pcmail-current-subset-vector))) X X(defun pcmail-read-filter-name (&optional pr) X "Read a filter name from the minibuffer. XArgs: (&optional PROMPT) XRead a filter name from the minibuffer. Completion is permitted; input Xdefaults to pcmail-last-filter-name. Signal an error if supplied filter Xname is invalid." X (let ((s (pcmail-completing-read (or pr "Filter name: ") pcmail-filter-alist X pcmail-last-filter-name))) X (or (pcmail-filter-exists-p s) X (error "No filter named %s." s)) X (setq pcmail-last-filter-name s))) X X(defun pcmail-get-filter (filter-name) X "Read filter arguments and return filter predicate. XArgs: (filter-name) X If FILTER-NAME is a valid filter, get its required arguments from the Xminibuffer and return the filter predicate." X (let ((ent)) X (setq ent (pcmail-filter-exists-p filter-name)) X (and (nth 2 ent) (eval (nth 2 ent))) X (nth 1 ent))) X X;;; predicates for subset creation. Each predicate is applied to a X;;; message with number pcmail-current-tested-message. This variable X;;; is a free variable. X X(defun pcmail-has-address-p (recipients) X "Return non-NIL if current message contains the supplied address regexp . XArgs: (recipients) X Convert comma-separated list of recipients RECIPIENTS into a regular Xexpression. Return non-NIL if message pcmail-current-tested-message X(free variable) contains this regular expression, NIL else." X (setq recipients (mail-comma-list-regexp recipients)) X (save-excursion X (save-restriction X (pcmail-narrow-to-unpruned-header pcmail-current-tested-message) X (or (string-match recipients (or (mail-fetch-field "to") "")) X (string-match recipients (or (mail-fetch-field "resent-to") "")) X (string-match recipients (or (mail-fetch-field "from") "")) X (string-match recipients (or (mail-fetch-field "resent-from") "")) X (string-match recipients (or (mail-fetch-field "cc") "")) X (string-match recipients (or (mail-fetch-field "resent-cc") "")))))) X X(defun pcmail-contains-attribute-p (attr) X "Return non-NIL if current message has attribute, NIL else. XArgs: (attr) X Return non-NIL if pcmail-current-tested-message (free variable) has XATTR set, NIL else." X (pcmail-has-attribute-p pcmail-current-tested-message attr)) X X(defun pcmail-subset-interesting-message-p () X "Return non-NIL is current message is interesting, NIL else. XArgs: none" X (pcmail-interesting-p pcmail-current-tested-message)) X X(defun pcmail-within-numeric-range-p (range) X "Return non-NIL if current message is within a numeric range, NIL else. XArgs: (range) X Return non-NIL if pcmail-current-tested-message (free variable) is Xwithin the range of absolute message numbers specified by the list RANGE, XNIL else." X (and (>= pcmail-current-tested-message (nth 0 range)) X (<= pcmail-current-tested-message (nth 1 range)))) X X(defun pcmail-within-date-range-p (range) X "Return non-NIL if the current message's date is within date range, NIL else. XArgs: (range) X Return non-NIL if pcmail-current-tested-message (free variable) Xhas its date within the range of dates specified by the list RANGE, NIL else. XDates are triples (day month year); RANGE is a pair of such triples." X (let ((lo (pcmail-date-triple-to-ndays (nth 0 range))) X (hi (pcmail-date-triple-to-ndays (nth 1 range))) X (date (pcmail-message-date pcmail-current-tested-message))) X (and date X (setq date (pcmail-date-triple-to-ndays date)) X (<= date hi) X (>= date lo)))) X X(defun pcmail-contains-string-p (regexp) X "Return non-NIL if the current message contains a specified regexp, NIL else. XArgs: (regexp)" X (save-excursion X (save-restriction X (let ((case-fold-search t)) X (pcmail-narrow-to-message pcmail-current-tested-message) X (re-search-forward regexp nil t))))) X X;;; read ranges from keyboard X X(defun pcmail-read-date-range () X "Read a date range from the minibuffer XArgs: none X Read a pair of dates from the minibuffer. Dates must be input in the Xform dd-mmm-yy. Default range is pcmail-last-date-range, which is a pair of Xdate triples, low and high. If no default has been specified, use low value Xas default for high value. If the string \"begin\" is input at the low value Xprompt, range includes all messages below high-value. If the string \"now\" Xis input at the high value prompt, range includes all messages above Xlow-value. Input becomes new value of pcmail-last-date-range." X X ; our date input parser is stupid, so temporarily bind the date format to X ; the date input format so default input works correctly X (let ((lo) (hi) (pcmail-date-format "%d-%m-%y")) X (setq lo X (pcmail-read-string-default X "First date in range: " X (and (nth 0 pcmail-last-date-range) X (pcmail-date-triple-to-string (nth 0 pcmail-last-date-range))) X t)) X (cond ((string= lo "begin") X (setq lo '(1 1 0))) X ((not (setq lo (pcmail-string-to-date-triple lo))) X (error "Date not dd-mmm-yy or \"begin\"."))) X (setq hi X (pcmail-read-string-default X "Last date in range: " X (if (nth 1 pcmail-last-date-range) X (pcmail-date-triple-to-string (nth 1 pcmail-last-date-range)) X (pcmail-date-triple-to-string lo)) X t)) X (cond ((string= hi "now") X (setq hi (pcmail-string-to-date-triple))) X ((not (setq hi (pcmail-string-to-date-triple hi))) X (error "Date not dd-mmm-yy or \"now\"."))) X (if (> (pcmail-date-triple-to-ndays lo) (pcmail-date-triple-to-ndays hi)) X (list hi lo) X (list lo hi)))) X X(defun pcmail-read-numeric-range () X "Read a numeric range from the minibuffer. XArgs: none X Read a pair of absolute message numbers from the minibuffer. Default Xrange is value of variable pcmail-last-numeric-range, which is a pair of Xnumbers, low and high. If no default has been specified, use low value as Xdefault for high value. If the string \"first\" is input at the low Xvalue prompt, range includes all messages below high-value. If the string X\"last\" is input at the high value prompt, range includes all messages above Xlow-value. Input becomes new value of pcmail-last-numeric-range." X (let ((lo) X (hi)) X (setq lo X (pcmail-read-string-default X "First message in range: " X (and (nth 0 pcmail-last-numeric-range) X (int-to-string (nth 0 pcmail-last-numeric-range))) X t)) X (cond ((string= lo "first") X (setq lo 1)) X ((or (not (setq lo (string-to-int lo))) X (< lo 1) X (> lo pcmail-total-messages)) X (error "Range endpoint not 1 - %d or \"first\"." X pcmail-total-messages))) X (setq hi X (pcmail-read-string-default X "Last message in range: " X (if (nth 1 pcmail-last-numeric-range) X (int-to-string (nth 1 pcmail-last-numeric-range)) X (int-to-string lo)) X t)) X (cond ((string= hi "last") X (setq hi pcmail-total-messages)) X ((or (not (setq hi (string-to-int hi))) X (< hi 1) X (> hi pcmail-total-messages)) X (error "Range endpoint not 1 - %d or \"last\"." X pcmail-total-messages))) X (list (min lo hi) (max lo hi)))) X X(provide 'pcmailsub) ________This_Is_The_END________ if test `wc -c < pcmailsub.el` -ne 17622; then echo 'shar: pcmailsub.el was damaged during transit (should have been 17622 bytes)' fi fi ; : end of overwriting check echo 'x - pcmailsysdep.el' if test -f pcmailsysdep.el; then echo 'shar: not overwriting pcmailsysdep.el'; else sed 's/^X//' << '________This_Is_The_END________' > pcmailsysdep.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: markl@oracle.com or markl%oracle.com@apple.com 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;;;; system-dependent things X X;;; mail environment. For new environments, simply add a system-type switch X;;; to the cond and put whatever properties you desire into the cond clause X;;; examples for VMS and UNIX follow. Currently all UNIXes are treated the X;;; same. This can change as required. A fair amount of this code is X;;; VMS-specific. If you need to save space and you don't use VMS, X;;; cut where indicated and throw the remainder of the file away. X X(cond ((eq system-type 'vax-vms) X X ;; VMS system mail drop X X (put 'vms-default-mail-drop 'conversion-function X 'pcmail-convert-vms-message) X (put 'vms-default-mail-drop 'msg-start-regexp "^\^L\nFrom:[ \t]+") X (put 'vms-default-mail-drop 'insert-function 'pcmail-do-vms-movemail) X X ;; VMS file mail drop, used to perform an initial import (extract X ;; your messages into a file and use this mail drop to import the X ;; file X X (put 'vms-file-mail-drop 'conversion-function X 'pcmail-convert-vms-message) X (put 'vms-file-mail-drop 'msg-start-regexp "^\^L\nFrom:[ \t]+") X (put 'vms-file-mail-drop 'insert-function 'pcmail-rename-mail-drop) X (put 'vms-file-mail-drop 'name-input-func X '(lambda () (pcmail-narrow-read-file-name "maildrop.log"))) X X ;; other environment stuff X X (put 'pcmail-mail-environment 'printer "SYS$PRINT") X (put 'pcmail-mail-environment 'print-function 'pcmail-vms-print-message) X (put 'pcmail-mail-environment 'mail-directory X (concat (substring (getenv "HOME") 0 -1) ".pcmail]")) X (put 'pcmail-mail-environment 'time-zone "PST") X (put 'pcmail-mail-environment 'legal-folder-regexp X "[0-9A-Za-z][0-9A-Za-z---_$+.]+") X (put 'pcmail-mail-environment 'send-mail-function 'pcmail-vms-send-mail) X (put 'pcmail-mail-environment 'create-mail-directory-fn X 'pcmail-vms-create-mail-directory) X (put 'pcmail-mail-environment 'folder-to-file-function X 'pcmail-vms-folder-name-to-file) X (put 'pcmail-mail-environment 'default-mail-drop-list X '(vms-default-mail-drop))) X X ;;; UNIX systems X X (t X X ;; NNTP mail drop X X (put 'nntp-mail-drop 'conversion-function 'pcmail-convert-nntp-message) X (put 'nntp-mail-drop 'msg-start-regexp X "^\^L\n\$Path\\|From\\|Xref\$:") X (put 'nntp-mail-drop 'insert-function 'pcmail-load-nntp-mail) X (put 'nntp-mail-drop 'display-errors-p t) X (put 'nntp-mail-drop 'folder-delete-hook 'pcmail-delete-nntp-folder) X X ;; NNTP file mail drop -- this is a file of NNTP messages that have been X ;; assembled by the nntp-slave program. An indirect variant of the X ;; above X X (put 'nntp-file-mail-drop 'conversion-function X 'pcmail-convert-nntp-message) X (put 'nntp-file-mail-drop 'msg-start-regexp "^\^L\n\$Path\\|From\$:") X (put 'nntp-file-mail-drop 'insert-function 'pcmail-rename-mail-drop) X (put 'nntp-file-mail-drop 'folder-delete-hook X 'pcmail-delete-nntp-folder) X (put 'nntp-file-mail-drop 'name-input-func X '(lambda () (pcmail-narrow-read-file-name "mail-log"))) X X ;; Berkeley-mail mail drops X (put 'spool-mail-drop 'conversion-function 'pcmail-convert-unix-message) X (put 'spool-mail-drop 'insert-function 'pcmail-do-unix-movemail) X (put 'spool-mail-drop 'msg-start-regexp "^From ") X X (put 'berkeley-mail-drop 'conversion-function X 'pcmail-convert-unix-message) X (put 'berkeley-mail-drop 'msg-start-regexp "^From ") X (put 'berkeley-mail-drop 'insert-function 'pcmail-rename-mail-drop) X (put 'berkeley-mail-drop 'name-input-func X '(lambda () (pcmail-narrow-read-file-name "~/mbox"))) X X ;; MH "mail drop" X X (put 'mh-mail-drop 'conversion-function 'pcmail-convert-mh-message) X (put 'mh-mail-drop 'msg-start-regexp "^\^Lbegin-message\^L\n") X (put 'mh-mail-drop 'insert-function 'pcmail-do-mh-movemail) X (put 'mh-mail-drop 'display-errors-p t) X X ;; other environment stuff X X (put 'pcmail-mail-environment 'time-zone "PST") X (put 'pcmail-mail-environment 'legal-folder-regexp X "[0-9A-Za-z---_$.+%#&!]+") X (put 'pcmail-mail-environment 'printer (or (getenv "PRINTER") "lp")) X (put 'pcmail-mail-environment 'print-function 'pcmail-unix-lpr-message) X (put 'pcmail-mail-environment 'mail-directory "~/.pcmail/") X (put 'pcmail-mail-environment 'create-mail-directory-fn X 'pcmail-unix-create-mail-directory) X (put 'pcmail-mail-environment 'folder-to-file-function 'identity) X (put 'pcmail-mail-environment 'default-mail-drop-list X '(spool-mail-drop)))) X X;;;; UNIX functions X X;;; message print function X X(defun pcmail-unix-lpr-message (printer-name folder-name) X "Send current message to printer XArgs: (printer-name folder-name) X Send the current message to the printer using LPR. Call-process-region Xon the current region. Add job/title arguments so burst page looks nice." X (call-process-region (point-min) (point-max) "lpr" X nil nil nil X (concat "-P" printer-name) X (format "-J\"Msg %s/%d\"" folder-name X (pcmail-make-absolute X pcmail-current-subset-message)) X (format "-T\"Msg %s/%d\"" folder-name X (pcmail-make-absolute X pcmail-current-subset-message)))) X X;;; maildrop to folder move routines X X;; UNIX mail-drop transfer routine X X(defun pcmail-do-unix-movemail (mail-drop) X "UNIX mail-drop transfer function. XArgs: (mail-drop) XCall the emacs movemail utility to transfer <spool-directory>/foo to a Xtemporary file, returning the temporary file's name to the caller. If XMAIL-DROP has a 'display-errors-p property, signal any errors from movemail Xby formatting the movemail output in process output buffer." X (let ((fromfile (substitute-in-file-name X (concat (if (boundp 'rmail-spool-directory) X rmail-spool-directory X "/usr/spool/mail/") X "$USER"))) X (errors (get mail-drop 'display-errors-p)) X (tofile (expand-file-name "~/.newmail"))) X X ;; On some systems, <spool-directory>/foo is a directory X ;; and the actual mail drop is <spool-directory>/foo/foo. X (and (file-directory-p fromfile) X (setq fromfile X (substitute-in-file-name (expand-file-name "$USER" fromfile)))) X (cond ((file-exists-p fromfile) X (pcmail-generic-unix-movemail "movemail" exec-directory errors X fromfile tofile) X tofile)))) X X;; UNIX NNTP mail transfer routine X X(defun pcmail-load-nntp-mail (mail-drop) X "UNIX NNTP mail-drop transfer function. XArgs: (mail-drop) XCall the nntp_slave program to transfer netnews messages from a newgroup Xwith the same name as the current folder to a temporary file. If MAIL-DROP Xhas a 'display-errors-p property, signal any errors from movemail by Xformatting the movemail output in process output buffer." X (let ((errors (get mail-drop 'display-errors-p)) X (tofile (expand-file-name (concat pcmail-folder-name ".newnews"))) X (controlfile (concat pcmail-folder-name ".ctl"))) X (pcmail-generic-unix-movemail "nntp_slave" exec-directory errors X pcmail-nntp-host-name pcmail-folder-name X tofile controlfile) X tofile)) X X(defun pcmail-delete-nntp-folder (folder-name) X "NNTP-mail-drop-specific folder delete processing XArgs: (foler_name) X Run on delete of FOLDER_NAME with an attached nntp mail drop. Deletes the Xnntp_slave news control file associated with FOLDER_NAME." X (condition-case nil X (delete-file (expand-file-name (concat folder-name ".ctl") X pcmail-directory)) X (file-error nil))) X X;; Unix MH load X X(defun pcmail-do-mh-movemail (mail-drop) X "UNIX MH mail-drop transfer function. XArgs: (mail-drop) X Read an MH folder name from the minibuffer and use an export utility to Xmove all messages in the MH folder into a temporary file, returning Xthe temporary file's name to the caller. If MAIL-DROP has a X'display-errors-p property, signal any errors from the shell script by Xformatting the shell script output in the process output buffer." X (let* ((folder (pcmail-mh-read-folder-name)) X (errors (get mail-drop 'display-errors-p)) X (tofile (expand-file-name (concat "~/Mail/" folder "/" folder X ".mhexport")))) X (pcmail-generic-unix-movemail "mh-to-pcmail-export" exec-directory X errors folder tofile) X tofile)) X X(defun pcmail-mh-read-folder-name () X "Read a folder name from the minibuffer, using completion. XArgs: none X Use pcmail-completing-read to read an MH folder name from the minibuffer. XCompletion directory is the standard MH mail directory ~/Mail/. XPcmail-completing-read takes an alist, so we need to convert the output of Xfile-name-all-completions to alist form. In the process, remove trailing Xslashes from any directory names in the completion set. Completion set Xis filtered through a lambda expression that passes only directories and Xeliminates the special directories \".\" and \"..\"." X (let ((mhdir (expand-file-name "~/Mail/"))) X (or (file-directory-p mhdir) X (error "Default MH mail directory \"%s\" does not exist." mhdir)) X (pcmail-completing-read X "Folder name: " X (mapcar '(lambda (s) (list (if (string-match ".*/$" s) X (substring s 0 -1) X s))) X (file-name-all-completions "" mhdir)) X nil X '(lambda (s) (and (file-directory-p (expand-file-name (car s) mhdir)) X (not (string= (car s) "..")) X (not (string= (car s) "."))))))) X X X;; generic call-process and error-handling part of the above three routines X X(defun pcmail-generic-unix-movemail (progname dir errorbuf &rest args) X "Generic mail mover. Calls a program, formatting and signalling errors. XArgs: (progname dir tofile fromfile errorbuf &rest args) X If ERRORBUF is non-nil, generate an error buffer. Call PROGNAME in Xdirectory DIR, passing it arguments ARGS, and routing output to ERRORBUF Xif present. If errors occur, format the output in ERRORBUF and use it as Xan argument to a file-error signal." X (and errors X (setq errors (generate-new-buffer (concat " *" progname " lossage*")))) X (unwind-protect X (save-excursion X (and errors (buffer-flush-undo errors)) X (apply 'call-process (expand-file-name progname dir) nil errors nil X args) X (cond ((and errors (buffer-modified-p errors)) X (set-buffer errors) X (subst-char-in-region (point-min) (point-max) ?\n ?\ ) X (goto-char (point-max)) X (skip-chars-backward " \t") X (delete-region (point) (point-max)) X (goto-char (point-min)) X (and (looking-at (concat progname ": ")) X (delete-region (point-min) (match-end 0))) X (signal 'file-error X (list progname X (buffer-substring (point-min) (point-max))))))) X (and errors (kill-buffer errors)))) X X;;; Generic mail drop insert function X X(defun pcmail-rename-mail-drop (mail-drop) X "A generic mail drop insert function XArgs: (mail-drop) X Read a source mail drop name from the minibuffer and rename it to a Xtemporary file, returning the name of the temporary file to the caller." X (or (get mail-drop 'name-input-func) X (error "Missing mail drop name input property in mail drop %s" X mail-drop)) X (let ((tofile) X (fromfile (funcall (get mail-drop 'name-input-func)))) X (cond ((file-exists-p fromfile) X (setq tofile X (concat (file-name-directory fromfile) "new-" X (file-name-nondirectory fromfile))) X (rename-file fromfile tofile nil) X tofile)))) X X;;; message conversion routines. These functions look from point X;;; forward for a message-begin regexp (end of current message, beginning of X;;; next message). They narrow to that region and reformat the message, X;;; putting it in Babyl format and converting any non-conformant headers X X;;; default conversion routine X X(defun pcmail-convert-unknown-message () X "Convert a message of unknown type to Babyl format. X Args: none XThis routine is called when there is no match for a mail drop message-begin Xregular expression. Assumes the buffer is narrowed from point to end of Xbuffer." X (insert pcmail-babyl-header) X (pcmail-add-babyl-attr nil "badheader") X (insert "Date: " (pcmail-todays-date) "\n") X (insert "From: \"The Mail Reader\" <pcmail>\n") X (insert "To: " pcmail-primary-folder-name "\n") X (insert "Subject: Could not convert this message to Babyl format") X (insert pcmail-header-delim) X (goto-char (point-min)) X (while (search-forward pcmail-babyl-end nil t) X (replace-match (concat "\n" pcmail-babyl-exploded-end))) X (goto-char (point-max)) X (insert pcmail-babyl-end)) X X;;; Babyl conversion routine X X(defun pcmail-convert-babyl-message () X "Convert a Babyl message to Babyl format XArgs: (none) X Convert a Babyl message to Babyl format. If looking at Babyl header, nuke Xit. If looking at Babyl message, remove summary-line field if present. XAssume the current buffer is narrowed from point to end-of-buffer." X (cond ((looking-at "BABYL OPTIONS:") X (setq newmsgs (1- newmsgs)) ;not a real message X (re-search-forward pcmail-babyl-end nil 'move) X (delete-region (point-min) (point))) X ((looking-at pcmail-babyl-begin) X (let ((end) (case-fold-search t)) X (cond ((re-search-forward pcmail-babyl-end nil 'move) X (delete-region (point) X (progn (skip-chars-forward " \t\n") X (point)))) X (t X (insert pcmail-babyl-end))) X (save-excursion X (goto-char (point-min)) X (cond ((search-forward pcmail-header-delim nil t) X (setq end (point)) X (goto-char (point-min)) X (and (re-search-forward X "^summary-line:.*\n\$[ \t]+.*\n\$*" end t) X (replace-match ""))))))))) X X;;; MH-export conversion routine X X(defun pcmail-convert-mh-message () X "Convert an exported MH message to Babyl format. XArgs: none X See pcmail-convert-unix-message." X (let ((start (point)) X (msgseparator (get 'mh-mail-drop 'msg-start-regexp))) X ;point must be at this regexp; see convert-region-to-babyl-format X (re-search-forward msgseparator nil t) X (replace-match "") X (insert pcmail-babyl-header) X (cond ((re-search-forward (concat "\$" msgseparator "\$") nil t) X (goto-char (match-beginning 1))) X (t X (goto-char (point-max)))) X (narrow-to-region start (point)) X (goto-char (point-min)) X (pcmail-bash-unix-header) X (goto-char (point-min)) X (while (search-forward pcmail-babyl-end nil t) X (replace-match (concat "\n" pcmail-babyl-exploded-end))) X (goto-char (point-max)) X (widen) X (insert pcmail-babyl-end))) X X;;; Berkeley MAIL conversion routine X X(defun pcmail-convert-unix-message () X "Convert a Berkeley Mail message to Babyl format. XArgs: none X Convert a UNIX-style Mail message to Babyl format. Regexps snarfed from XRMAIL. Assumes the current buffer is narrowed from point to end of buffer." X (let ((start (point))) X (insert pcmail-babyl-header) X (forward-line 1) ;over first line X (if (re-search-forward ; UNIX header regexp... X (concat "^\$" X "From [^ \n]*\\(\\|\".*\"[^ \n]*\$ ?[^ \n]* [^ \n]* *" X "[0-9]* [0-9:]* " ; time of day X "\$[A-Z]?[A-Z][A-Z]T \\|" ; 3-char time zone X "[-+][0-9][0-9][0-9][0-9] \\|\$" ; numeric offset time zone X "19[0-9]*$\\)") nil t) X (goto-char (match-beginning 1)) X (goto-char (point-max))) X (narrow-to-region start (point)) X (goto-char (point-min)) X (pcmail-bash-unix-header) X (goto-char (point-min)) X (while (search-forward pcmail-babyl-end nil t) X (replace-match (concat "\n" pcmail-babyl-exploded-end))) X (goto-char (point-max)) X (widen) X (insert pcmail-babyl-end))) X X(defun pcmail-bash-unix-header () X "Turn a Berkeley Mail header into an RFC822 header XArgs: none" X (let ((hdrend (progn X (or (re-search-forward pcmail-header-delim nil 'move) X (insert pcmail-header-delim)) X (point))) X (case-fold-search t)) X (save-excursion X (save-restriction X (narrow-to-region (point-min) hdrend) X (goto-char (point-min)) X (pcmail-maybe-gronk-unix-header))))) X X(defun pcmail-maybe-gronk-unix-header () X "Transform unix mail header. XArgs: none X If there is a righteous from or date field, nuke the non-standard Berkeley Xfrom field, otherwise extract from and date field info from it and create Xrighteous fields before nuking the Berkeley from field. Assume buffer is Xnarrowed to the message header." X (let ((case-fold-search t) (has-from) (has-date)) X (goto-char (point-min)) X (and (re-search-forward "^Date:[ \t]+.*\n\$[\t ]+.*\n\$*" nil t) X (setq has-date t)) X (goto-char (point-min)) X (and (re-search-forward "^From:[ \t]+.*\n\$[\t ]+.*\n\$*" nil t) X (setq has-from t)) X (goto-char (point-min)) X X ; if the header has neither a from nor a date field, create them using X ; the Berkeley from field X (let ((case-fold-search nil)) X (and (re-search-forward ;The Pinhead Header X "^From \$[^ ]*\\(\\|\".*\"[^ ]*\$\\) ?\$[^ ]*\$ \$[^ ]*\$ *\$[0-9]*\$ \$[0-9:]*\$\$ [A-Z]?[A-Z][A-Z]T\\|[-+][0-9][0-9][0-9][0-9]\\|\$ 19\$[0-9]*\$\n" nil t) X (replace-match X (concat X (cond (has-date X "") X ((= (match-beginning 7) (match-end 7)) X (concat "Date: \\3, \\5 \\4 \\8 \\6 " pcmail-time-zone X "\n")) X (t X "Date: \\3, \\5 \\4 \\8 \\6\\7\n")) X (cond (has-from X "") X (t X "From: \\1\n")))))))) X X;;; NNTP message conversion routine X X(defun pcmail-convert-nntp-message () X "Convert an NNTP slave message to Babyl format. XArgs: none X See pcmail-convert-unix-message." X (let ((start (point))) X ;point must be at this regexp; see convert-region-to-babyl-format X (re-search-forward "^\^L\n" nil t) X (replace-match pcmail-babyl-header) X (cond ((re-search-forward "\$^\^L\n\$\$Path\\|From\\|Xref\$:[ \t]+" X nil t) X (goto-char (match-beginning 1))) X (t X (goto-char (point-max)))) X (narrow-to-region start (point)) X (goto-char (point-min)) X (pcmail-bash-nntp-header) X (goto-char (point-min)) X (while (search-forward pcmail-babyl-end nil t) X (replace-match (concat "\n" pcmail-babyl-exploded-end))) X (goto-char (point-max)) X (widen) X (insert pcmail-babyl-end))) X X(defun pcmail-bash-nntp-header () X "Turn an NNTP message into a mail message. XArgs: none XSimple routine to change the NNTP Newsgroups: field into a To: field so Xthat the mail reader will be happy (mail messages need To: fields)." X (let ((hdrend (progn X (or (re-search-forward pcmail-header-delim nil 'move) X (insert pcmail-header-delim)) X (point))) X (case-fold-search t)) X (save-excursion X (save-restriction X (narrow-to-region (point-min) hdrend) X (and (re-search-backward "^Newsgroups:" nil t) X (replace-match "To:")))))) X X X;;; initial mail directory create X X(defun pcmail-unix-create-mail-directory () X "Create UNIX local mail directory. XArgs: none" X (call-process "mkdir" nil nil nil X (directory-file-name (expand-file-name pcmail-directory)))) X X X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X;;;; X;;;; VMS SYSTEM-SPECIFIC FUNCTIONS. IF YOU DON'T RUN VMS AND WANT TO SAVE X;;;; SPACE, CUT HERE, BEGING CAREFUL TO PRESERVE THE (PROVIDE 'PCMAILSYSDEP) X;;;; FORM ON THE LAST LINE OF THE FILE X;;;; X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X X;;; message print function X X(defun pcmail-vms-print-message (printer-name &ignore) X "Send the current message to printer queue. XArgs: (printer-name &ignore) X Send the current message to printer queue PRINTER-NAME using a canned XCOM file. First write message to a file. COM file prints the file and may Xdelete it." X (let ((temp-file (expand-file-name "pcmail-msg.txt" pcmail-directory)) X (com-file (expand-file-name "vms-doprint.com" exec-directory)) X (bname (buffer-name))) X (write-region (point-min) (point-max) temp-file) X (pcmail-vms-command (format "@%s %s %s" com-file printer-name X temp-file "delete")) X (set-buffer bname))) ;pcmail-vms-command lossage X X;;; directory create function X X(defun pcmail-vms-create-mail-directory () X "Create VMS local mail directory. XArgs: none" X (pcmail-vms-command (concat "create/dir " pcmail-directory)) X (while (not (file-directory-p pcmail-directory)))) X X X;;; mail-drop move function X X(defun pcmail-do-vms-movemail (mail-drop) X "VMS mail-drop transfer function. XArgs: (mail-drop) X Call a COM file to transfer a file named newmail into a temporary file Xnamed newmail. Return the file name to the caller. Assumes existence of Xa function called pcmail-vms-command which does a non-blocking exexute of a XDCL command in an kept inferior process." X (let ((bname (buffer-name)) X (fromfile "newmail") X (tofile "mail.temp")) X (condition-case nil X (delete-file tofile) ;in case of previous lossage X (file-error nil)) X (pcmail-vms-command (concat "@" X (expand-file-name "vms-movemail.com" exec-directory) X " " X fromfile X " " X tofile X " " X (file-name-directory (buffer-file-name)))) X (set-buffer bname) ;pcmail-vms-command lossage X (while (not (file-exists-p tofile))) ;gag, choke, nonblocking call X tofile)) X X X;;; convert a VMS VAX-MAIL message to a Babyl message. This is pretty X;;; horrific, but works well enough. X X(defun pcmail-convert-vms-message () X "Convert a VMS-style message to Babyl format. XArgs: none X See pcmail-convert-unix-message." X (let ((start (point)) X (msg-start-regexp "^\^L\nFrom:[ \t]+")) X ;point must be at this regexp; see convert-region-to-babyl-format X (re-search-forward "^\^L\n" nil t) X (replace-match pcmail-babyl-header) X (cond ((re-search-forward X (concat "\$^\^L\n\$From:[ \t]+.+[0-9]+-[a-zA-Z]+-" X "19[0-9]+[ \t]*[0-9]+:[0-9]+") X nil t) X (goto-char (match-beginning 1))) X (t X (goto-char (point-max)))) X (narrow-to-region start (point)) X (goto-char (point-min)) X (pcmail-bash-vms-header) X (goto-char (point-min)) X (while (search-forward pcmail-babyl-end nil t) X (replace-match (concat "\n" pcmail-babyl-exploded-end))) X (goto-char (point-max)) X (widen) X (insert pcmail-babyl-end))) X X(defun pcmail-bash-vms-header () X "Convert a VMS message header to at least minimally resemble an RFC822 header XArgs: none X Assume the region is narrowed to the current message." X (let ((hdrend (progn X (or (re-search-forward pcmail-header-delim nil 'move) X (insert pcmail-header-delim)) X (point))) X (case-fold-search t)) X (save-excursion X (save-restriction X (narrow-to-region (point-min) hdrend) X (pcmail-maybe-gronk-vms-header))))) X X(defun pcmail-maybe-gronk-vms-header () X "Reformat or nuke VMS fields as necessary. Not too bad. XArgs: none" X (goto-char (point-min)) X (cond ((re-search-forward X (concat "^From:\t" ;Anatomy of a VMS From: field X "\$\\(\\w+::\$?" ;optional host name X "\$\\w+\$" ;user name X "[ \t]*\$\".*\"\$?[ \t]*\\)";comment X "\$[0-9]+\$-" ;day X "\$[a-zA-Z]+\$-" ;month X "19\$[0-9]+\$[ \t]*" ;year X "\$[0-9]+:[0-9]+\$\$:[0-9]+\$?.*\n") ;time X nil t) X (replace-match X (concat "Date: \\5 " X (capitalize X (buffer-substring (match-beginning 6) (match-end 6))) X " \\7 \\8 " pcmail-time-zone "\n" X "From: \\1\n") X t))) X X ; find subject and reformat if it exists, punt if blank X (goto-char (point-min)) X (let ((no-subject) (has-cc) (has-to)) X (setq no-subject X (let ((temp-subj (mail-fetch-field "subj"))) X (zerop (length temp-subj)))) X (and (re-search-forward "^Subj:\t\$.*\n\\([ \t]+.*\n\$?\\)" nil t) X (replace-match (if no-subject "" "Subject: \\1") t)) X X ; find CC and reformat if it exists, punt if blank X (goto-char (point-min)) X (setq no-cc X (let ((temp-cc (mail-fetch-field "cc"))) X (zerop (length temp-cc)))) X (and (re-search-forward "^CC:\t\$.*\n\\([ \t]+.*\n\$?\\)" nil t) X (if no-cc X (replace-match "") X (replace-match "Cc: \\1" t))) X X ; find to: field and reformat if no other to fields exists X (goto-char (point-min)) X (and (re-search-forward "^To:\t" nil t) X (replace-match "To: ")))) X X;;; folder-to-file translate function X X(defun pcmail-vms-folder-name-to-file (folder-name) X "Return a copy of FOLDER-NAME that has been translated into a valid VMS Xfile name. The translation converts \".\" characters into \"_\" characters Xand \"+\" characters into \"$\" characters." X (let ((i 0) (outbox (copy-sequence folder-name))) X (while (< i (length outbox)) X (and (= (aref outbox i) ?.) (aset outbox i ?_)) X (and (= (aref outbox i) ?+) (aset outbox i ?$)) X (setq i (1+ i))) X outbox)) X X;;; mail transmission function X X(defconst pcmail-vms-mailcopy "SYS$SCRATCH:MAIL.CPY" X "File used to store body of message when using VMS mail utility. XDeleted on mail transmit.") X X(defun pcmail-vms-send-mail () X "Send a message using VMS Mail. XArgs: none X Copy message body to a file. Using message header, create TO and SUBJECT Xarguments after converting addresses from RFC822 format to VMS format. XCall VMS MAIL with to, subject, and body file arguments. Note that this is Xa hack, and may break down from time to time." X (let ((tembuf) (case-fold-search t) (to) (cc) (subj) (delimline) X (mailbuf (current-buffer))) X (and (file-exists-p pcmail-vms-mailcopy) (delete-file pcmail-vms-mailcopy)) X (find-file pcmail-vms-mailcopy) X (unwind-protect X (save-excursion X (save-restriction X (setq tembuf (current-buffer)) X (erase-buffer) X (insert-buffer-substring mailbuf) X ;; Find end of header and narrow to it. X (goto-char (point-min)) X (or (re-search-forward X (concat "^" (regexp-quote mail-header-separator))) X (error "Improperly formatted mail buffer.")) X (setq delimline (point-marker)) X (replace-match "") X (narrow-to-region (point-min) delimline) X X ;; Find and handle any aliases. X (and mail-aliases X (expand-mail-aliases (point-min) delimline)) X X ;; Remove any blank lines in the header. X (goto-char (point-min)) X (while (re-search-forward "^[ \t\n]*\n" delimline t) X (replace-match "")) X X ;; Find and handle any FCC fields. X (goto-char (point-min)) X (and (re-search-forward "^FCC:" delimline t) X (mail-do-fcc delimline)) X X ;; don't send out a blank subject line X (goto-char (point-min)) X (and (re-search-forward "^Subject:[ \t]*\n" delimline t) X (replace-match "")) X X (goto-char (point-min)) X (pcmail-vms-mail-convert-text-field "subject") X (setq to (or (mail-fetch-field "to" nil t) X (error "Message must have a to: recipient."))) X (setq cc (mail-fetch-field "cc" nil t)) X (and cc (setq to (concat to "," cc))) X (setq to (pcmail-vms-mail-nl-to-space to)) X (if (setq subj (mail-fetch-field "subject" t)) X (setq subj (pcmail-vms-mail-nl-to-space X (concat "/SUBJECT=\"" subj "\""))) X (setq subj ""))) X (delete-region (point-min) delimline) X (write-file (buffer-file-name)) X ;; Make call to VMS Mail. X (pcmail-vms-command (concat "MAIL" subj " -")) X (pcmail-vms-command (concat pcmail-vms-mailcopy " -")) X (pcmail-vms-command (concat "\"" to "\"")) X (pcmail-vms-command " ")) ; to clear out any prompts due to errors X (set-buffer tembuf) X (set-buffer-modified-p nil) X (kill-buffer tembuf)))) X X(defun pcmail-vms-mail-convert-text-field (field) X "Convert RFC822 text fields to VMS format. XArgs: (field)" X (let ((start) X (case-fold-search t)) X (save-excursion X (save-restriction X (goto-char (point-min)) X (cond ((re-search-forward (concat "^" (regexp-quote field) ":[ \t]*") X nil t) X (setq start (point)) X (while (progn (forward-line 1) X (looking-at "[ \t]"))) X (narrow-to-region start (point)) X (goto-char start) X (while (re-search-forward "\"" nil t) X (replace-match "\"\"")))))))) X X(defun pcmail-vms-mail-nl-to-space (s) X "Convert all whitespace in S to spaces and return the result. Modifies S. XArgs: (s)" X (let ((i 0)) X (while (< i (length s)) X (and (or (= (aref s i) ?\n) X (= (aref s i) ?\t)) X (aset s i ? )) X (setq i (1+ i)))) X s) X X X;;; subprocess capability. NOTE THAT THIS IS A HACK. A GRUNGY HACK. X X(defvar pcmail-vms-process-id nil X "Process ID of inferior VMS process used by pcmail-vms-command.") X X(defvar pcmail-vms-process-buffer "*DCL Output*" X "Name of buffer where output from VMS process goes.") X X(defun pcmail-vms-command (s) X "Send a string S to a kept inferior VMS process. XArgs: (s) X If variable PCMAIL-VMS-PROCESS-ID is unbound, spawn a process using the XSPAWN-PROCESS function. Then send S to the process using the XSEND-COMMAND-TO-SUBPROCESS function." X (cond ((not pcmail-vms-process-id) X (setq pcmail-vms-process-id (random)) X (spawn-subprocess pcmail-vms-process-id 'pcmail-vms-process-input))) X (send-command-to-subprocess pcmail-vms-process-id s)) X X(defun pcmail-vms-process-input (id s) X "Called when input string S arrives from VMS process with handle ID XArgs: (id s) X Place input in buffer PCMAIL-VMS-PROCESS-BUFFER and display that buffer in Xanother window." X (pop-to-buffer pcmail-vms-process-buffer) X (goto-char (point-max)) X (insert s)) X X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X;;;; X;;;; STOP CUTTING HERE X;;;; X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; X X(provide 'pcmailsysdep) ________This_Is_The_END________ if test `wc -c < pcmailsysdep.el` -ne 30775; then echo 'shar: pcmailsysdep.el was damaged during transit (should have been 30775 bytes)' fi fi ; : end of overwriting check exit 0