home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume8 / pcmail / part08 < prev    next >
Lisp/Scheme  |  1989-11-03  |  41KB  |  1,051 lines
  1. Newsgroups: comp.sources.misc
  2. subject: v08i116: pcmail part 08 of 08
  3. From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
  4. Reply-To: markl@oracle.com (Croaker the Physician)
  5.  
  6. Posting-number: Volume 8, Issue 116
  7. Submitted-by: markl@oracle.com (Croaker the Physician)
  8. Archive-name: pcmail/part08
  9.  
  10. Ack when you get the whole thing; then I can post to gnu.emacs telling
  11. them they can expect it on c.s.misc in the near future...
  12.  
  13. Thanks,
  14. markl
  15.  
  16.  
  17. #--------------------------------CUT HERE-------------------------------------
  18. #! /bin/sh
  19. #
  20. # This is a shell archive.  Save this into a file, edit it
  21. # and delete all lines above this comment.  Then give this
  22. # file to sh by executing the command "sh file".  The files
  23. # will be extracted into the current directory owned by
  24. # you with default permissions.
  25. #
  26. # The files contained herein are:
  27. #
  28. # -rw-rw-r--  1 markl       26267 Oct 31 13:00 pcmailbabyl.el
  29. # -rw-rw-r--  1 markl       12137 Oct 31 11:50 pcmailmail.el
  30. #
  31. echo 'x - pcmailbabyl.el'
  32. if test -f pcmailbabyl.el; then echo 'shar: not overwriting pcmailbabyl.el'; else
  33. sed 's/^X//' << '________This_Is_The_END________' > pcmailbabyl.el
  34. X;;;; GNU-EMACS PCMAIL mail reader
  35. X
  36. X;;  Written by Mark L. Lambert
  37. X;;  Architecture Group, Network Products Division
  38. X;;  Oracle Corporation
  39. X;;  20 Davis Dr,
  40. X;;  Belmont CA, 94002
  41. X;;
  42. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  43. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  44. X
  45. X;; Copyright (C) 1989 Mark L. Lambert
  46. X
  47. X;; This file is not officially part of GNU Emacs, but is being
  48. X;; donated to the Free Software Foundation.  As such, it is
  49. X;; subject to the standard GNU-Emacs General Public License,
  50. X;; referred to below.
  51. X
  52. X;; GNU Emacs is distributed in the hope that it will be useful,
  53. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  54. X;; accepts responsibility to anyone for the consequences of using it
  55. X;; or for whether it serves any particular purpose or works at all,
  56. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  57. X;; License for full details.
  58. X
  59. X;; Everyone is granted permission to copy, modify and redistribute
  60. X;; GNU Emacs, but only under the conditions described in the
  61. X;; GNU Emacs General Public License.   A copy of this license is
  62. X;; supposed to have been given to you along with GNU Emacs so you
  63. X;; can know your rights and responsibilities.  It should be in a
  64. X;; file named COPYING.  Among other things, the copyright notice
  65. X;; and this notice must be preserved on all copies.
  66. X
  67. X;; NOTE: this is the only code in the pcmail mail reader implementation 
  68. X;;       that understands Babyl.  The message format therefore does not
  69. X;;       matter provided the public entry points all do the expected thing
  70. X
  71. X;;;; global variables
  72. X
  73. X;;; system-defined globals
  74. X
  75. X(defconst pcmail-header-delim "\n\n"
  76. X  "Mail header delimiter.")
  77. X  
  78. X(defconst pcmail-babyl-begin "\^L"
  79. X  "Character sequence that begins a Babyl message.")
  80. X
  81. X(defconst pcmail-babyl-end "\n\^_"
  82. X  "Character sequence that ends a Babyl message.")
  83. X
  84. X(defconst pcmail-babyl-exploded-end "^_"
  85. X  "The character sequence to which we change pcmail-babyl-end when we encounter
  86. Xit in the body of a mail message")
  87. X
  88. X(defconst pcmail-babyl-old-header-delim "*** EOOH ***\n"
  89. X  "Babyl old header delimiting string.")
  90. X
  91. X(defconst pcmail-babyl-header
  92. X  (concat pcmail-babyl-begin "\n0, unseen,,\n" pcmail-babyl-old-header-delim)
  93. X  "Initial Babyl message header string.")
  94. X
  95. X(defconst pcmail-babyl-defined-attributes
  96. X  '("deleted" "forwarded" "filed" "answered" "unseen" "recent" "badheader")
  97. X  "A list of attributes defined in the Babyl specification")
  98. X
  99. X(defvar pcmail-uninteresting-fields-regexp nil
  100. X  "Regexp of headers derived from pcmail-interesting-fields-list.")
  101. X
  102. X;; Babyl mail drop
  103. X
  104. X(put 'babyl-mail-drop 'conversion-function 'pcmail-convert-babyl-message)
  105. X(put 'babyl-mail-drop 'msg-start-regexp 
  106. X     (concat "BABYL OPTIONS:\\|" pcmail-babyl-begin))
  107. X(put 'babyl-mail-drop 'insert-function 'pcmail-rename-mail-drop)
  108. X(put 'babyl-mail-drop 'name-input-func
  109. X     '(lambda () (pcmail-narrow-read-file-name rmail-file-name)))
  110. X     
  111. X;;;; operations specific to Babyl format
  112. X
  113. X(defun pcmail-version-information ()
  114. X  "Show useful information about this incarnation of the mail reader.
  115. XArgs: none"
  116. X  (interactive)
  117. X  (with-output-to-temp-buffer "*pcmail-information*"
  118. X    (let ((vers))
  119. X      (save-excursion
  120. X    (save-restriction
  121. X      (pcmail-narrow-to-babyl-header)
  122. X      (setq vers (or (mail-fetch-field "version") "[unknown]"))))
  123. X      (princ "Mail reader version:\t") (princ pcmail-version) (terpri)
  124. X      (princ "Babyl version:\t\t") (princ (or vers "[unknown]")) (terpri)
  125. X      (princ "Mail directory:\t\t") (princ pcmail-directory) (terpri)
  126. X      (princ "AutoPigeonholing:\t") 
  127. X      (princ (if pcmail-pigeonhole-hook "enabled\n" "disabled\n"))
  128. X      (princ "Ignored header fields:\t") 
  129. X      (save-excursion
  130. X    (set-buffer "*pcmail-information*")
  131. X    (let ((fill-prefix "\t\t\t") (foo (point)))
  132. X      (princ (mapconcat 'identity pcmail-uninteresting-fields-list ", ")) 
  133. X      (terpri)
  134. X      (fill-region-as-paragraph foo (point))))
  135. X      (princ "Summary format:\t\t") (princ pcmail-summary-format) (terpri)
  136. X      (princ "Date format:\t\t") (princ pcmail-date-format) (terpri)
  137. X      (princ "Folder format:\t\t") 
  138. X      (princ pcmail-folder-mode-line-format) (terpri)
  139. X      (princ "Startup filter name:\t") (princ pcmail-default-filter-name)
  140. X      (terpri)
  141. X      (and (boundp 'pcmail-last-file)
  142. X       (princ "Default archive file:\t") (princ pcmail-last-file) (terpri))
  143. X      (princ "Default wastebasket:\t") 
  144. X      (princ pcmail-wastebasket-folder) (terpri)
  145. X      (princ "Default printer:\t") (princ pcmail-printer-name) (terpri)
  146. X      (princ "Default attribute:\t") (princ (or pcmail-last-attr "[none]"))
  147. X      (terpri)
  148. X      (princ "Default folder:\t\t") (princ (or pcmail-last-folder "[none]"))
  149. X      (terpri)
  150. X      (princ "Default filter name:\t") (princ (or pcmail-last-filter-name
  151. X                          "[none]"))
  152. X      (terpri)
  153. X      (princ "Default search regexp:\t") 
  154. X      (princ (or pcmail-last-search "[none]")) (terpri)
  155. X      (princ "Default addresses:\t") 
  156. X      (princ (or pcmail-last-addresses "[none]")) (terpri) 
  157. X      (princ "Default numeric range:\t") 
  158. X      (princ (cond (pcmail-last-numeric-range 
  159. X            (format "[%d - %d]\n" (nth 0 pcmail-last-numeric-range)
  160. X                (nth 1 pcmail-last-numeric-range)))
  161. X           (t "[none]\n")))
  162. X      (princ "Default date range:\t") 
  163. X      (princ (cond (pcmail-last-date-range 
  164. X            (format "[%s - %s]\n" 
  165. X                (pcmail-date-triple-to-string
  166. X                 (nth 0 pcmail-last-date-range))
  167. X                (pcmail-date-triple-to-string
  168. X                 (nth 1 pcmail-last-date-range))))
  169. X           (t "[none]\n")))
  170. X      (princ "Yanked-message prefix:\t")
  171. X      (princ (if (stringp pcmail-yank-prefix) pcmail-yank-prefix "[none]"))
  172. X      (terpri)
  173. X      (princ "Highlight forwarded:\t") 
  174. X      (princ (if pcmail-highlight-forwarded-message "yes" "no")) (terpri)
  175. X      (princ "Yank message on reply:\t") 
  176. X      (princ (if pcmail-yank-message-on-reply "yes" "no")) (terpri)
  177. X      (princ "Expunge on save:\t") 
  178. X      (princ (if pcmail-expunge-on-save "yes" "no")) (terpri)
  179. X      (princ "Wastebasket on expunge:\t") 
  180. X      (princ (if pcmail-wastebasket-on-expunge "yes" "no")) (terpri)
  181. X      (princ "Save on quit:\t\t") 
  182. X      (princ (if pcmail-save-on-quit "yes" "no")) (terpri)
  183. X      (princ "Delete on archive:\t") 
  184. X      (princ (if pcmail-delete-on-archive "yes" "no")) (terpri)
  185. X      (princ "Delete on copy:\t\t") 
  186. X      (princ (if pcmail-delete-on-copy "yes" "no")) (terpri)
  187. X      (princ "Delete on print:\t") 
  188. X      (princ (if pcmail-delete-on-print "yes" "no")) (terpri))))
  189. X
  190. X(defun pcmail-undigestify-message ()
  191. X  "Separate a digest message into its constituent messages.  
  192. XArgs: none
  193. X  See pcmail-undigestify-message-1. After undigestifying, move to the next 
  194. Xinteresting message in the folder."
  195. X  (interactive)
  196. X  (pcmail-undigestify-message-1 
  197. X   (pcmail-make-absolute pcmail-current-subset-message))
  198. X  (pcmail-next-message))
  199. X
  200. X(defun pcmail-undigestify-message-1 (n)
  201. X  "Separate a digest message into its constituent messages.
  202. XArgs: N
  203. X  If message absolute-numbered N is a UNIX digest, break the digest into its
  204. Xconstituent messages, appending the messages to the current folder.
  205. XEach undigestified message shares the digest's attribute list."
  206. X  (let* ((buffer-read-only nil)
  207. X     (short-dashes (make-string 27 ?-))
  208. X     (done)
  209. X     (digest-name)
  210. X     (start) (end)
  211. X     (msg-string (pcmail-message-contents n)))
  212. X    (save-restriction
  213. X      (pcmail-narrow-to-unpruned-header n)
  214. X      (setq digest-name
  215. X        (mail-strip-quoted-names (or (mail-fetch-field "to")
  216. X                     (mail-fetch-field "reply-to")
  217. X                     (error "Message is not a digest.")))))
  218. X    (widen)
  219. X    (goto-char (point-max))
  220. X    (setq start (point-marker))
  221. X    (insert msg-string)
  222. X    (setq end (point-max-marker))
  223. X    (unwind-protect
  224. X    (progn
  225. X      (save-restriction
  226. X        (narrow-to-region start end)
  227. X        (goto-char (point-min))
  228. X        (cond ((re-search-forward (concat "^" short-dashes "-*\n*"
  229. X                          "End of.*digest.*\n"
  230. X                          "\\**\\(\n------*\\)*")
  231. X                      nil t)
  232. X           (replace-match ""))
  233. X          (t
  234. X           (error "Message is not a digest.")))
  235. X        (goto-char (point-min))
  236. X        (cond ((re-search-forward (concat "^" (make-string 55 ?-) "-*\n*")
  237. X                      nil t)
  238. X           (delete-region (point-min) (point))
  239. X           (insert pcmail-babyl-begin "\n0,"
  240. X               (pcmail-format-babyl-attrs 
  241. X                (aref pcmail-attr-vector n))
  242. X               "\n" pcmail-babyl-old-header-delim)
  243. X           (pcmail-insert-digest-name digest-name))
  244. X          (t
  245. X           (error "Message is not a digest.")))
  246. X        (while (re-search-forward (concat pcmail-header-delim
  247. X                          short-dashes "-*\n*") 
  248. X                      nil t)
  249. X          (replace-match (concat pcmail-babyl-end pcmail-babyl-begin
  250. X                     "\n0,"
  251. X                     (pcmail-format-babyl-attrs 
  252. X                      (aref pcmail-attr-vector n))
  253. X                     "\n" pcmail-babyl-old-header-delim))
  254. X          (pcmail-insert-digest-name digest-name))
  255. X        (message "Message successfully undigestified")
  256. X        (setq done t))
  257. X      (pcmail-set-message-vectors start)
  258. X      (pcmail-set-attribute n "undigestified" t)
  259. X      (pcmail-set-attribute n "deleted" t))
  260. X      (or done
  261. X      (delete-region start end))
  262. X      (move-marker start nil)
  263. X      (move-marker end nil)
  264. X      (pcmail-narrow-to-message n))))
  265. X
  266. X(defun pcmail-insert-digest-name (name)
  267. X  "Make a To: field in the current message and make NAME its contents.
  268. XArgs: (name)"
  269. X  (save-restriction
  270. X    (narrow-to-region (point)
  271. X              (progn (search-forward pcmail-header-delim)
  272. X                 (point)))
  273. X    (cond ((not (mail-fetch-field "to"))
  274. X       (goto-char (point-min))
  275. X       (re-search-forward "^from:[ \t]*.*\n" nil t)
  276. X       (insert "To: " name "\n")))))
  277. X
  278. X(defun pcmail-toggle-message-header ()
  279. X  "Show original message header of current message if pruned header is now
  280. Xshown, or vice versa.
  281. XArgs: none"
  282. X  (interactive)
  283. X  (pcmail-barf-if-empty-folder)
  284. X  (let ((n (pcmail-make-absolute pcmail-current-subset-message)))
  285. X    (cond ((pcmail-header-pruned-p n)
  286. X       (pcmail-unprune-header n))
  287. X      (t
  288. X        (pcmail-prune-header n)))
  289. X    (pcmail-narrow-to-message n)))
  290. X
  291. X;;;; Various utility routines that know about Babyl-formatted messages
  292. X
  293. X(defun pcmail-make-uninteresting-fields-regexp ()
  294. X  "Make a pruning regexp from the fields in pcmail-uninteresting-fields-list.
  295. XArgs: none"
  296. X  (and pcmail-uninteresting-fields-list
  297. X       (setq pcmail-uninteresting-fields-regexp
  298. X         (concat "^"
  299. X             (mapconcat 'identity pcmail-uninteresting-fields-list
  300. X                ":\\|^")
  301. X             ":"))))
  302. X
  303. X(defun pcmail-unprune-header (n)
  304. X  "Set message N's header to its original, unpruned state.
  305. XArgs: (n)
  306. X  Delete message absolute-numbered N's pruned header, leaving only the 
  307. Xunpruned header. Preserve the state of buffer-modified-p; i.e. if it was nil, 
  308. Xkeep it nil despite our modifications.  This saves on disk writes and doesn't 
  309. Xhurt us since all messages are automatically pruned on display as necessary 
  310. Xanyway."
  311. X  (and (not (zerop n))
  312. X       (pcmail-header-pruned-p n)
  313. X       (let ((buffer-read-only nil)
  314. X         (mod (buffer-modified-p)))
  315. X     (widen)
  316. X     (goto-char (pcmail-msgbeg n))
  317. X     (forward-line 1)
  318. X     (delete-char 1)
  319. X     (insert ?0)
  320. X     (forward-line 1)
  321. X     (insert pcmail-babyl-old-header-delim)
  322. X     (search-forward pcmail-babyl-old-header-delim)
  323. X     (forward-line -1)
  324. X     (let ((temp (point)))
  325. X       (and (search-forward pcmail-header-delim nil t)
  326. X        (delete-region temp (point))))
  327. X     (set-buffer-modified-p mod))))
  328. X  
  329. X(defun pcmail-prune-header (n)
  330. X  "Copy message header and prune the copy.
  331. XArgs: (n)
  332. X  Copy message absolute-numbered N's message header, prune it, and place the 
  333. Xpruned header after the original header line so it will be displayed by 
  334. Xpcmail-narrow-to-message.  Throw away all headers in 
  335. Xpcmail-uninteresting-fields-list.  Leave current buffer narrowed to pruned 
  336. Xheader.  Save the state of buffer-modified-p before pruning and restore 
  337. Xafterwards.  This saves on disk writes and doesn't hurt us since all messages 
  338. Xare automatically pruned on display as necessary anyway."
  339. X  (or (zerop n)
  340. X      (pcmail-header-pruned-p n)
  341. X      (let ((buffer-read-only nil)
  342. X        (mod (buffer-modified-p)))
  343. X    (widen)
  344. X    (goto-char (pcmail-msgbeg n))
  345. X    (forward-line 1)
  346. X    (delete-char 1)
  347. X    (insert ?1)
  348. X    (forward-line 1) 
  349. X    (if (looking-at (regexp-quote pcmail-babyl-old-header-delim))
  350. X        (delete-region (point) (progn (forward-line 1) (point))))
  351. X    (insert-buffer-substring (current-buffer) 
  352. X                 (point)
  353. X                 (save-excursion 
  354. X                   (search-forward pcmail-header-delim
  355. X                           (pcmail-msgend n)
  356. X                           'move)
  357. X                   (point)))
  358. X    (insert pcmail-babyl-old-header-delim)
  359. X    (narrow-to-region (point)
  360. X              (progn
  361. X                (search-forward pcmail-header-delim
  362. X                        (pcmail-msgend n) t)
  363. X                (point)))
  364. X    (pcmail-nuke-uninteresting-fields n)
  365. X    (set-buffer-modified-p mod))))
  366. X
  367. X(defun pcmail-nuke-uninteresting-fields (n)
  368. X  "Delete all of message N's header fields in pcmail-uninteresting-fields-list.
  369. XArgs: (n)
  370. X  Search for matches for pcmail-uninteresting-fields-regexp, deleting region
  371. Xfrom matched text start through possible field continuation lines.  Assume 
  372. Xregion is narrowed to message absolute-numbered N's header."
  373. X  (or pcmail-uninteresting-fields-regexp
  374. X      (pcmail-make-uninteresting-fields-regexp))
  375. X  (let ((case-fold-search t))
  376. X    (goto-char (point-min))
  377. X    (while (re-search-forward pcmail-uninteresting-fields-regexp nil t)
  378. X      (beginning-of-line)
  379. X      (delete-region (point)
  380. X             (progn (re-search-forward "\n[^ \t]")
  381. X                (forward-char -1)
  382. X                (point)))
  383. X      (goto-char (point-min)))))
  384. X
  385. X(defun pcmail-header-pruned-p (n)
  386. X  "Return T if message absolute-numbered N's header is pruned, NIL else.
  387. XArgs: (n)"
  388. X  (save-excursion
  389. X    (save-restriction
  390. X      (widen)
  391. X      (goto-char (pcmail-msgbeg n))
  392. X      (forward-line 1)
  393. X      (= (following-char) ?1))))
  394. X
  395. X(defun pcmail-narrow-to-unpruned-header (n)
  396. X  "Narrow to the region around message absolute-numbered N's unpruned header.
  397. XArgs: (n)"
  398. X  (widen)
  399. X  (goto-char (pcmail-msgbeg n))
  400. X  (cond ((pcmail-header-pruned-p n)
  401. X     (forward-line 2)        ;skip over attrs
  402. X     (narrow-to-region (point)
  403. X               (progn (search-forward 
  404. X                   pcmail-babyl-old-header-delim)
  405. X                  (forward-line -1) (point))))
  406. X    (t
  407. X     (forward-line 3)        ;skip over attrs, EOOH
  408. X      (narrow-to-region
  409. X        (point)
  410. X        (progn (search-forward pcmail-header-delim
  411. X                   (pcmail-msgend n) 'move)
  412. X           (point))))))
  413. X
  414. X(defun pcmail-narrow-to-message (n)
  415. X  "Narrow the current buffer to message absolute-numbered N.
  416. XArgs: (n)
  417. X  Narrowed region is message N in a displayable form, i.e. starts with the
  418. Xmessage's pruned header and does not include Babyl delimiters, Babyl
  419. Xheader information, or unpruned header.  If N is 0, narrow to the current
  420. Xfolder's Babyl header."
  421. X  (widen)
  422. X  (goto-char (pcmail-msgbeg n))
  423. X  (cond ((zerop n)
  424. X      (narrow-to-region (pcmail-msgbeg n) (1- (pcmail-msgend n))))
  425. X    (t
  426. X     (narrow-to-region
  427. X      (progn (search-forward pcmail-babyl-old-header-delim nil t) (point))
  428. X      (- (pcmail-msgend n) 2)))))
  429. X
  430. X(defun pcmail-narrow-to-field (f)
  431. X  "Narrow the current buffer to the contents of header field F.
  432. XArgs: (f)
  433. X  Go to the beginning of current narrowed region, search for field F, and
  434. Xnarrow to its contents.  Assume that the region is already narrowed to a 
  435. Xmessage header.  Return non-NIL if F exists, NIL else."
  436. X  (let ((start))
  437. X    (goto-char (point-min))
  438. X    (cond ((re-search-forward (concat "^" (regexp-quote f) ":[ \t]*")
  439. X                  nil t)
  440. X       (setq start (point))
  441. X       (while (progn (forward-line 1) (looking-at "[ \t]")))
  442. X       (narrow-to-region start (point))
  443. X       (goto-char start)
  444. X       t))))
  445. X
  446. X(defun pcmail-narrow-to-babyl-attrs (&optional n)
  447. X  "Narrow the current buffer to a message's Babyl attribute list.
  448. XArgs: (&optional N)
  449. X  If N is non-NIL, narrow the current buffer to message absolute-numbered N's 
  450. XBabyl attribute list, otherwise narrow to the nearest Babyl attribute list 
  451. Xin the current buffer.  Nearest Babyl message is found by searching backward
  452. Xthrough the current buffer for the previous message's Babyl message-end 
  453. Xdelimiter and parsing the attribute list following.  If no delimiter 
  454. Xexists (i.e. point is at the Babyl folder header), return NIL."
  455. X  (widen)
  456. X  (let ((found (if n
  457. X           (goto-char (pcmail-msgbeg n))
  458. X         (re-search-backward 
  459. X          (concat pcmail-babyl-end pcmail-babyl-begin) nil t))))
  460. X    (and found
  461. X     (cond ((re-search-forward "[01]," (and n (pcmail-msgend n)) t)
  462. X        (narrow-to-region (point) (progn (end-of-line) (point)))
  463. X        (goto-char (point-min)))
  464. X           (t
  465. X        (error "Region not Babyl format (narrow-to-babyl-attrs)"))))))
  466. X
  467. X(defun pcmail-narrow-to-babyl-header ()
  468. X  "Narrow the current buffer to its folder Babyl header.
  469. XArgs: none"
  470. X  (widen)
  471. X  (goto-char (point-min))
  472. X  (narrow-to-region 
  473. X   (point)
  474. X   (progn (or (re-search-forward pcmail-babyl-end nil t)
  475. X          (error "Region not Babyl format (narrow-to-babyl-header)"))
  476. X      (1- (point))))
  477. X  (goto-char (point-min)))
  478. X
  479. X(defun pcmail-insert-babyl-header (mail-drop-list)
  480. X  "Insert a folder Babyl header at the start of the current buffer.
  481. XArgs: (mail-drop-list)"
  482. X  (goto-char (point-min))
  483. X  (insert "BABYL OPTIONS:\nVersion: 5\nLabels: printed, copied, edited, "
  484. X      "timely, expired, undigestified, precious\n"
  485. X      (if mail-drop-list
  486. X          (concat "Mail: "
  487. X              (mapconcat '(lambda (s) (prin1-to-string s)) 
  488. X                 mail-drop-list ", ")
  489. X              "\n")
  490. X        "")
  491. X      "Note: if you can see this, this folder is empty." 
  492. X      pcmail-babyl-end))
  493. X
  494. X(defun pcmail-convert-region-to-babyl-format (mail-drop start end)
  495. X  "Convert region from native mail drop format to Babyl format.
  496. XArgs: (mail-drop start end)
  497. X  Convert the messages between buffer positions START and END from native
  498. Xmail drop format to Babyl format.  This means installing message-delimiting 
  499. Xmarkers, creating an attribute list, and adding it to the list of such lists
  500. Xmaintained by the calling function.  Conversion functions are defined in 
  501. XMAIL-DROP through the 'conversion-function property.  Leave the current 
  502. Xbuffer narrowed and return the number of messages converted."
  503. X  (save-excursion
  504. X    (save-restriction
  505. X      (narrow-to-region start end)
  506. X      (goto-char (point-min))
  507. X      (let ((case-fold-search t)
  508. X        (conv-fn (get mail-drop 'conversion-function))
  509. X        (msg-start-regexp (get mail-drop 'msg-start-regexp))
  510. X        (newmsgs 0))
  511. X    (cond ((not conv-fn)
  512. X           (message "Missing conversion-function property in mail drop %s" 
  513. X            mail-drop)
  514. X           (ding)
  515. X           (sit-for 1))
  516. X          ((not msg-start-regexp)
  517. X           (message "Missing msg-start-regexp property in mail drop %s" 
  518. X            mail-drop)
  519. X           (ding)
  520. X           (sit-for 1)))
  521. X    (while (not (eobp))
  522. X      (cond ((and conv-fn msg-start-regexp (looking-at msg-start-regexp))
  523. X         (funcall conv-fn))
  524. X        (t
  525. X         (pcmail-convert-unknown-message)))
  526. X      (and (zerop (% (setq newmsgs (1+ newmsgs)) pcmail-progress-interval))
  527. X           (message "Checking %s...%d" mail-drop newmsgs))
  528. X      (narrow-to-region (point) (point-max)))
  529. X    newmsgs))))
  530. X
  531. X(defun pcmail-scan-babyl-messages (&optional start)
  532. X  "Scan the current folder buffer, setting up message information.
  533. XArgs: (start)
  534. X  Create attribute list and message marker list for current folder.  Put 
  535. Xmessage-delimiting markers in messages-list, message attributes in
  536. Xattr-list, timely message numbers in timely-list, and bump message total 
  537. Xtotal-messages.  Scan from buffer position START to end of buffer."
  538. X  (let ((msg-attr-list))
  539. X    (save-excursion
  540. X      (save-restriction
  541. X    (widen)
  542. X    (goto-char (or start (point-min)))
  543. X    (while (re-search-forward pcmail-babyl-end nil t)
  544. X      (setq msg-attr-list (pcmail-make-babyl-attr-list)
  545. X        attr-list (cons msg-attr-list attr-list)
  546. X        messages-list (cons (point-marker) messages-list))
  547. X      (and (pcmail-in-sequence-p "timely" msg-attr-list)
  548. X           (setq timely-list (cons total-messages timely-list)))
  549. X      (and (zerop (% (setq total-messages (1+ total-messages)) 
  550. X                 pcmail-progress-interval))
  551. X           (message "Counting messages in %s...%d" pcmail-folder-name
  552. X                total-messages)))
  553. X    (setq messages-list (nreverse messages-list)
  554. X          attr-list (nreverse attr-list))))))
  555. X
  556. X(defun pcmail-make-babyl-attr-list ()
  557. X  "Return a list of attribute strings from a message's Babyl label list.
  558. XArgs: none
  559. XCreate an attribute string list from the closest message's Babyl attribute
  560. Xinformation.  Assume point is at the start of a message's Babyl information.
  561. XThis will work on both RMAIL-style and true Babyl-style attribute lists."
  562. X  (save-excursion
  563. X    (save-restriction
  564. X      (and (pcmail-narrow-to-babyl-attrs)
  565. X       (pcmail-parse-space-list 
  566. X        (buffer-substring (point-min) (point-max)))))))
  567. X
  568. X(defun pcmail-babyl-defined-attribute-p (attr)
  569. X  "Return non-NIL if ATTR is a babyl-defined attribute, NIL else."
  570. X  (pcmail-in-sequence-p attr pcmail-babyl-defined-attributes))
  571. X
  572. X(defun pcmail-format-babyl-attrs (l)
  573. X  "Turn a list of attributes into a Babyl-format label string.
  574. XArgs: (attrlist)
  575. XGiven a list of attributes, turns it into a Babyl-compatible label string.
  576. XThe string is of the form \"( <attr>,)*,( <user-defined-label>,)*\"."
  577. X  (let ((sys-attrs) (user-attrs))
  578. X    (while l
  579. X      (if (pcmail-babyl-defined-attribute-p (car l))
  580. X      (setq sys-attrs (cons (car l) sys-attrs))
  581. X    (setq user-attrs (cons (car l) user-attrs)))
  582. X      (setq l (cdr l)))
  583. X
  584. X    ; now have 2 lists: system attributes and user attributes
  585. X    ; put them together according to the Babyl specification
  586. X    (concat 
  587. X     (mapconcat '(lambda (s) (concat " " s ",")) sys-attrs "")
  588. X     ","
  589. X     (mapconcat '(lambda (s) (concat " " s ",")) user-attrs ""))))
  590. X       
  591. X(defun pcmail-add-babyl-attr (n attr)
  592. X  "Add a label to the current message absolute-numbered N's babyl label list.
  593. XArgs: (n attr)
  594. XIf N is NIL, search backward for the nearest Babyl message, otherwise use
  595. Xmessage absolute-numbered N.  If ATTR is babyl-defined (i.e. a member of
  596. Xthe list pcmail-babyl-defined-attributes), place it at the end of the 
  597. Xattribute list according to the Babyl specification.  Otherwise put it
  598. Xat the beginning."
  599. X  (save-excursion
  600. X    (save-restriction
  601. X      (let ((buffer-read-only))
  602. X    (pcmail-narrow-to-babyl-attrs n)
  603. X    (if (pcmail-babyl-defined-attribute-p attr)
  604. X        (goto-char (point-min))
  605. X      (goto-char (point-max)))
  606. X    (insert " " attr ",")))))
  607. X
  608. X(defun pcmail-remove-babyl-attr (n attr)
  609. X  "Remove a label from message absolute-numbered N's babyl label list.
  610. XArgs: (n attr)
  611. XIf N is NIL, search backward for the nearest Babyl message, otherwise use
  612. Xmessage absolute-numbered N.  Remove the attribute."
  613. X  (save-excursion
  614. X    (save-restriction
  615. X      (let ((buffer-read-only))
  616. X    (pcmail-narrow-to-babyl-attrs n)
  617. X    (and (re-search-forward (concat " ?" attr ",") nil t)
  618. X         (delete-region (match-beginning 0) (match-end 0)))))))
  619. X
  620. X(defun pcmail-babyl-attr-present-p (n attr)
  621. X  "Return non-NIL if ATTR is present in message absolute-numbered N, NIL else.
  622. XArgs: (n attr)
  623. XIf N is NIL, narrow to most recent babyl message's babyl label list, 
  624. Xotherwise narrow to message absolute-numbered N's list.  Return non-NIL if
  625. XATTR is there, NIL else."
  626. X  (save-excursion
  627. X    (save-restriction
  628. X      (pcmail-narrow-to-babyl-attrs n)
  629. X      (re-search-forward (concat " ?" attr ",") nil t))))
  630. X
  631. X(defun pcmail-user-defined-babyl-attr-list ()
  632. X  "Return the list of non-Babyl-defined attributes in the Labels option
  633. Xat the beginning of the current mail file."
  634. X  (let ((l) (k))
  635. X    (save-excursion
  636. X      (save-restriction)
  637. X      (pcmail-narrow-to-babyl-header)
  638. X      (setq l (mail-fetch-field "labels" nil t)
  639. X        k (mail-fetch-field "keywords" nil t)) ;alt form
  640. X      (if k (setq l (if l (concat l " " k) k)))
  641. X      (and l (pcmail-parse-space-list l)))))
  642. X
  643. X(defun pcmail-insert-user-defined-babyl-attr (attr)
  644. X  "Insert the user-defined attr ATTR into the current and primary mail files.
  645. XArgs: (attr)
  646. XIf attr is not already present, insert it into both the current mail file
  647. Xand the primary mail file (named pcmail-primary-folder-name).  The Babyl
  648. Xspecification requires that all user-defined labels in a particular mail
  649. Xfile appear in that mail file's labels: option field.  We also put the
  650. Xattr in the primary mail file's labels: option field so that it gets
  651. Xinterned in the attr obarray at mail reader startup."
  652. X  (pcmail-insert-user-defined-babyl-attr-1 attr pcmail-folder-name)
  653. X  (pcmail-insert-user-defined-babyl-attr-1 attr pcmail-primary-folder-name)
  654. X
  655. X  ; insert may have screwed up region around current message.  Fix it.
  656. X  (pcmail-narrow-to-message 
  657. X   (pcmail-make-absolute pcmail-current-subset-message)))
  658. X
  659. X(defun pcmail-insert-user-defined-babyl-attr-1 (attr folder-name)
  660. X  "Insert the user-defined attr ATTR into mail file FOLDER-NAME.
  661. XArgs: (args folder-name)
  662. XThis could be made a lot simpler by looking for a labels line and appending
  663. Xto it or creating it if it doesn't exist.  Instead, we fill labels lines
  664. Xwith no more than default-fill-column worth of labels, then create a new
  665. Xlabel line.  Also, labels are comma-separated with no leading commas."
  666. X  (save-excursion
  667. X    (pcmail-open-folder folder-name)
  668. X    (save-excursion
  669. X      (save-restriction
  670. X    (pcmail-narrow-to-babyl-header)
  671. X    (let ((buffer-read-only)
  672. X          (labelist)
  673. X          (label-line-exists)
  674. X          (label-exists)
  675. X          (label-null)
  676. X          (label-start))
  677. X
  678. X      ; skullduggery to use multiple labels: lines rather than
  679. X      ; overflow the line.  Search for last labels: line
  680. X      (while (re-search-forward "Labels:[ \t]*" nil t)
  681. X        (setq label-start (point))
  682. X        (and (looking-at "\n") (setq label-null t)) ;no labels here!
  683. X        (and (re-search-backward attr (prog1 (point) (end-of-line)) t)
  684. X         (setq label-exists t))
  685. X        (setq label-line-exists t))
  686. X
  687. X      (cond ((not label-exists)    ;don't bother if label is already there
  688. X
  689. X         ; if there is a label line, get the last line's contents
  690. X         (and label-line-exists
  691. X              (setq labelist
  692. X                (buffer-substring label-start (point))))
  693. X
  694. X         ; if there is no label line, or the current one will be too 
  695. X         ; long with the newly-added label, make a new label line, 
  696. X         ; otherwise use the current one
  697. X         (cond ((or (not label-line-exists)
  698. X                (> (+ 10 (length attr) (length labelist))
  699. X                   default-fill-column))
  700. X            (goto-char (point-max))
  701. X            (insert "Labels: " attr "\n"))
  702. X               (t
  703. X            (insert (or label-null ",") " " attr))))))))))
  704. X
  705. X(defun pcmail-get-babyl-mail-drop-list ()
  706. X  "Return a list of interned mail drop symbols derived from the names in
  707. Xthe current mail file's mail: option field."
  708. X  (save-excursion
  709. X    (save-restriction
  710. X      (pcmail-narrow-to-babyl-header)
  711. X      (let ((s))
  712. X    (setq s (mail-fetch-field "mail"))
  713. X    (and s
  714. X         (mapcar '(lambda (x) (intern x)) (pcmail-parse-space-list s)))))))
  715. X
  716. X(provide 'pcmailbabyl)
  717. ________This_Is_The_END________
  718. if test `wc -c < pcmailbabyl.el` -ne 26267; then
  719.     echo 'shar: pcmailbabyl.el was damaged during transit (should have been 26267 bytes)'
  720. fi
  721. fi        ; : end of overwriting check
  722. echo 'x - pcmailmail.el'
  723. if test -f pcmailmail.el; then echo 'shar: not overwriting pcmailmail.el'; else
  724. sed 's/^X//' << '________This_Is_The_END________' > pcmailmail.el
  725. X;;;; GNU-EMACS PCMAIL mail reader
  726. X
  727. X;;  Written by Mark L. Lambert
  728. X;;  Architecture Group, Network Products Division
  729. X;;  Oracle Corporation
  730. X;;  20 Davis Dr,
  731. X;;  Belmont CA, 94002
  732. X;;
  733. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  734. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  735. X
  736. X;; Copyright (C) 1989 Mark L. Lambert
  737. X
  738. X;; This file is not officially part of GNU Emacs, but is being
  739. X;; donated to the Free Software Foundation.  As such, it is
  740. X;; subject to the standard GNU-Emacs General Public License,
  741. X;; referred to below.
  742. X
  743. X;; GNU Emacs is distributed in the hope that it will be useful,
  744. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  745. X;; accepts responsibility to anyone for the consequences of using it
  746. X;; or for whether it serves any particular purpose or works at all,
  747. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  748. X;; License for full details.
  749. X
  750. X;; Everyone is granted permission to copy, modify and redistribute
  751. X;; GNU Emacs, but only under the conditions described in the
  752. X;; GNU Emacs General Public License.   A copy of this license is
  753. X;; supposed to have been given to you along with GNU Emacs so you
  754. X;; can know your rights and responsibilities.  It should be in a
  755. X;; file named COPYING.  Among other things, the copyright notice
  756. X;; and this notice must be preserved on all copies.
  757. X
  758. X;; The following code implements a Pcmail client under GNU-EMACS.  For
  759. X;; details on how Pcmail works, see NIC RFC-993.
  760. X
  761. X;;;; global variable definitions
  762. X
  763. X;;;; pcmail mail composition commands -- compose, forward, reply
  764. X
  765. X(defun pcmail-mail ()
  766. X  "Compose mail in another window.
  767. XArgs: none
  768. X  Compose mail in another window.  Any header parsing can be made
  769. Xto conform to NIC RFC-822 by setting the variable mail-use-rfc822 non-NIL."
  770. X  (interactive)
  771. X
  772. X  ; note the skullduggery here.  We need to set the referencing message
  773. X  ; and folder now because once we call mail-other-window we lose the
  774. X  ; pcmail local variables.  We can't set the referencing variables
  775. X  ; now because they are local variables defined in 
  776. X  ; pcmail-overlay-mail-commands
  777. X  (let ((n pcmail-current-subset-message)
  778. X    (mbox pcmail-folder-name))
  779. X    (mail-other-window nil nil nil nil nil (current-buffer))
  780. X    (pcmail-overlay-mail-commands nil n mbox)))
  781. X
  782. X(defun pcmail-answer-message (just-sender)
  783. X  "Answer the current message.
  784. XArgs: (just-sender)
  785. X  Compose a reply to the current message.  Set this message's answered
  786. Xattribute.  If JUST-SENDER is non-nil (interactively with prefix argument),
  787. XDo not include CC: to all other recipients of original message, otherwise
  788. Xdo.  While composing the reply, use \\[mail-yank-original] to yank the
  789. Xoriginal message into it.
  790. X
  791. XAny header parsing can be made to conform to NIC RFC-822 by setting
  792. Xthe variable mail-use-rfc822 non-NIL.
  793. X
  794. XIf the variable pcmail-yank-original is non-NIL, yank the original
  795. Xmessage into the mail buffer."
  796. X  (interactive "P")
  797. X  (pcmail-barf-if-empty-folder)
  798. X  (let ((from) 
  799. X    (reply-to)
  800. X    (message-id)
  801. X    (cc)
  802. X    (subject)
  803. X    (date)
  804. X    (to)
  805. X    (resent-p)
  806. X    (n (pcmail-make-absolute pcmail-current-subset-message))
  807. X    (relnum pcmail-current-subset-message)
  808. X    (mbox pcmail-folder-name))
  809. X    (save-excursion
  810. X      (save-restriction
  811. X    (pcmail-narrow-to-unpruned-header n)
  812. X    (setq to (or (setq resent-p (mail-fetch-field "resent-to" nil t))
  813. X             (setq resent-p (mail-fetch-field "resent-apparently-to" 
  814. X                              nil t)) ;uck
  815. X             (mail-fetch-field "to" nil t)
  816. X             (mail-fetch-field "apparently-to" nil t) ;uck
  817. X             ""))
  818. X    (cond (resent-p
  819. X        (setq from (mail-fetch-field "resent-from")
  820. X              reply-to (or (mail-fetch-field "resent-reply-to" t)
  821. X                   from)
  822. X              cc (if just-sender nil (mail-fetch-field "resent-cc" t))
  823. X              subject (or (mail-fetch-field "resent-subject" t)
  824. X                  (mail-fetch-field "subject" t))
  825. X              date (mail-fetch-field "resent-date" t)
  826. X              message-id (or (mail-fetch-field "resent-message-id" t)
  827. X                     "")))
  828. X          (t
  829. X        (setq from (mail-fetch-field "from")
  830. X              reply-to (or (mail-fetch-field "reply-to" t)
  831. X                   from)
  832. X              cc (if just-sender nil (mail-fetch-field "cc" nil t))
  833. X              subject (mail-fetch-field "subject" t)
  834. X              date (mail-fetch-field "date")
  835. X              message-id (or (mail-fetch-field "message-id")
  836. X                     ""))))))
  837. X
  838. X    ; if subject was a Re:, strip the Re: since one will be added later
  839. X    (and subject
  840. X     (string-match "^[ \t]*\\(re:[ \t]*\\)*\\(.*\\)" subject)
  841. X     (setq subject (substring subject (match-beginning 2) (match-end 2))))
  842. X
  843. X    ; and compose the message
  844. X    (mail-other-window nil
  845. X      (mail-strip-quoted-names reply-to)
  846. X      (and subject (concat "Re: " subject))
  847. X      (pcmail-make-in-reply-to-field from date message-id)
  848. X      (cond (just-sender
  849. X          nil)
  850. X        (t
  851. X          (let* ((cc-list (rmail-dont-reply-to
  852. X                (mail-strip-quoted-names
  853. X                  (if (null cc) to (concat to ", " cc))))))
  854. X        (if (string= cc-list "") nil cc-list))))
  855. X      (current-buffer))
  856. X    (pcmail-overlay-mail-commands 'answered relnum mbox)
  857. X    (pcmail-maybe-yank-original)))
  858. X
  859. X(defun pcmail-maybe-yank-original ()
  860. X  "Maybe yank replied-to message into reply body.
  861. XArgs: none
  862. X  If pcmail-yank-message-on-reply is non-NIL, place the replied-to message
  863. Xin the message reply.  The header is filtered through the
  864. Xmail-yank-ignored-headers regexp and is indented.  If 
  865. Xpcmail-yank-message-on-reply is a string, highlight the yanked message
  866. Xwith that string at the beginning of each line."
  867. X  (and pcmail-yank-message-on-reply
  868. X       (pcmail-insert-current-message nil)))
  869. X
  870. X(defun pcmail-make-in-reply-to-field (from date message-id)
  871. X  " Create an in-reply-to field from from:, date:, and message-id: fields.
  872. XArgs: (from date message-id)"
  873. X  (let ((field))
  874. X    (and from (setq field (pcmail-quoted-name from)))
  875. X    (and date (setq field (concat field "'s message of " date)))
  876. X    (and message-id (setq field (concat field " " message-id)))))
  877. X
  878. X(defun pcmail-quoted-name (field)
  879. X  "Return FIELD's quoted name or FIELD if no quoted name exists.
  880. XArgs: (field)."
  881. X  (if (or (string-match "\\(.*\\)  *<" field)
  882. X      (string-match "(\\(.*\\))" field))
  883. X      (setq field (substring field (match-beginning 1) (match-end 1)))
  884. X    field))
  885. X
  886. X(defun pcmail-forward-message (dont-clear)
  887. X  "Forward the current message.
  888. XArgs: dont-clear
  889. X  Set up a forwarded message for editing by the user.  Forwarded messages
  890. Xare given the forwarded attribute.  If called interactively, a prefix
  891. Xarg means do not filter the header of the forwarded message prior to insertion
  892. Xin the mail composition buffer.  If pcmail-highlight-forwarded-message
  893. Xis non-NIL, put highlight lines at the beginning and end of the forwarded
  894. Xtext.   Any header parsing can be made to conform to NIC RFC-822 by setting 
  895. Xthe variable mail-use-rfc822 non-NIL."
  896. X  (interactive "P")
  897. X  (pcmail-barf-if-empty-folder)
  898. X  (let ((forward-buffer (current-buffer))
  899. X    (start) (subject (mail-fetch-field "subject"))
  900. X    (forwarded-from)
  901. X    (n pcmail-current-subset-message)
  902. X    (mbox pcmail-folder-name))
  903. X
  904. X    ; if subject was of a forwarded message, strip the subject portion to
  905. X    ; avoid cascaded [foo: [foo: [foo: ...]]] nightmares
  906. X    (and subject
  907. X     (let ((match) (lastgood))
  908. X       (while (setq match (string-match "\\[.*: " subject lastgood))
  909. X         (setq lastgood (match-end 0)))
  910. X       (and lastgood
  911. X        (setq subject (substring subject lastgood))
  912. X        (and (setq match (string-match "\\]+" subject))
  913. X             (setq subject (substring subject 0 match))))))
  914. X    (setq forwarded-from (mail-strip-quoted-names (mail-fetch-field "From")))
  915. X    (mail nil nil 
  916. X      (if subject
  917. X          (format "[%s: %s]" forwarded-from subject)
  918. X        (format "[message from %s]" forwarded-from))
  919. X      nil nil (current-buffer))
  920. X    (save-excursion
  921. X      (goto-char (point-max))
  922. X      (forward-line 1)
  923. X      (and pcmail-highlight-forwarded-message
  924. X       (insert "\n---Begin Forwarded Message---\n\n"))
  925. X      (setq start (point))
  926. X      (insert-buffer forward-buffer)
  927. X      (or dont-clear (mail-yank-clear-headers start (mark)))
  928. X      (goto-char (point-max))
  929. X      (and pcmail-highlight-forwarded-message
  930. X       (insert "\n\n---End Forwarded Message---\n")))
  931. X    (pcmail-overlay-mail-commands 'forwarded n mbox)))
  932. X
  933. X(defun pcmail-overlay-mail-commands (type relnum mbox)
  934. X  "Overlay standard mail functions with augmented pcmail functions.
  935. XArgs: (type relnum mbox)
  936. X  Also set local variables which will tell the mail-send routine whether
  937. Xor not to set referencing message attributes on send."
  938. X  (make-local-variable 'pcmail-referencing-message-type)
  939. X  (setq pcmail-referencing-message-type type)
  940. X  (make-local-variable 'pcmail-referencing-message-rel-number)
  941. X  (setq pcmail-referencing-message-rel-number relnum)
  942. X  (make-local-variable 'pcmail-referencing-message-folder)
  943. X  (setq pcmail-referencing-message-folder mbox)
  944. X  (define-key mail-mode-map "\C-c\C-y" 'pcmail-insert-current-message)
  945. X  (define-key mail-mode-map "\C-c\C-c" 'pcmail-mail-send-and-exit)
  946. X  (define-key mail-mode-map "\C-c\C-s" 'pcmail-mail-send))
  947. X
  948. X(defun pcmail-mail-send-and-exit (arg)
  949. X  "Like mail-send-and-exit, but sensitive to the other buffer being 
  950. Xpcmail-mode rather than rmail-mode."
  951. X  (interactive "P")
  952. X  (pcmail-mail-send)
  953. X  (bury-buffer (current-buffer))
  954. X  (if (and (not arg)
  955. X       (not (one-window-p))
  956. X       (save-excursion
  957. X         (set-buffer (window-buffer (next-window (selected-window) 'not)))
  958. X         (eq major-mode 'pcmail-folder-mode)))
  959. X      (delete-window)
  960. X    (switch-to-buffer (other-buffer (current-buffer)))))
  961. X
  962. X(defun pcmail-mail-send ()
  963. X  "Like mail-send, but also sets labels of referencing message as necessary.
  964. XArgs: none
  965. X  Calls mail-send.  If successful, sets the forwarded/answered labels of
  966. Xthe message that this message references."
  967. X  (interactive)
  968. X  (let ((type pcmail-referencing-message-type)
  969. X    (rel-n pcmail-referencing-message-rel-number)
  970. X    (n)
  971. X    (mbox pcmail-referencing-message-folder))
  972. X    (mail-send)
  973. X
  974. X    ; if the message to be sent is forwarded or replied-to, set the
  975. X    ; forwarded or replied-to message's forwarded/answered attributes
  976. X    (and mail-reply-buffer
  977. X     type
  978. X     rel-n
  979. X     mbox
  980. X     (pcmail-find-folder mbox)
  981. X     (save-excursion
  982. X       (save-restriction
  983. X         (pcmail-open-folder mbox)
  984. X         (setq n (pcmail-make-absolute rel-n))
  985. X         (pcmail-narrow-to-message n)
  986. X         (cond ((eq type 'forwarded)
  987. X            (pcmail-set-attribute n "forwarded" t)
  988. X            (pcmail-update-folder-mode-line rel-n))
  989. X           ((eq type 'answered)
  990. X            (pcmail-set-attribute n "answered" t)
  991. X            (pcmail-update-folder-mode-line rel-n))))))))
  992. X
  993. X(defun pcmail-insert-current-message (n)
  994. X  "Insert the current folder's current message into an outbound message.
  995. XArgs: (n)
  996. X  Insert the current message into the message composition buffer and filter
  997. Xits header according to mail-yank-ignored-headers.  With a
  998. Xprefix argument N, insert the Nth message in the current subset.  If N
  999. Xis negative, don't filter the inserted message's header."
  1000. X  (interactive "P")
  1001. X  (let ((nostrip) (folderbuf) (msgbuf (current-buffer)))
  1002. X    (if (or (null n)
  1003. X        (zerop n))
  1004. X    (setq n pcmail-referencing-message-rel-number))
  1005. X    (and n
  1006. X     (save-excursion
  1007. X       (if (< n 0) 
  1008. X           (setq nostrip t
  1009. X             n (- n)))
  1010. X       (cond ((pcmail-find-folder pcmail-referencing-message-folder)
  1011. X          (pcmail-open-folder pcmail-referencing-message-folder)
  1012. X          (save-excursion
  1013. X            (save-restriction
  1014. X              (setq n (pcmail-make-absolute n))
  1015. X              (cond ((<= n pcmail-total-messages)
  1016. X                 (pcmail-narrow-to-message n)
  1017. X                 (setq folderbuf (current-buffer))
  1018. X                 (delete-windows-on folderbuf)
  1019. X                 (set-buffer msgbuf)
  1020. X                 (let ((start (point)))
  1021. X                   (insert-buffer folderbuf)
  1022. X                   (or nostrip 
  1023. X                   (run-hooks
  1024. X                    (if (boundp 'mail-yank-hooks)
  1025. X                    'mail-yank-hooks
  1026. X                      'pcmail-default-mail-yank-hook)))
  1027. X                   (exchange-point-and-mark)
  1028. X                   (or (eolp)
  1029. X                   (insert ?\n)))))))))))))
  1030. X
  1031. X;;; yank-message hook, for use with supercite package.  Default hook assumes
  1032. X;;; no supercite capability
  1033. X
  1034. X(setq pcmail-default-mail-yank-hook
  1035. X      '(lambda ()
  1036. X     (mail-yank-clear-headers start (mark))
  1037. X     (indent-rigidly start (mark) 3)
  1038. X     (and (stringp pcmail-yank-prefix)
  1039. X          (while (re-search-forward "^" nil t)
  1040. X        (replace-match pcmail-yank-prefix)
  1041. X        (forward-line 1)))))
  1042. X
  1043. X(provide 'pcmailmail)
  1044. ________This_Is_The_END________
  1045. if test `wc -c < pcmailmail.el` -ne 12137; then
  1046.     echo 'shar: pcmailmail.el was damaged during transit (should have been 12137 bytes)'
  1047. fi
  1048. fi        ; : end of overwriting check
  1049. exit 0
  1050.  
  1051.