mh-folder.el 77 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978
  1. ;;; mh-folder.el --- MH-Folder mode
  2. ;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
  3. ;; Author: Bill Wohler <wohler@newt.com>
  4. ;; Maintainer: Bill Wohler <wohler@newt.com>
  5. ;; Keywords: mail
  6. ;; See: mh-e.el
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; Mode for browsing folders
  20. ;;; Change Log:
  21. ;;; Code:
  22. (require 'mh-e)
  23. (require 'mh-scan)
  24. (mh-require-cl)
  25. ;; Dynamically-created functions not found in mh-loaddefs.el.
  26. (autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
  27. (autoload 'mh-tool-bar-init "mh-tool-bar")
  28. (require 'gnus-util)
  29. (autoload 'message-fetch-field "message")
  30. ;;; MH-E Entry Points
  31. ;;;###autoload
  32. (defun mh-rmail (&optional arg)
  33. "Incorporate new mail with MH.
  34. Scan an MH folder if ARG is non-nil.
  35. This function is an entry point to MH-E, the Emacs interface to
  36. the MH mail system."
  37. (interactive "P")
  38. (mh-find-path)
  39. (if arg
  40. (call-interactively 'mh-visit-folder)
  41. (unless (get-buffer mh-inbox)
  42. (mh-visit-folder mh-inbox (symbol-name mh-unseen-seq)))
  43. (mh-inc-folder)))
  44. ;;;###autoload
  45. (defun mh-nmail (&optional arg)
  46. "Check for new mail in inbox folder.
  47. Scan an MH folder if ARG is non-nil.
  48. This function is an entry point to MH-E, the Emacs interface to
  49. the MH mail system."
  50. (interactive "P")
  51. (mh-find-path) ; init mh-inbox
  52. (if arg
  53. (call-interactively 'mh-visit-folder)
  54. (mh-visit-folder mh-inbox)))
  55. ;;; Desktop Integration
  56. ;; desktop-buffer-mode-handlers appeared in Emacs 22.
  57. (if (boundp 'desktop-buffer-mode-handlers)
  58. (add-to-list 'desktop-buffer-mode-handlers
  59. '(mh-folder-mode . mh-restore-desktop-buffer)))
  60. (defun mh-restore-desktop-buffer (desktop-buffer-file-name
  61. desktop-buffer-name
  62. desktop-buffer-misc)
  63. "Restore an MH folder buffer specified in a desktop file.
  64. When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the
  65. file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer
  66. name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info
  67. used by the `desktop-buffer-handlers' functions."
  68. (mh-find-path)
  69. (mh-visit-folder desktop-buffer-name)
  70. (current-buffer))
  71. ;;; Variables
  72. (defvar mh-folder-filename nil
  73. "Full path of directory for this folder.")
  74. (defvar mh-partial-folder-mode-line-annotation "select"
  75. "Annotation when displaying part of a folder.
  76. The string is displayed after the folder's name. nil for no
  77. annotation.")
  78. (defvar mh-last-destination nil
  79. "Destination of last refile or write command.")
  80. (defvar mh-last-destination-folder nil
  81. "Destination of last refile command.")
  82. (defvar mh-last-destination-write nil
  83. "Destination of last write command.")
  84. (defvar mh-first-msg-num nil
  85. "Number of first message in buffer.")
  86. (defvar mh-last-msg-num nil
  87. "Number of last msg in buffer.")
  88. (defvar mh-msg-count nil
  89. "Number of msgs in buffer.")
  90. ;;; Sequence Menu
  91. (easy-menu-define
  92. mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
  93. '("Sequence"
  94. ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
  95. ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
  96. ["Delete Message from Sequence..." mh-delete-msg-from-seq
  97. (mh-get-msg-num nil)]
  98. ["List Sequences in Folder..." mh-list-sequences t]
  99. ["Delete Sequence..." mh-delete-seq t]
  100. ["Narrow to Sequence..." mh-narrow-to-seq t]
  101. ["Widen from Sequence" mh-widen mh-folder-view-stack]
  102. "--"
  103. ["Narrow to Subject Sequence" mh-narrow-to-subject t]
  104. ["Narrow to Tick Sequence" mh-narrow-to-tick
  105. (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))]
  106. ["Delete Rest of Same Subject" mh-delete-subject t]
  107. ["Toggle Tick Mark" mh-toggle-tick t]
  108. "--"
  109. ["Push State Out to MH" mh-update-sequences t]))
  110. ;;; Message Menu
  111. (easy-menu-define
  112. mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
  113. '("Message"
  114. ["Show Message" mh-show (mh-get-msg-num nil)]
  115. ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
  116. ["Show Message with Preferred Alternative"
  117. mh-show-preferred-alternative (mh-get-msg-num nil)]
  118. ["Next Message" mh-next-undeleted-msg t]
  119. ["Previous Message" mh-previous-undeleted-msg t]
  120. ["Go to First Message" mh-first-msg t]
  121. ["Go to Last Message" mh-last-msg t]
  122. ["Go to Message by Number..." mh-goto-msg t]
  123. ["Modify Message" mh-modify t]
  124. ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
  125. ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
  126. ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
  127. ["Execute Delete/Refile" mh-execute-commands
  128. (mh-outstanding-commands-p)]
  129. "--"
  130. ["Compose a New Message" mh-send t]
  131. ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
  132. ["Forward Message..." mh-forward (mh-get-msg-num nil)]
  133. ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
  134. ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
  135. ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
  136. "--"
  137. ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
  138. ["Print Message" mh-print-msg (mh-get-msg-num nil)]
  139. ["Write Message to File..." mh-write-msg-to-file
  140. (mh-get-msg-num nil)]
  141. ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
  142. ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
  143. ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
  144. ;;; Folder Menu
  145. (easy-menu-define
  146. mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
  147. '("Folder"
  148. ["Incorporate New Mail" mh-inc-folder t]
  149. ["Toggle Show/Folder" mh-toggle-showing t]
  150. ["Execute Delete/Refile" mh-execute-commands
  151. (mh-outstanding-commands-p)]
  152. ["Rescan Folder" mh-rescan-folder t]
  153. ["Thread Folder" mh-toggle-threads
  154. (not (memq 'unthread mh-view-ops))]
  155. ["Pack Folder" mh-pack-folder t]
  156. ["Sort Folder" mh-sort-folder t]
  157. "--"
  158. ["List Folders" mh-list-folders t]
  159. ["Visit a Folder..." mh-visit-folder t]
  160. ["View New Messages" mh-index-new-messages t]
  161. ["Search..." mh-search t]
  162. "--"
  163. ["Quit MH-E" mh-quit t]))
  164. ;;; MH-Folder Keys
  165. (suppress-keymap mh-folder-mode-map)
  166. ;; Use defalias to make sure the documented primary key bindings
  167. ;; appear in menu lists.
  168. (defalias 'mh-alt-show 'mh-show)
  169. (defalias 'mh-alt-refile-msg 'mh-refile-msg)
  170. (defalias 'mh-alt-send 'mh-send)
  171. (defalias 'mh-alt-visit-folder 'mh-visit-folder)
  172. ;; Save the "b" binding for a future `back'. Maybe?
  173. (gnus-define-keys mh-folder-mode-map
  174. " " mh-page-msg
  175. "!" mh-refile-or-write-again
  176. "'" mh-toggle-tick
  177. "," mh-header-display
  178. "." mh-alt-show
  179. ":" mh-show-preferred-alternative
  180. ";" mh-toggle-mh-decode-mime-flag
  181. ">" mh-write-msg-to-file
  182. "?" mh-help
  183. "E" mh-extract-rejected-mail
  184. "M" mh-modify
  185. "\177" mh-previous-page
  186. "\C-d" mh-delete-msg-no-motion
  187. "\t" mh-index-next-folder
  188. [backtab] mh-index-previous-folder
  189. "\M-\t" mh-index-previous-folder
  190. "\e<" mh-first-msg
  191. "\e>" mh-last-msg
  192. "\ed" mh-redistribute
  193. "\r" mh-show
  194. "^" mh-alt-refile-msg
  195. "c" mh-copy-msg
  196. "d" mh-delete-msg
  197. "e" mh-edit-again
  198. "f" mh-forward
  199. "g" mh-goto-msg
  200. "i" mh-inc-folder
  201. "k" mh-delete-subject-or-thread
  202. "m" mh-alt-send
  203. "n" mh-next-undeleted-msg
  204. "\M-n" mh-next-unread-msg
  205. "o" mh-refile-msg
  206. "p" mh-previous-undeleted-msg
  207. "\M-p" mh-previous-unread-msg
  208. "q" mh-quit
  209. "r" mh-reply
  210. "s" mh-send
  211. "t" mh-toggle-showing
  212. "u" mh-undo
  213. "v" mh-index-visit-folder
  214. "x" mh-execute-commands
  215. "|" mh-pipe-msg)
  216. (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
  217. "?" mh-prefix-help
  218. "'" mh-index-ticked-messages
  219. "S" mh-sort-folder
  220. "c" mh-catchup
  221. "f" mh-alt-visit-folder
  222. "k" mh-kill-folder
  223. "l" mh-list-folders
  224. "n" mh-index-new-messages
  225. "o" mh-alt-visit-folder
  226. "p" mh-pack-folder
  227. "q" mh-index-sequenced-messages
  228. "r" mh-rescan-folder
  229. "s" mh-search
  230. "u" mh-undo-folder
  231. "v" mh-visit-folder)
  232. (define-key mh-folder-mode-map "I" mh-inc-spool-map)
  233. (gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
  234. "?" mh-prefix-help
  235. "b" mh-junk-blacklist
  236. "w" mh-junk-whitelist)
  237. (gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
  238. "?" mh-prefix-help
  239. "C" mh-ps-print-toggle-color
  240. "F" mh-ps-print-toggle-faces
  241. "f" mh-ps-print-msg-file
  242. "l" mh-print-msg
  243. "p" mh-ps-print-msg)
  244. (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
  245. "'" mh-narrow-to-tick
  246. "?" mh-prefix-help
  247. "d" mh-delete-msg-from-seq
  248. "k" mh-delete-seq
  249. "l" mh-list-sequences
  250. "n" mh-narrow-to-seq
  251. "p" mh-put-msg-in-seq
  252. "s" mh-msg-is-in-seq
  253. "w" mh-widen)
  254. (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
  255. "?" mh-prefix-help
  256. "u" mh-thread-ancestor
  257. "p" mh-thread-previous-sibling
  258. "n" mh-thread-next-sibling
  259. "t" mh-toggle-threads
  260. "d" mh-thread-delete
  261. "o" mh-thread-refile)
  262. (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
  263. "'" mh-narrow-to-tick
  264. "?" mh-prefix-help
  265. "c" mh-narrow-to-cc
  266. "g" mh-narrow-to-range
  267. "m" mh-narrow-to-from
  268. "s" mh-narrow-to-subject
  269. "t" mh-narrow-to-to
  270. "w" mh-widen)
  271. (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
  272. "?" mh-prefix-help
  273. "s" mh-store-msg ;shar
  274. "u" mh-store-msg) ;uuencode
  275. (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
  276. " " mh-page-digest
  277. "?" mh-prefix-help
  278. "\177" mh-page-digest-backwards
  279. "b" mh-burst-digest)
  280. (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
  281. "?" mh-prefix-help
  282. "a" mh-mime-save-parts
  283. "e" mh-display-with-external-viewer
  284. "i" mh-folder-inline-mime-part
  285. "o" mh-folder-save-mime-part
  286. "t" mh-toggle-mime-buttons
  287. "v" mh-folder-toggle-mime-part
  288. "\t" mh-next-button
  289. [backtab] mh-prev-button
  290. "\M-\t" mh-prev-button)
  291. (cond
  292. ((featurep 'xemacs)
  293. (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
  294. (t
  295. (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
  296. ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
  297. ;;; MH-Folder Help Messages
  298. ;; If you add a new prefix, add appropriate text to the nil key.
  299. ;; In general, messages are grouped logically. Taking the main commands for
  300. ;; example, the first line is "ways to view messages," the second line is
  301. ;; "things you can do with messages", and the third is "composing" messages.
  302. ;; When adding a new prefix, ensure that the help message contains "what" the
  303. ;; prefix is for. For example, if the word "folder" were not present in the
  304. ;; "F" entry, it would not be clear what these commands operated upon.
  305. (defvar mh-folder-mode-help-messages
  306. '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
  307. "[d]elete, [o]refile, e[x]ecute,\n"
  308. "[s]end, [r]eply,\n"
  309. "[;]toggle MIME decoding.\n"
  310. "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
  311. "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
  312. (?F "[l]ist; [v]isit folder;\n"
  313. "[n]ew messages; [']ticked messages; [s]earch;\n"
  314. "[p]ack; [S]ort; [r]escan; [k]ill")
  315. (?P "[p]rint message to [f]ile; old-style [l]pr printing;\n"
  316. "Toggle printing of [C]olors, [F]aces")
  317. (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
  318. "[s]equences, [l]ist,\n"
  319. "[d]elete message from sequence, [k]ill sequence")
  320. (?T "[t]oggle, [d]elete, [o]refile thread")
  321. (?/ "Limit to [c]c, ran[g]e, fro[m], [s]ubject, [t]o; [w]iden")
  322. (?X "un[s]har, [u]udecode message")
  323. (?D "[b]urst digest")
  324. (?K "[v]iew, [i]nline, with [e]xternal viewer; \n"
  325. "[o]utput/save MIME part; save [a]ll parts; \n"
  326. "[t]oggle buttons; [TAB] next; [SHIFT-TAB] previous")
  327. (?J "[b]lacklist, [w]hitelist message"))
  328. "Key binding cheat sheet.
  329. See `mh-set-help'.")
  330. ;;; MH-Folder Font Lock
  331. (defvar mh-folder-font-lock-keywords
  332. (list
  333. ;; Folders when displaying index buffer
  334. (list "^\\+.*"
  335. '(0 'mh-search-folder))
  336. ;; Marked for deletion
  337. (list (concat mh-scan-deleted-msg-regexp ".*")
  338. '(0 'mh-folder-deleted))
  339. ;; Marked for refile
  340. (list (concat mh-scan-refiled-msg-regexp ".*")
  341. '(0 'mh-folder-refiled))
  342. ;; After subject
  343. (list mh-scan-body-regexp
  344. '(1 'mh-folder-body nil t))
  345. ;; Subject
  346. '(mh-folder-font-lock-subject
  347. (1 'mh-folder-followup append t)
  348. (2 'mh-folder-subject append t))
  349. ;; Current message number
  350. (list mh-scan-cur-msg-number-regexp
  351. '(1 'mh-folder-cur-msg-number))
  352. ;; Message number
  353. (list mh-scan-good-msg-regexp
  354. '(1 'mh-folder-msg-number))
  355. ;; Date
  356. (list mh-scan-date-regexp
  357. '(1 'mh-folder-date))
  358. ;; Messages from me (To:)
  359. (list mh-scan-rcpt-regexp
  360. '(1 'mh-folder-to)
  361. '(2 'mh-folder-address))
  362. ;; Messages to me
  363. (list mh-scan-sent-to-me-sender-regexp
  364. '(1 'mh-folder-sent-to-me-hint)
  365. '(2 'mh-folder-sent-to-me-sender)))
  366. "Keywords (regular expressions) used to fontify the MH-Folder buffer.")
  367. (defun mh-folder-font-lock-subject (limit)
  368. "Return MH-E scan subject strings to font-lock between point and LIMIT."
  369. (if (not (re-search-forward mh-scan-subject-regexp limit t))
  370. nil
  371. (if (match-beginning 1)
  372. (set-match-data (list (match-beginning 1) (match-end 3)
  373. (match-beginning 1) (match-end 3) nil nil))
  374. (set-match-data (list (match-beginning 3) (match-end 3)
  375. nil nil (match-beginning 3) (match-end 3))))
  376. t))
  377. ;; Fontify unseen messages in bold.
  378. (defmacro mh-generate-sequence-font-lock (seq prefix face)
  379. "Generate the appropriate code to fontify messages in SEQ.
  380. PREFIX is used to generate unique names for the variables and
  381. functions defined by the macro. So a different prefix should be
  382. provided for every invocation.
  383. FACE is the font-lock face used to display the matching scan lines."
  384. (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
  385. (func (intern (format "mh-folder-font-lock-%s" prefix))))
  386. `(progn
  387. (defvar ,cache nil
  388. "Internal cache variable used for font-lock in MH-E.
  389. Should only be non-nil through font-lock stepping, and nil once
  390. font-lock is done highlighting.")
  391. (make-variable-buffer-local ',cache)
  392. (defun ,func (limit)
  393. "Return unseen message lines to font-lock between point and LIMIT."
  394. (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
  395. (let ((cur-msg (mh-get-msg-num nil)))
  396. (cond ((not ,cache)
  397. nil)
  398. ((>= (point) limit) ;Presumably at end of buffer
  399. (setq ,cache nil)
  400. nil)
  401. ((member cur-msg ,cache)
  402. (let ((bpoint (progn (beginning-of-line)(point)))
  403. (epoint (progn (forward-line 1)(point))))
  404. (if (<= limit (point)) (setq ,cache nil))
  405. (set-match-data (list bpoint epoint bpoint epoint))
  406. t))
  407. (t
  408. ;; move forward one line at a time, checking each message
  409. (while (and (= 0 (forward-line 1))
  410. (> limit (point))
  411. (not (member (mh-get-msg-num nil) ,cache))))
  412. ;; Examine how we must have exited the loop...
  413. (let ((cur-msg (mh-get-msg-num nil)))
  414. (cond ((or (<= limit (point))
  415. (not (member cur-msg ,cache)))
  416. (setq ,cache nil)
  417. nil)
  418. ((member cur-msg ,cache)
  419. (let ((bpoint (progn (beginning-of-line) (point)))
  420. (epoint (progn (forward-line 1) (point))))
  421. (if (<= limit (point)) (setq ,cache nil))
  422. (set-match-data
  423. (list bpoint epoint bpoint epoint))
  424. t))))))))
  425. (setq mh-folder-font-lock-keywords
  426. (append mh-folder-font-lock-keywords
  427. (list (list ',func (list 1 '',face 'prepend t))))))))
  428. (mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
  429. (mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick)
  430. ;;; MH-Folder Mode
  431. (defmacro mh-remove-xemacs-horizontal-scrollbar ()
  432. "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
  433. (when (featurep 'xemacs)
  434. `(if (and (featurep 'scrollbar)
  435. (fboundp 'set-specifier))
  436. (set-specifier horizontal-scrollbar-visible-p nil
  437. (cons (current-buffer) nil)))))
  438. ;; Register mh-folder-mode as supporting which-function-mode...
  439. (mh-require 'which-func nil t)
  440. (when (boundp 'which-func-modes)
  441. (add-to-list 'which-func-modes 'mh-folder-mode))
  442. ;; Shush compiler.
  443. (defvar desktop-save-buffer)
  444. (defvar font-lock-auto-fontify)
  445. (mh-do-in-xemacs
  446. (defvar font-lock-defaults))
  447. ;; Ensure new buffers won't get this mode if default major-mode is nil.
  448. (put 'mh-folder-mode 'mode-class 'special)
  449. ;; Autoload cookie needed by desktop.el
  450. ;;;###autoload
  451. (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
  452. "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
  453. You can show the message the cursor is pointing to, and step through
  454. the messages. Messages can be marked for deletion or refiling into
  455. another folder; these commands are executed all at once with a
  456. separate command.
  457. Options that control this mode can be changed with
  458. \\[customize-group]; specify the \"mh\" group. In particular, please
  459. see the `mh-scan-format-file' option if you wish to modify scan's
  460. format.
  461. When a folder is visited, the hook `mh-folder-mode-hook' is run.
  462. Ranges
  463. ======
  464. Many commands that operate on individual messages, such as
  465. `mh-forward' or `mh-refile-msg' take a RANGE argument. This argument
  466. can be used in several ways.
  467. If you provide the prefix argument (\\[universal-argument]) to
  468. these commands, then you will be prompted for the message range.
  469. This can be any valid MH range which can include messages,
  470. sequences, and the abbreviations (described in the mh(1) man
  471. page):
  472. <num1>-<num2>
  473. Indicates all messages in the range <num1> to <num2>, inclusive.
  474. The range must be nonempty.
  475. <num>:N
  476. <num>:+N
  477. <num>:-N
  478. Up to N messages beginning with (or ending with) message num. Num
  479. may be any of the predefined symbols: first, prev, cur, next or
  480. last.
  481. first:N
  482. prev:N
  483. next:N
  484. last:N
  485. The first, previous, next or last messages, if they exist.
  486. all
  487. All of the messages.
  488. For example, a range that shows all of these things is `1 2 3
  489. 5-10 last:5 unseen'.
  490. If the option `transient-mark-mode' is set to t and you set a
  491. region in the MH-Folder buffer, then the MH-E command will
  492. perform the operation on all messages in that region.
  493. \\{mh-folder-mode-map}"
  494. (mh-do-in-gnu-emacs
  495. (unless mh-folder-tool-bar-map
  496. (mh-tool-bar-folder-buttons-init))
  497. (if (boundp 'tool-bar-map)
  498. (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)))
  499. (mh-do-in-xemacs
  500. (mh-tool-bar-init :folder))
  501. (make-local-variable 'font-lock-defaults)
  502. (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
  503. (make-local-variable 'desktop-save-buffer)
  504. (setq desktop-save-buffer t)
  505. (mh-make-local-vars
  506. 'mh-colors-available-flag (mh-colors-available-p)
  507. ; Do we have colors available
  508. 'mh-current-folder (buffer-name) ; Name of folder, a string
  509. 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
  510. 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
  511. (file-name-as-directory (mh-expand-file-name (buffer-name)))
  512. 'mh-display-buttons-for-inline-parts-flag
  513. mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
  514. ; be toggled.
  515. 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
  516. 'overlay-arrow-position nil ; Allow for simultaneous display in
  517. 'overlay-arrow-string ">" ; different MH-E buffers.
  518. 'mh-showing-mode nil ; Show message also?
  519. 'mh-delete-list nil ; List of msgs nums to delete
  520. 'mh-refile-list nil ; List of folder names in mh-seq-list
  521. 'mh-seq-list nil ; Alist of (seq . msgs) nums
  522. 'mh-seen-list nil ; List of displayed messages
  523. 'mh-next-direction 'forward ; Direction to move to next message
  524. 'mh-view-ops () ; Stack that keeps track of the order
  525. ; in which narrowing/threading has been
  526. ; carried out.
  527. 'mh-folder-view-stack () ; Stack of previous views of the
  528. ; folder.
  529. 'mh-index-data nil ; If the folder was created by a call
  530. ; to mh-search, this contains info
  531. ; about the search results.
  532. 'mh-index-previous-search nil ; folder, indexer, search-regexp
  533. 'mh-index-msg-checksum-map nil ; msg -> checksum map
  534. 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
  535. 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
  536. 'mh-first-msg-num nil ; Number of first msg in buffer
  537. 'mh-last-msg-num nil ; Number of last msg in buffer
  538. 'mh-msg-count nil ; Number of msgs in buffer
  539. 'mh-mode-line-annotation nil ; Indicates message range
  540. 'mh-sequence-notation-history (make-hash-table)
  541. ; Remember what is overwritten by
  542. ; mh-note-seq.
  543. 'imenu-create-index-function 'mh-index-create-imenu-index
  544. ; Setup imenu support
  545. 'mh-previous-window-config nil) ; Previous window configuration
  546. (mh-remove-xemacs-horizontal-scrollbar)
  547. (setq truncate-lines t)
  548. (auto-save-mode -1)
  549. (setq buffer-offer-save t)
  550. (mh-make-local-hook (mh-write-file-functions))
  551. (add-hook (mh-write-file-functions) 'mh-execute-commands nil t)
  552. (make-local-variable 'revert-buffer-function)
  553. (make-local-variable 'hl-line-mode) ; avoid pollution
  554. (mh-funcall-if-exists hl-line-mode 1)
  555. (setq revert-buffer-function 'mh-undo-folder)
  556. (add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
  557. (easy-menu-add mh-folder-sequence-menu)
  558. (easy-menu-add mh-folder-message-menu)
  559. (easy-menu-add mh-folder-folder-menu)
  560. (mh-inc-spool-make)
  561. (mh-set-help mh-folder-mode-help-messages)
  562. (if (and (featurep 'xemacs)
  563. font-lock-auto-fontify)
  564. (turn-on-font-lock))) ; Force font-lock in XEmacs.
  565. ;;; MH-Folder Commands
  566. ;; Alphabetical.
  567. ;; See also mh-comp.el, mh-junk.el, mh-mime.el, mh-print.el,
  568. ;; mh-search.el, and mh-seq.el.
  569. ;;;###mh-autoload
  570. (defun mh-delete-msg (range)
  571. "Delete RANGE\\<mh-folder-mode-map>.
  572. To mark a message for deletion, use this command. A \"D\" is
  573. placed by the message in the scan window, and the next undeleted
  574. message is displayed. If the previous command had been
  575. \\[mh-previous-undeleted-msg], then the next message displayed is
  576. the first undeleted message previous to the message just deleted.
  577. Use \\[mh-next-undeleted-msg] to force subsequent
  578. \\[mh-delete-msg] commands to move forward to the next undeleted
  579. message after deleting the message under the cursor.
  580. The hook `mh-delete-msg-hook' is called after you mark a message
  581. for deletion. For example, a past maintainer of MH-E used this
  582. once when he kept statistics on his mail usage.
  583. Check the documentation of `mh-interactive-range' to see how
  584. RANGE is read in interactive use."
  585. (interactive (list (mh-interactive-range "Delete")))
  586. (mh-delete-msg-no-motion range)
  587. (if (looking-at mh-scan-deleted-msg-regexp)
  588. (mh-next-msg)))
  589. ;;;###mh-autoload
  590. (defun mh-delete-msg-no-motion (range)
  591. "Delete RANGE, don't move to next message.
  592. This command marks the RANGE for deletion but leaves the cursor
  593. at the current message in case you wish to perform other
  594. operations on the message.
  595. Check the documentation of `mh-interactive-range' to see how
  596. RANGE is read in interactive use."
  597. (interactive (list (mh-interactive-range "Delete")))
  598. (mh-iterate-on-range () range
  599. (mh-delete-a-msg nil)))
  600. ;;;###mh-autoload
  601. (defun mh-execute-commands ()
  602. "Process outstanding delete and refile requests\\<mh-folder-mode-map>.
  603. If you've marked messages to be deleted or refiled and you want
  604. to go ahead and delete or refile the messages, use this command.
  605. Many MH-E commands that may affect the numbering of the
  606. messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder])
  607. will ask if you want to process refiles or deletes first and then
  608. either run this command for you or undo the pending refiles and
  609. deletes.
  610. This function runs `mh-before-commands-processed-hook' before the
  611. commands are processed and `mh-after-commands-processed-hook'
  612. after the commands are processed."
  613. (interactive)
  614. (if mh-folder-view-stack (mh-widen t))
  615. (mh-process-commands mh-current-folder)
  616. (mh-set-scan-mode)
  617. (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
  618. (mh-make-folder-mode-line)
  619. t) ; return t for write-file-functions
  620. ;;;###mh-autoload
  621. (defun mh-first-msg ()
  622. "Display first message."
  623. (interactive)
  624. (goto-char (point-min))
  625. (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
  626. (forward-line 1)))
  627. ;;;###mh-autoload
  628. (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
  629. "Go to a message\\<mh-folder-mode-map>.
  630. You can enter the message NUMBER either before or after typing
  631. \\[mh-goto-msg]. In the latter case, Emacs prompts you.
  632. In a program, optional non-nil second argument NO-ERROR-IF-NO-MESSAGE
  633. means return nil instead of signaling an error if message does not
  634. exist\; in this case, the cursor is positioned near where the message
  635. would have been. Non-nil third argument DONT-SHOW means not to show
  636. the message."
  637. (interactive "NGo to message: ")
  638. (setq number (prefix-numeric-value number))
  639. (let ((point (point))
  640. (return-value t))
  641. (goto-char (point-min))
  642. (unless (re-search-forward (format (mh-scan-msg-search-regexp) number)
  643. nil t)
  644. (goto-char point)
  645. (unless no-error-if-no-message
  646. (error "No message %d" number))
  647. (setq return-value nil))
  648. (beginning-of-line)
  649. (or dont-show (not return-value) (mh-maybe-show number))
  650. return-value))
  651. ;;;###mh-autoload
  652. (defun mh-inc-folder (&optional file folder)
  653. "Incorporate new mail into a folder.
  654. You can incorporate mail from any file into the current folder by
  655. specifying a prefix argument; you'll be prompted for the name of
  656. the FILE to use as well as the destination FOLDER
  657. The hook `mh-inc-folder-hook' is run after incorporating new
  658. mail.
  659. Do not call this function from outside MH-E; use \\[mh-rmail]
  660. instead."
  661. (interactive (list (if current-prefix-arg
  662. (expand-file-name
  663. (read-file-name "inc mail from file: "
  664. mh-user-path)))
  665. (if current-prefix-arg
  666. (mh-prompt-for-folder "inc mail into" mh-inbox t))))
  667. (if (not folder)
  668. (setq folder mh-inbox))
  669. (let ((threading-needed-flag nil))
  670. (let ((config (current-window-configuration)))
  671. (when (and mh-show-buffer (get-buffer mh-show-buffer))
  672. (delete-windows-on mh-show-buffer))
  673. (cond ((not (get-buffer folder))
  674. (mh-make-folder folder)
  675. (setq threading-needed-flag mh-show-threads-flag)
  676. (setq mh-previous-window-config config))
  677. ((not (eq (current-buffer) (get-buffer folder)))
  678. (switch-to-buffer folder)
  679. (setq mh-previous-window-config config))))
  680. (mh-get-new-mail file)
  681. (when (and threading-needed-flag
  682. (save-excursion
  683. (goto-char (point-min))
  684. (or (null mh-large-folder)
  685. (not (equal (forward-line (1+ mh-large-folder)) 0))
  686. (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
  687. nil))))
  688. (mh-toggle-threads))
  689. (beginning-of-line)
  690. (if (and mh-showing-mode (looking-at mh-scan-valid-regexp)) (mh-show))
  691. (run-hooks 'mh-inc-folder-hook)))
  692. ;;;###mh-autoload
  693. (defun mh-last-msg ()
  694. "Display last message."
  695. (interactive)
  696. (goto-char (point-max))
  697. (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
  698. (forward-line -1))
  699. (mh-recenter nil))
  700. ;;;###mh-autoload
  701. (defun mh-modify (&optional message)
  702. "Edit message.
  703. There are times when you need to edit a message. For example, you
  704. may need to fix a broken Content-Type header field. You can do
  705. this with this command. It displays the raw message in an
  706. editable buffer. When you are done editing, save and kill the
  707. buffer as you would any other.
  708. From a program, edit MESSAGE; nil means edit current message."
  709. (interactive)
  710. (let* ((message (or message (mh-get-msg-num t)))
  711. (msg-filename (mh-msg-filename message))
  712. edit-buffer)
  713. (when (not (file-exists-p msg-filename))
  714. (error "Message %d does not exist" message))
  715. ;; Invalidate the show buffer if it is showing the same message that is
  716. ;; to be edited.
  717. (when (and (buffer-live-p (get-buffer mh-show-buffer))
  718. (equal (with-current-buffer mh-show-buffer
  719. buffer-file-name)
  720. msg-filename))
  721. (mh-invalidate-show-buffer))
  722. ;; Edit message
  723. (find-file msg-filename)
  724. (setq edit-buffer (current-buffer))
  725. ;; Set buffer properties
  726. (mh-letter-mode)
  727. (use-local-map text-mode-map)
  728. ;; Just show the edit buffer...
  729. (delete-other-windows)
  730. (switch-to-buffer edit-buffer)))
  731. ;;;###mh-autoload
  732. (defun mh-next-button (&optional backward-flag)
  733. "Go to the next button.
  734. If the end of the buffer is reached then the search wraps over to
  735. the start of the buffer.
  736. If an optional prefix argument BACKWARD-FLAG is given, the cursor
  737. will move to the previous button."
  738. (interactive (list current-prefix-arg))
  739. (unless mh-showing-mode
  740. (mh-show))
  741. (mh-in-show-buffer (mh-show-buffer)
  742. (mh-goto-next-button backward-flag)))
  743. ;;;###mh-autoload
  744. (defun mh-next-undeleted-msg (&optional count wait-after-complaining-flag)
  745. "Display next message.
  746. This command can be given a prefix argument COUNT to specify how
  747. many unread messages to skip.
  748. In a program, pause for a second after printing message if we are
  749. at the last undeleted message and optional argument
  750. WAIT-AFTER-COMPLAINING-FLAG is non-nil."
  751. (interactive "p")
  752. (setq mh-next-direction 'forward)
  753. (forward-line 1)
  754. (cond ((re-search-forward mh-scan-good-msg-regexp nil t count)
  755. (beginning-of-line)
  756. (mh-maybe-show))
  757. (t (forward-line -1)
  758. (message "No more undeleted messages")
  759. (if wait-after-complaining-flag (sit-for 1)))))
  760. ;;;###mh-autoload
  761. (defun mh-next-unread-msg (&optional count)
  762. "Display next unread message.
  763. This command can be given a prefix argument COUNT to specify how
  764. many unread messages to skip."
  765. (interactive "p")
  766. (unless (> count 0)
  767. (error "The function `mh-next-unread-msg' expects positive argument"))
  768. (setq count (1- count))
  769. (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
  770. (cur-msg (mh-get-msg-num nil)))
  771. (cond ((and (not cur-msg) (not (bobp))
  772. ;; If we are at the end of the buffer back up one line and go
  773. ;; to unread message after that.
  774. (progn
  775. (forward-line -1)
  776. (setq cur-msg (mh-get-msg-num nil)))
  777. nil))
  778. ((or (null unread-sequence) (not cur-msg))
  779. ;; No unread message or there aren't any messages in buffer...
  780. (message "No more unread messages"))
  781. ((progn
  782. ;; Skip messages
  783. (while (and unread-sequence (>= cur-msg (car unread-sequence)))
  784. (setq unread-sequence (cdr unread-sequence)))
  785. (while (> count 0)
  786. (setq unread-sequence (cdr unread-sequence))
  787. (setq count (1- count)))
  788. (not (car unread-sequence)))
  789. (message "No more unread messages"))
  790. (t (loop for msg in unread-sequence
  791. when (mh-goto-msg msg t) return nil
  792. finally (message "No more unread messages"))))))
  793. ;;;###mh-autoload
  794. (defun mh-page-msg (&optional lines)
  795. "Display next page in message.
  796. You can give this command a prefix argument that specifies the
  797. number of LINES to scroll. This command will also show the next
  798. undeleted message if it is used at the bottom of a message."
  799. (interactive "P")
  800. (if mh-showing-mode
  801. (if mh-page-to-next-msg-flag
  802. (if (equal mh-next-direction 'backward)
  803. (mh-previous-undeleted-msg)
  804. (mh-next-undeleted-msg))
  805. (if (mh-in-show-buffer (mh-show-buffer)
  806. (pos-visible-in-window-p (point-max)))
  807. (progn
  808. (message
  809. "End of message (Type %s to read %s undeleted message)"
  810. (single-key-description last-input-event)
  811. (if (equal mh-next-direction 'backward)
  812. "previous"
  813. "next"))
  814. (setq mh-page-to-next-msg-flag t))
  815. (scroll-other-window lines)))
  816. (mh-show)))
  817. ;;;###mh-autoload
  818. (defun mh-prev-button ()
  819. "Go to the previous button.
  820. If the beginning of the buffer is reached then the search wraps
  821. over to the end of the buffer."
  822. (interactive)
  823. (mh-next-button t))
  824. ;;;###mh-autoload
  825. (defun mh-previous-page (&optional lines)
  826. "Display next page in message.
  827. You can give this command a prefix argument that specifies the
  828. number of LINES to scroll."
  829. (interactive "P")
  830. (mh-in-show-buffer (mh-show-buffer)
  831. (scroll-down lines)))
  832. ;;;###mh-autoload
  833. (defun mh-previous-undeleted-msg (&optional count wait-after-complaining-flag)
  834. "Display previous message.
  835. This command can be given a prefix argument COUNT to specify how
  836. many unread messages to skip.
  837. In a program, pause for a second after printing message if we are
  838. at the last undeleted message and optional argument
  839. WAIT-AFTER-COMPLAINING-FLAG is non-nil."
  840. (interactive "p")
  841. (setq mh-next-direction 'backward)
  842. (beginning-of-line)
  843. (cond ((re-search-backward mh-scan-good-msg-regexp nil t count)
  844. (mh-maybe-show))
  845. (t (message "No previous undeleted message")
  846. (if wait-after-complaining-flag (sit-for 1)))))
  847. ;;;###mh-autoload
  848. (defun mh-previous-unread-msg (&optional count)
  849. "Display previous unread message.
  850. This command can be given a prefix argument COUNT to specify how
  851. many unread messages to skip."
  852. (interactive "p")
  853. (unless (> count 0)
  854. (error "The function `mh-previous-unread-msg' expects positive argument"))
  855. (setq count (1- count))
  856. (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
  857. (cur-msg (mh-get-msg-num nil)))
  858. (cond ((and (not cur-msg) (not (bobp))
  859. ;; If we are at the end of the buffer back up one line and go
  860. ;; to unread message after that.
  861. (progn
  862. (forward-line -1)
  863. (setq cur-msg (mh-get-msg-num nil)))
  864. nil))
  865. ((or (null unread-sequence) (not cur-msg))
  866. ;; No unread message or there aren't any messages in buffer...
  867. (message "No more unread messages"))
  868. ((progn
  869. ;; Skip count messages...
  870. (while (and unread-sequence (>= (car unread-sequence) cur-msg))
  871. (setq unread-sequence (cdr unread-sequence)))
  872. (while (> count 0)
  873. (setq unread-sequence (cdr unread-sequence))
  874. (setq count (1- count)))
  875. (not (car unread-sequence)))
  876. (message "No more unread messages"))
  877. (t (loop for msg in unread-sequence
  878. when (mh-goto-msg msg t) return nil
  879. finally (message "No more unread messages"))))))
  880. ;;;###mh-autoload
  881. (defun mh-quit ()
  882. "Quit the current MH-E folder.
  883. When you want to quit using MH-E and go back to editing, you can use
  884. this command. This buries the buffers of the current MH-E folder and
  885. restores the buffers that were present when you first ran
  886. \\[mh-rmail]. It also removes any MH-E working buffers whose name
  887. begins with \" *mh-\" or \"*MH-E \". You can later restore your MH-E
  888. session by selecting the \"+inbox\" buffer or by running \\[mh-rmail]
  889. again.
  890. The two hooks `mh-before-quit-hook' and `mh-quit-hook' are called by
  891. this function. The former one is called before the quit occurs, so you
  892. might use it to perform any MH-E operations; you could perform some
  893. query and abort the quit or call `mh-execute-commands', for example.
  894. The latter is not run in an MH-E context, so you might use it to
  895. modify the window setup."
  896. (interactive)
  897. (run-hooks 'mh-before-quit-hook)
  898. (let ((show-buffer (get-buffer mh-show-buffer)))
  899. (when show-buffer
  900. (kill-buffer show-buffer)))
  901. (mh-update-sequences)
  902. (mh-destroy-postponed-handles)
  903. (bury-buffer (current-buffer))
  904. ;; Delete all MH-E temporary and working buffers.
  905. (dolist (buffer (buffer-list))
  906. (when (or (string-match "^ \\*mh-" (buffer-name buffer))
  907. (string-match "^\\*MH-E " (buffer-name buffer)))
  908. (kill-buffer buffer)))
  909. (if mh-previous-window-config
  910. (set-window-configuration mh-previous-window-config))
  911. (run-hooks 'mh-quit-hook))
  912. ;;;###mh-autoload
  913. (defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
  914. "Refile (output) RANGE into FOLDER.
  915. You are prompted for the folder name. Note that this command can also
  916. be used to create folders. If you specify a folder that does not
  917. exist, you will be prompted to create it.
  918. The hook `mh-refile-msg-hook' is called after a message is marked to
  919. be refiled.
  920. Check the documentation of `mh-interactive-range' to see how RANGE is
  921. read in interactive use.
  922. In a program, the variables `mh-last-destination' and
  923. `mh-last-destination-folder' are not updated if
  924. DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil."
  925. (interactive (list (mh-interactive-range "Refile")
  926. (intern (mh-prompt-for-refile-folder))))
  927. (unless dont-update-last-destination-flag
  928. (setq mh-last-destination (cons 'refile folder)
  929. mh-last-destination-folder mh-last-destination))
  930. (mh-iterate-on-range () range
  931. (mh-refile-a-msg nil folder))
  932. (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
  933. ;;;###mh-autoload
  934. (defun mh-refile-or-write-again (range &optional interactive-flag)
  935. "Repeat last output command.
  936. If you are refiling several messages into the same folder, you
  937. can use this command to repeat the last
  938. refile (\\[mh-refile-msg]) or write (\\[mh-write-msg-to-file]).
  939. You can use a range.
  940. Check the documentation of `mh-interactive-range' to see how RANGE is
  941. read in interactive use.
  942. In a program, a non-nil INTERACTIVE-FLAG means that the function was
  943. called interactively."
  944. (interactive (list (mh-interactive-range "Redo") t))
  945. (if (null mh-last-destination)
  946. (error "No previous refile or write"))
  947. (cond ((eq (car mh-last-destination) 'refile)
  948. (mh-refile-msg range (cdr mh-last-destination))
  949. (message "Destination folder: %s" (cdr mh-last-destination)))
  950. (t
  951. (mh-iterate-on-range msg range
  952. (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)))
  953. (mh-next-msg interactive-flag))))
  954. ;;;###mh-autoload
  955. (defun mh-rescan-folder (&optional range dont-exec-pending)
  956. "Rescan folder\\<mh-folder-mode-map>.
  957. This command is useful to grab all messages in your \"+inbox\" after
  958. processing your new mail for the first time. If you don't want to
  959. rescan the entire folder, this command will accept a RANGE. Check the
  960. documentation of `mh-interactive-range' to see how RANGE is read in
  961. interactive use.
  962. This command will ask if you want to process refiles or deletes first
  963. and then either run \\[mh-execute-commands] for you or undo the
  964. pending refiles and deletes.
  965. In a program, the processing of outstanding commands is not performed
  966. if DONT-EXEC-PENDING is non-nil."
  967. (interactive (list (if current-prefix-arg
  968. (mh-read-range "Rescan" mh-current-folder t nil t
  969. mh-interpret-number-as-range-flag)
  970. nil)))
  971. (setq mh-next-direction 'forward)
  972. (let ((threaded-flag (memq 'unthread mh-view-ops))
  973. (msg-num (mh-get-msg-num nil)))
  974. (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
  975. ;; If there isn't a cur sequence, mh-scan-folder goes to the first message.
  976. ;; Try to stay where we were.
  977. (if (null (car (mh-seq-to-msgs 'cur)))
  978. (mh-goto-msg msg-num t t))
  979. (cond (threaded-flag (mh-toggle-threads))
  980. (mh-index-data (mh-index-insert-folder-headers)))))
  981. (defun mh-show-mouse (event)
  982. "Move point to mouse EVENT and show message."
  983. (interactive "e")
  984. (mouse-set-point event)
  985. (mh-show))
  986. ;;;###mh-autoload
  987. (defun mh-toggle-showing ()
  988. "Toggle between MH-Folder and MH-Folder Show modes.
  989. This command switches between MH-Folder mode and MH-Folder Show
  990. mode. MH-Folder mode turns off the associated show buffer so that
  991. you can perform operations on the messages quickly without
  992. reading them. This is an excellent way to prune out your junk
  993. mail or to refile a group of messages to another folder for later
  994. examination."
  995. (interactive)
  996. (if mh-showing-mode
  997. (mh-set-scan-mode)
  998. (mh-show)))
  999. ;;;###mh-autoload
  1000. (defun mh-undo (range)
  1001. "Undo pending deletes or refiles in RANGE.
  1002. If you've deleted a message or refiled it, but changed your mind,
  1003. you can cancel the action before you've executed it. Use this
  1004. command to undo a refile on or deletion of a single message. You
  1005. can also undo refiles and deletes for messages that are found in
  1006. a given RANGE.
  1007. Check the documentation of `mh-interactive-range' to see how
  1008. RANGE is read in interactive use."
  1009. (interactive (list (mh-interactive-range "Undo")))
  1010. (cond ((numberp range)
  1011. (let ((original-position (point)))
  1012. (beginning-of-line)
  1013. (while (not (or (looking-at mh-scan-deleted-msg-regexp)
  1014. (looking-at mh-scan-refiled-msg-regexp)
  1015. (and (eq mh-next-direction 'forward) (bobp))
  1016. (and (eq mh-next-direction 'backward)
  1017. (save-excursion (forward-line) (eobp)))))
  1018. (forward-line (if (eq mh-next-direction 'forward) -1 1)))
  1019. (if (or (looking-at mh-scan-deleted-msg-regexp)
  1020. (looking-at mh-scan-refiled-msg-regexp))
  1021. (progn
  1022. (mh-undo-msg (mh-get-msg-num t))
  1023. (mh-maybe-show))
  1024. (goto-char original-position)
  1025. (error "Nothing to undo"))))
  1026. (t (mh-iterate-on-range () range
  1027. (mh-undo-msg nil))))
  1028. (if (not (mh-outstanding-commands-p))
  1029. (mh-set-folder-modified-p nil)))
  1030. ;;;###mh-autoload
  1031. (defun mh-visit-folder (folder &optional range index-data)
  1032. "Visit FOLDER.
  1033. When you want to read the messages that you have refiled into folders,
  1034. use this command to visit the folder. You are prompted for the folder
  1035. name.
  1036. The folder buffer will show just unseen messages if there are any;
  1037. otherwise, it will show all the messages in the buffer as long there
  1038. are fewer than `mh-large-folder' messages. If there are more, then you
  1039. are prompted for a range of messages to scan.
  1040. You can provide a prefix argument in order to specify a RANGE of
  1041. messages to show when you visit the folder. In this case, regions are
  1042. not used to specify the range and `mh-large-folder' is ignored. Check
  1043. the documentation of `mh-interactive-range' to see how RANGE is read
  1044. in interactive use.
  1045. Note that this command can also be used to create folders. If you
  1046. specify a folder that does not exist, you will be prompted to create
  1047. it.
  1048. Do not call this function from outside MH-E; use \\[mh-rmail] instead.
  1049. If, in a program, RANGE is nil (the default), then all messages in
  1050. FOLDER are displayed. If an index buffer is being created then
  1051. INDEX-DATA is used to initialize the index buffer specific data
  1052. structures."
  1053. (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
  1054. (list folder-name
  1055. (mh-read-range "Scan" folder-name t nil
  1056. current-prefix-arg
  1057. mh-interpret-number-as-range-flag))))
  1058. (let ((config (current-window-configuration))
  1059. (current-buffer (current-buffer))
  1060. (threaded-view-flag mh-show-threads-flag))
  1061. (delete-other-windows)
  1062. (when (get-buffer folder)
  1063. (with-current-buffer folder
  1064. (setq threaded-view-flag (memq 'unthread mh-view-ops))))
  1065. (when index-data
  1066. (mh-make-folder folder)
  1067. (setq mh-index-data (car index-data)
  1068. mh-index-msg-checksum-map (make-hash-table :test #'equal)
  1069. mh-index-checksum-origin-map (make-hash-table :test #'equal))
  1070. (mh-index-update-maps folder (cadr index-data))
  1071. (mh-index-create-sequences))
  1072. (mh-scan-folder folder (or range "all"))
  1073. (cond ((and threaded-view-flag
  1074. (save-excursion
  1075. (goto-char (point-min))
  1076. (or (null mh-large-folder)
  1077. (not (equal (forward-line (1+ mh-large-folder)) 0))
  1078. (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
  1079. nil))))
  1080. (mh-toggle-threads))
  1081. (mh-index-data
  1082. (mh-index-insert-folder-headers)))
  1083. (unless (eq current-buffer (current-buffer))
  1084. (setq mh-previous-window-config config)))
  1085. nil)
  1086. ;;;###mh-autoload
  1087. (defun mh-write-msg-to-file (message file no-header)
  1088. "Append MESSAGE to end of FILE\\<mh-folder-mode-map>.
  1089. You are prompted for the filename. If the file already exists,
  1090. the message is appended to it. You can also write the message to
  1091. the file without the header by specifying a prefix argument
  1092. NO-HEADER. Subsequent writes to the same file can be made with
  1093. the command \\[mh-refile-or-write-again]."
  1094. (interactive
  1095. (list (mh-get-msg-num t)
  1096. (let ((default-dir (if (eq 'write (car mh-last-destination-write))
  1097. (file-name-directory
  1098. (car (cdr mh-last-destination-write)))
  1099. default-directory)))
  1100. (read-file-name (format "Save message%s in file: "
  1101. (if current-prefix-arg " body" ""))
  1102. default-dir
  1103. (if (eq 'write (car mh-last-destination-write))
  1104. (car (cdr mh-last-destination-write))
  1105. (expand-file-name "mail.out" default-dir))))
  1106. current-prefix-arg))
  1107. (let ((msg-file-to-output (mh-msg-filename message))
  1108. (output-file (mh-expand-file-name file)))
  1109. (setq mh-last-destination (list 'write file (if no-header 'no-header))
  1110. mh-last-destination-write mh-last-destination)
  1111. (with-current-buffer (get-buffer-create mh-temp-buffer)
  1112. (erase-buffer)
  1113. (insert-file-contents msg-file-to-output)
  1114. (goto-char (point-min))
  1115. (if no-header (search-forward "\n\n"))
  1116. (append-to-file (point) (point-max) output-file))))
  1117. ;;;###mh-autoload
  1118. (defun mh-update-sequences ()
  1119. "Flush MH-E's state out to MH.
  1120. This function updates the sequence specified by your
  1121. \"Unseen-Sequence:\" profile component, \"cur\", and the sequence
  1122. listed by the `mh-tick-seq' option which is \"tick\" by default.
  1123. The message at the cursor is used for \"cur\"."
  1124. (interactive)
  1125. ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
  1126. ;; which updates MH-E's state from MH.
  1127. (let ((folder-set (mh-update-unseen))
  1128. (new-cur (mh-get-msg-num nil)))
  1129. (if new-cur
  1130. (let ((seq-entry (mh-find-seq 'cur)))
  1131. (mh-remove-cur-notation)
  1132. (setcdr seq-entry
  1133. (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
  1134. (mh-define-sequence 'cur (list new-cur))
  1135. (beginning-of-line)
  1136. (if (looking-at mh-scan-good-msg-regexp)
  1137. (mh-notate-cur)))
  1138. (or folder-set
  1139. (save-excursion
  1140. ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
  1141. ;; So I added this sanity check.
  1142. (if (stringp mh-current-folder)
  1143. (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
  1144. (mh-exec-cmd-quiet t "folder" "-fast")))))))
  1145. ;;; Support Routines
  1146. (defun mh-get-new-mail (maildrop-name)
  1147. "Read new mail from MAILDROP-NAME into the current buffer.
  1148. Return in the current buffer."
  1149. (let ((point-before-inc (point))
  1150. (folder mh-current-folder)
  1151. (new-mail-flag nil))
  1152. (with-mh-folder-updating (t)
  1153. (if maildrop-name
  1154. (message "inc %s -file %s..." folder maildrop-name)
  1155. (message "inc %s..." folder))
  1156. (setq mh-next-direction 'forward)
  1157. (goto-char (point-max))
  1158. (mh-remove-cur-notation)
  1159. (let ((start-of-inc (point)))
  1160. (if maildrop-name
  1161. ;; I think MH 5 used "-ms-file" instead of "-file",
  1162. ;; which would make inc'ing from maildrops fail.
  1163. (mh-exec-cmd-output mh-inc-prog nil folder
  1164. (mh-scan-format)
  1165. "-file" (expand-file-name maildrop-name)
  1166. "-width" (window-width)
  1167. "-truncate")
  1168. (mh-exec-cmd-output mh-inc-prog nil
  1169. (mh-scan-format)
  1170. "-width" (window-width)))
  1171. (if maildrop-name
  1172. (message "inc %s -file %s...done" folder maildrop-name)
  1173. (message "inc %s...done" folder))
  1174. (goto-char start-of-inc)
  1175. (cond ((save-excursion
  1176. (re-search-forward "^inc: no mail" nil t))
  1177. (message "No new mail%s%s" (if maildrop-name " in " "")
  1178. (if maildrop-name maildrop-name "")))
  1179. ((and (when mh-folder-view-stack
  1180. (let ((saved-text (buffer-substring-no-properties
  1181. start-of-inc (point-max))))
  1182. (delete-region start-of-inc (point-max))
  1183. (unwind-protect (mh-widen t)
  1184. (mh-remove-cur-notation)
  1185. (goto-char (point-max))
  1186. (setq start-of-inc (point))
  1187. (insert saved-text)
  1188. (goto-char start-of-inc))))
  1189. nil))
  1190. ((re-search-forward "^inc:" nil t) ; Error messages
  1191. (error "Error incorporating mail"))
  1192. ((and
  1193. (equal mh-scan-format-file t)
  1194. mh-adaptive-cmd-note-flag
  1195. ;; Have we reached an edge condition?
  1196. (save-excursion
  1197. (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
  1198. (setq start-of-inc (mh-generate-new-cmd-note folder))
  1199. nil))
  1200. (t
  1201. (setq new-mail-flag t)))
  1202. (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
  1203. (let* ((sequences (mh-read-folder-sequences folder t))
  1204. (new-cur (assoc 'cur sequences))
  1205. (new-unseen (assoc mh-unseen-seq sequences)))
  1206. (unless (assoc 'cur mh-seq-list)
  1207. (push (list 'cur) mh-seq-list))
  1208. (unless (assoc mh-unseen-seq mh-seq-list)
  1209. (push (list mh-unseen-seq) mh-seq-list))
  1210. (setcdr (assoc 'cur mh-seq-list) (cdr new-cur))
  1211. (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen)))
  1212. (when (equal (point-max) start-of-inc)
  1213. (mh-notate-cur))
  1214. (if new-mail-flag
  1215. (progn
  1216. (mh-make-folder-mode-line)
  1217. (when (mh-speed-flists-active-p)
  1218. (mh-speed-flists t mh-current-folder))
  1219. (when (memq 'unthread mh-view-ops)
  1220. (mh-thread-inc folder start-of-inc))
  1221. (mh-goto-cur-msg))
  1222. (goto-char point-before-inc))
  1223. (mh-notate-user-sequences (cons start-of-inc (point-max)))))))
  1224. (defun mh-generate-new-cmd-note (folder)
  1225. "Fix the `mh-cmd-note' value for this FOLDER.
  1226. After doing an `mh-get-new-mail' operation in this FOLDER, at least
  1227. one line that looks like a truncated message number was found.
  1228. Remove the text added by the last `mh-inc' command. It should be the
  1229. messages cur-last. Call `mh-set-cmd-note', adjusting the notation
  1230. column with the width of the largest message number in FOLDER.
  1231. Reformat the message number width on each line in the buffer and trim
  1232. the line length to fit in the window.
  1233. Rescan the FOLDER in the range cur-last in order to display the
  1234. messages that were removed earlier. They should all fit in the scan
  1235. line now with no message truncation."
  1236. (save-excursion
  1237. (let ((maxcol (1- (window-width)))
  1238. (old-cmd-note mh-cmd-note)
  1239. mh-cmd-note-fmt
  1240. msgnum)
  1241. ;; Nuke all of the lines just added by the last inc
  1242. (delete-char (- (point-max) (point)))
  1243. ;; Update the current buffer to reflect the new mh-cmd-note
  1244. ;; value needed to display messages.
  1245. (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width folder)))
  1246. (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
  1247. ;; Cleanup the messages that are in the buffer right now
  1248. (goto-char (point-min))
  1249. (cond ((memq 'unthread mh-view-ops)
  1250. (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
  1251. (t (while (re-search-forward (mh-scan-msg-number-regexp) nil 0 1)
  1252. ;; reformat the number to fix in mh-cmd-note columns
  1253. (setq msgnum (string-to-number
  1254. (buffer-substring
  1255. (match-beginning 1) (match-end 1))))
  1256. (replace-match (format mh-cmd-note-fmt msgnum))
  1257. ;; trim the line to fix in the window
  1258. (end-of-line)
  1259. (let ((eol (point)))
  1260. (move-to-column maxcol)
  1261. (if (<= (point) eol)
  1262. (delete-char (- eol (point))))))))
  1263. ;; now re-read the lost messages
  1264. (goto-char (point-max))
  1265. (prog1 (point)
  1266. (mh-regenerate-headers "cur-last" t)))))
  1267. ;;;###mh-autoload
  1268. (defun mh-goto-cur-msg (&optional minimal-changes-flag)
  1269. "Position the cursor at the current message.
  1270. When optional argument MINIMAL-CHANGES-FLAG is non-nil, the
  1271. function doesn't recenter the folder buffer."
  1272. (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
  1273. (cond ((and cur-msg
  1274. (mh-goto-msg cur-msg t t))
  1275. (unless minimal-changes-flag
  1276. (mh-notate-cur)
  1277. (mh-recenter 0)
  1278. (mh-maybe-show cur-msg)))
  1279. (t
  1280. (setq overlay-arrow-position nil)
  1281. (message "No current message")))))
  1282. ;;;###mh-autoload
  1283. (defun mh-recenter (arg)
  1284. "Like recenter but with three improvements:
  1285. - At the end of the buffer it tries to show fewer empty lines.
  1286. - operates only if the current buffer is in the selected window.
  1287. (Commands like `save-some-buffers' can make this false.)
  1288. - nil ARG means recenter as if prefix argument had been given."
  1289. (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window)))
  1290. nil)
  1291. ((= (point-max) (save-excursion
  1292. (forward-line (- (/ (window-height) 2) 2))
  1293. (point)))
  1294. (let ((lines-from-end 2))
  1295. (save-excursion
  1296. (while (> (point-max) (progn (forward-line) (point)))
  1297. (incf lines-from-end)))
  1298. (recenter (- lines-from-end))))
  1299. ;; '(4) is the same as C-u prefix argument.
  1300. (t (recenter (or arg '(4))))))
  1301. (defun mh-update-unseen ()
  1302. "Synchronize the unseen sequence with MH.
  1303. Return non-nil if the MH folder was set.
  1304. The hook `mh-unseen-updated-hook' is called after the unseen sequence
  1305. is updated."
  1306. (if mh-seen-list
  1307. (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
  1308. (unseen-msgs (mh-seq-msgs unseen-seq)))
  1309. (if unseen-msgs
  1310. (progn
  1311. (mh-undefine-sequence mh-unseen-seq mh-seen-list)
  1312. (run-hooks 'mh-unseen-updated-hook)
  1313. (while mh-seen-list
  1314. (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
  1315. (setq mh-seen-list (cdr mh-seen-list)))
  1316. (setcdr unseen-seq unseen-msgs)
  1317. t) ;since we set the folder
  1318. (setq mh-seen-list nil)))))
  1319. ;;;###mh-autoload
  1320. (defun mh-outstanding-commands-p ()
  1321. "Return non-nil if there are outstanding deletes or refiles."
  1322. (save-excursion
  1323. (when (eq major-mode 'mh-show-mode)
  1324. (set-buffer mh-show-folder-buffer))
  1325. (or mh-delete-list mh-refile-list)))
  1326. ;;;###mh-autoload
  1327. (defun mh-set-folder-modified-p (flag)
  1328. "Mark current folder as modified or unmodified according to FLAG."
  1329. (set-buffer-modified-p flag))
  1330. (defun mh-process-commands (folder)
  1331. "Process outstanding commands for FOLDER.
  1332. This function runs `mh-before-commands-processed-hook' before the
  1333. commands are processed and `mh-after-commands-processed-hook'
  1334. after the commands are processed."
  1335. (message "Processing deletes and refiles for %s..." folder)
  1336. (set-buffer folder)
  1337. (with-mh-folder-updating (nil)
  1338. ;; Run the before hook -- the refile and delete lists are still valid
  1339. (run-hooks 'mh-before-commands-processed-hook)
  1340. ;; Update the unseen sequence if it exists
  1341. (mh-update-unseen)
  1342. (let ((redraw-needed-flag mh-index-data)
  1343. (folders-changed (list mh-current-folder))
  1344. (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
  1345. (mh-create-sequence-map mh-seq-list)))
  1346. (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
  1347. (make-hash-table))))
  1348. ;; Remove invalid scan lines if we are in an index folder and then remove
  1349. ;; the real messages
  1350. (when mh-index-data
  1351. (mh-index-delete-folder-headers)
  1352. (setq folders-changed
  1353. (append folders-changed (mh-index-execute-commands))))
  1354. ;; Then refile messages
  1355. (mh-mapc #'(lambda (folder-msg-list)
  1356. (let* ((dest-folder (symbol-name (car folder-msg-list)))
  1357. (last (car (mh-translate-range dest-folder "last")))
  1358. (msgs (cdr folder-msg-list)))
  1359. (push dest-folder folders-changed)
  1360. (setq redraw-needed-flag t)
  1361. (apply #'mh-exec-cmd
  1362. "refile" "-src" folder dest-folder
  1363. (mh-coalesce-msg-list msgs))
  1364. (mh-delete-scan-msgs msgs)
  1365. ;; Preserve sequences in destination folder...
  1366. (when mh-refile-preserves-sequences-flag
  1367. (clrhash dest-map)
  1368. (loop for i from (1+ (or last 0))
  1369. for msg in (sort (copy-sequence msgs) #'<)
  1370. do (loop for seq-name in (gethash msg seq-map)
  1371. do (push i (gethash seq-name dest-map))))
  1372. (maphash
  1373. #'(lambda (seq msgs)
  1374. ;; Can't be run in the background, since the
  1375. ;; current folder is changed by mark this could
  1376. ;; lead to a race condition with the next refile.
  1377. (apply #'mh-exec-cmd "mark"
  1378. "-sequence" (symbol-name seq) dest-folder
  1379. "-add" (mapcar #'(lambda (x) (format "%s" x))
  1380. (mh-coalesce-msg-list msgs))))
  1381. dest-map))))
  1382. mh-refile-list)
  1383. (setq mh-refile-list ())
  1384. ;; Now delete messages
  1385. (cond (mh-delete-list
  1386. (setq redraw-needed-flag t)
  1387. (apply 'mh-exec-cmd "rmm" folder
  1388. (mh-coalesce-msg-list mh-delete-list))
  1389. (mh-delete-scan-msgs mh-delete-list)
  1390. (setq mh-delete-list nil)))
  1391. ;; Don't need to remove sequences since delete and refile do so.
  1392. ;; Mark cur message
  1393. (if (> (buffer-size) 0)
  1394. (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
  1395. ;; Redraw folder buffer if needed
  1396. (when (and redraw-needed-flag)
  1397. (when (mh-speed-flists-active-p)
  1398. (apply #'mh-speed-flists t folders-changed))
  1399. (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
  1400. (mh-index-data (mh-index-insert-folder-headers))))
  1401. (and (buffer-file-name (get-buffer mh-show-buffer))
  1402. (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
  1403. ;; If "inc" were to put a new msg in this file,
  1404. ;; we would not notice, so mark it invalid now.
  1405. (mh-invalidate-show-buffer))
  1406. (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
  1407. (mh-remove-all-notation)
  1408. (mh-notate-user-sequences)
  1409. ;; Run the after hook -- now folders-changed is valid,
  1410. ;; but not the lists of specific messages.
  1411. (let ((mh-folders-changed folders-changed))
  1412. (run-hooks 'mh-after-commands-processed-hook)))
  1413. (message "Processing deletes and refiles for %s...done" folder)))
  1414. (defun mh-delete-scan-msgs (msgs)
  1415. "Delete the scan listing lines for MSGS."
  1416. (save-excursion
  1417. (while msgs
  1418. (when (mh-goto-msg (car msgs) t t)
  1419. (when (memq 'unthread mh-view-ops)
  1420. (mh-thread-forget-message (car msgs)))
  1421. (mh-delete-line 1))
  1422. (setq msgs (cdr msgs)))))
  1423. (defun mh-set-scan-mode ()
  1424. "Display the scan listing buffer, but do not show a message."
  1425. (if (get-buffer mh-show-buffer)
  1426. (delete-windows-on mh-show-buffer))
  1427. (mh-showing-mode 0)
  1428. (force-mode-line-update)
  1429. (if mh-recenter-summary-flag
  1430. (mh-recenter nil)))
  1431. ;;;###mh-autoload
  1432. (defun mh-make-folder-mode-line (&optional ignored)
  1433. "Set the fields of the mode line for a folder buffer.
  1434. The optional argument is now obsolete and IGNORED. It used to be
  1435. used to pass in what is now stored in the buffer-local variable
  1436. `mh-mode-line-annotation'."
  1437. (save-excursion
  1438. (save-window-excursion
  1439. (mh-first-msg)
  1440. (let ((new-first-msg-num (mh-get-msg-num nil)))
  1441. (when (or (not (memq 'unthread mh-view-ops))
  1442. (null mh-first-msg-num)
  1443. (null new-first-msg-num)
  1444. (< new-first-msg-num mh-first-msg-num))
  1445. (setq mh-first-msg-num new-first-msg-num)))
  1446. (mh-last-msg)
  1447. (let ((new-last-msg-num (mh-get-msg-num nil)))
  1448. (when (or (not (memq 'unthread mh-view-ops))
  1449. (null mh-last-msg-num)
  1450. (null new-last-msg-num)
  1451. (> new-last-msg-num mh-last-msg-num))
  1452. (setq mh-last-msg-num new-last-msg-num)))
  1453. (setq mh-msg-count (if mh-first-msg-num
  1454. (count-lines (point-min) (point-max))
  1455. 0))
  1456. (setq mode-line-buffer-identification
  1457. (list (format " {%%b%s} %s msg%s"
  1458. (if mh-mode-line-annotation
  1459. (format "/%s" mh-mode-line-annotation)
  1460. "")
  1461. (if (zerop mh-msg-count)
  1462. "no"
  1463. (format "%d" mh-msg-count))
  1464. (if (zerop mh-msg-count)
  1465. "s"
  1466. (cond ((> mh-msg-count 1)
  1467. (format "s (%d-%d)" mh-first-msg-num
  1468. mh-last-msg-num))
  1469. (mh-first-msg-num
  1470. (format " (%d)" mh-first-msg-num))
  1471. (""))))))
  1472. (mh-logo-display))))
  1473. ;;;###mh-autoload
  1474. (defun mh-scan-folder (folder range &optional dont-exec-pending)
  1475. "Scan FOLDER over RANGE.
  1476. After the scan is performed, switch to the buffer associated with
  1477. FOLDER.
  1478. Check the documentation of `mh-interactive-range' to see how RANGE is
  1479. read in interactive use.
  1480. The processing of outstanding commands is not performed if
  1481. DONT-EXEC-PENDING is non-nil."
  1482. (when (stringp range)
  1483. (setq range (delete "" (split-string range "[ \t\n]"))))
  1484. (cond ((null (get-buffer folder))
  1485. (mh-make-folder folder))
  1486. (t
  1487. (unless dont-exec-pending
  1488. (mh-process-or-undo-commands folder)
  1489. (mh-reset-threads-and-narrowing))
  1490. (switch-to-buffer folder)))
  1491. (mh-regenerate-headers range)
  1492. (if (zerop (buffer-size))
  1493. (if (equal range "all")
  1494. (message "Folder %s is empty" folder)
  1495. (message "No messages in %s, range %s" folder range))
  1496. (mh-goto-cur-msg))
  1497. (when (mh-outstanding-commands-p)
  1498. (mh-notate-deleted-and-refiled)))
  1499. ;;;###mh-autoload
  1500. (defun mh-process-or-undo-commands (folder)
  1501. "If FOLDER has outstanding commands, then either process or discard them.
  1502. Called by functions like `mh-sort-folder', so also invalidate
  1503. show buffer."
  1504. (set-buffer folder)
  1505. (if (mh-outstanding-commands-p)
  1506. (if (or mh-do-not-confirm-flag
  1507. (y-or-n-p
  1508. "Process outstanding deletes and refiles? "))
  1509. (mh-process-commands folder)
  1510. (set-buffer folder)
  1511. (mh-undo-folder)))
  1512. (mh-update-unseen)
  1513. (mh-invalidate-show-buffer))
  1514. ;;;###mh-autoload
  1515. (defun mh-regenerate-headers (range &optional update)
  1516. "Scan folder over RANGE.
  1517. If UPDATE, append the scan lines, otherwise replace."
  1518. (let ((folder mh-current-folder)
  1519. (range (if (and range (atom range)) (list range) range))
  1520. scan-start)
  1521. (message "Scanning %s..." folder)
  1522. (mh-remove-all-notation)
  1523. (with-mh-folder-updating (nil)
  1524. (if update
  1525. (goto-char (point-max))
  1526. (delete-region (point-min) (point-max))
  1527. (if mh-adaptive-cmd-note-flag
  1528. (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width
  1529. folder)))))
  1530. (setq scan-start (point))
  1531. (apply #'mh-exec-cmd-output
  1532. mh-scan-prog nil
  1533. (mh-scan-format)
  1534. "-noclear" "-noheader"
  1535. "-width" (window-width)
  1536. folder range)
  1537. (goto-char scan-start)
  1538. (cond ((looking-at "scan: no messages in")
  1539. (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
  1540. ((looking-at (if (mh-variant-p 'gnu-mh)
  1541. "scan: message set .* does not exist"
  1542. "scan: bad message list "))
  1543. (keep-lines mh-scan-valid-regexp))
  1544. ((looking-at "scan: ")) ; Keep error messages
  1545. (t
  1546. (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
  1547. (setq mh-seq-list (mh-read-folder-sequences folder nil))
  1548. (mh-notate-user-sequences)
  1549. (or update
  1550. (setq mh-mode-line-annotation
  1551. (if (equal range '("all"))
  1552. nil
  1553. mh-partial-folder-mode-line-annotation)))
  1554. (mh-make-folder-mode-line))
  1555. (message "Scanning %s...done" folder)))
  1556. ;;;###mh-autoload
  1557. (defun mh-reset-threads-and-narrowing ()
  1558. "Reset all variables pertaining to threads and narrowing.
  1559. Also removes all content from the folder buffer."
  1560. (setq mh-view-ops ())
  1561. (setq mh-folder-view-stack ())
  1562. (setq mh-thread-scan-line-map-stack ())
  1563. (let ((buffer-read-only nil)) (erase-buffer)))
  1564. (defun mh-make-folder (name)
  1565. "Create a new mail folder called NAME.
  1566. Make it the current folder."
  1567. (switch-to-buffer name)
  1568. (setq buffer-read-only nil)
  1569. (erase-buffer)
  1570. (if mh-adaptive-cmd-note-flag
  1571. (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width name))))
  1572. (setq buffer-read-only t)
  1573. (mh-folder-mode)
  1574. (mh-set-folder-modified-p nil)
  1575. (setq buffer-file-name mh-folder-filename)
  1576. (when (and (not mh-index-data)
  1577. (file-exists-p (concat buffer-file-name mh-index-data-file)))
  1578. (mh-index-read-data))
  1579. (mh-make-folder-mode-line))
  1580. ;;;###mh-autoload
  1581. (defun mh-next-msg (&optional wait-after-complaining-flag)
  1582. "Move backward or forward to the next undeleted message in the buffer.
  1583. If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and
  1584. we are at the last message, then wait for a second after telling
  1585. the user that there aren't any more unread messages."
  1586. (if (eq mh-next-direction 'forward)
  1587. (mh-next-undeleted-msg 1 wait-after-complaining-flag)
  1588. (mh-previous-undeleted-msg 1 wait-after-complaining-flag)))
  1589. ;;;###mh-autoload
  1590. (defun mh-prompt-for-refile-folder ()
  1591. "Prompt the user for a folder in which the message should be filed.
  1592. The folder is returned as a string.
  1593. The default folder name is generated by the option
  1594. `mh-default-folder-for-message-function' if it is non-nil or
  1595. `mh-folder-from-address'."
  1596. (mh-prompt-for-folder
  1597. "Destination"
  1598. (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
  1599. (if (null refile-file) ""
  1600. (with-current-buffer (get-buffer-create mh-temp-buffer)
  1601. (erase-buffer)
  1602. (insert-file-contents refile-file)
  1603. (or (and mh-default-folder-for-message-function
  1604. (let ((buffer-file-name refile-file))
  1605. (funcall mh-default-folder-for-message-function)))
  1606. (mh-folder-from-address)
  1607. (and (eq 'refile (car mh-last-destination-folder))
  1608. (symbol-name (cdr mh-last-destination-folder)))
  1609. ""))))
  1610. t))
  1611. ;;;###mh-autoload
  1612. (defun mh-folder-from-address ()
  1613. "Derive folder name from sender.
  1614. The name of the folder is derived as follows:
  1615. a) The folder name associated with the first address found in
  1616. the list `mh-default-folder-list' is used. Each element in
  1617. this list contains a \"Check Recipient\" item. If this item is
  1618. turned on, then the address is checked against the recipient
  1619. instead of the sender. This is useful for mailing lists.
  1620. b) An alias prefixed by `mh-default-folder-prefix'
  1621. corresponding to the address is used. The prefix is used to
  1622. prevent clutter in your mail directory.
  1623. Return nil if a folder name was not derived, or if the variable
  1624. `mh-default-folder-must-exist-flag' is t and the folder does not
  1625. exist."
  1626. ;; Loop for all entries in mh-default-folder-list
  1627. (save-restriction
  1628. (goto-char (point-min))
  1629. (re-search-forward "\n\n" nil 'limit)
  1630. (narrow-to-region (point-min) (point))
  1631. (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
  1632. (or (message-fetch-field "cc") "")))
  1633. (from (or (message-fetch-field "from") ""))
  1634. folder-name)
  1635. (setq folder-name
  1636. (loop for list in mh-default-folder-list
  1637. when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
  1638. return (nth 1 list)
  1639. finally return nil))
  1640. ;; Make sure a result from `mh-default-folder-list' begins with "+"
  1641. ;; since 'mh-expand-file-name below depends on it
  1642. (when (and folder-name (not (eq (aref folder-name 0) ?+)))
  1643. (setq folder-name (concat "+" folder-name)))
  1644. ;; If not, is there an alias for the address?
  1645. (when (not folder-name)
  1646. (let* ((from-header (mh-extract-from-header-value))
  1647. (address (and from-header
  1648. (nth 1 (mail-extract-address-components
  1649. from-header))))
  1650. (alias (and address (mh-alias-address-to-alias address))))
  1651. (when alias
  1652. (setq folder-name
  1653. (and alias (concat "+" mh-default-folder-prefix alias))))))
  1654. ;; If mh-default-folder-must-exist-flag set, check that folder exists.
  1655. (if (and folder-name
  1656. (or (not mh-default-folder-must-exist-flag)
  1657. (file-exists-p (mh-expand-file-name folder-name))))
  1658. folder-name))))
  1659. ;;;###mh-autoload
  1660. (defun mh-delete-a-msg (message)
  1661. "Delete MESSAGE.
  1662. If MESSAGE is nil then the message at point is deleted.
  1663. The hook `mh-delete-msg-hook' is called after you mark a message
  1664. for deletion. For example, a past maintainer of MH-E used this
  1665. once when he kept statistics on his mail usage."
  1666. (save-excursion
  1667. (if (numberp message)
  1668. (mh-goto-msg message nil t)
  1669. (beginning-of-line)
  1670. (setq message (mh-get-msg-num t)))
  1671. (if (looking-at mh-scan-refiled-msg-regexp)
  1672. (error "Message %d is refiled; undo refile before deleting" message))
  1673. (if (looking-at mh-scan-deleted-msg-regexp)
  1674. nil
  1675. (mh-set-folder-modified-p t)
  1676. (setq mh-delete-list (cons message mh-delete-list))
  1677. (mh-notate nil mh-note-deleted mh-cmd-note)
  1678. (run-hooks 'mh-delete-msg-hook))))
  1679. ;;;###mh-autoload
  1680. (defun mh-refile-a-msg (message folder)
  1681. "Refile MESSAGE in FOLDER.
  1682. If MESSAGE is nil then the message at point is refiled.
  1683. Folder is a symbol, not a string.
  1684. The hook `mh-refile-msg-hook' is called after a message is marked to
  1685. be refiled."
  1686. (save-excursion
  1687. (if (numberp message)
  1688. (mh-goto-msg message nil t)
  1689. (beginning-of-line)
  1690. (setq message (mh-get-msg-num t)))
  1691. (cond ((looking-at mh-scan-deleted-msg-regexp)
  1692. (error "Message %d is deleted; undo delete before moving" message))
  1693. ((looking-at mh-scan-refiled-msg-regexp)
  1694. (if (y-or-n-p
  1695. (format "Message %d already refiled; copy to %s as well? "
  1696. message folder))
  1697. (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
  1698. "-src" mh-current-folder
  1699. (symbol-name folder))
  1700. (message "Message not copied")))
  1701. (t
  1702. (mh-set-folder-modified-p t)
  1703. (cond ((null (assoc folder mh-refile-list))
  1704. (push (list folder message) mh-refile-list))
  1705. ((not (member message (cdr (assoc folder mh-refile-list))))
  1706. (push message (cdr (assoc folder mh-refile-list)))))
  1707. (mh-notate nil mh-note-refiled mh-cmd-note)
  1708. (run-hooks 'mh-refile-msg-hook)))))
  1709. (defun mh-undo-msg (msg)
  1710. "Undo the deletion or refile of one MSG.
  1711. If MSG is nil then act on the message at point"
  1712. (save-excursion
  1713. (if (numberp msg)
  1714. (mh-goto-msg msg t t)
  1715. (beginning-of-line)
  1716. (setq msg (mh-get-msg-num t)))
  1717. (cond ((memq msg mh-delete-list)
  1718. (setq mh-delete-list (delq msg mh-delete-list)))
  1719. (t
  1720. (dolist (folder-msg-list mh-refile-list)
  1721. (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
  1722. (setq mh-refile-list (loop for x in mh-refile-list
  1723. unless (null (cdr x)) collect x))))
  1724. (mh-notate nil ? mh-cmd-note)))
  1725. ;;;###mh-autoload
  1726. (defun mh-msg-filename (msg &optional folder)
  1727. "Return the file name of MSG in FOLDER (default current folder)."
  1728. (expand-file-name (int-to-string msg)
  1729. (if folder
  1730. (mh-expand-file-name folder)
  1731. mh-folder-filename)))
  1732. (provide 'mh-folder)
  1733. ;; Local Variables:
  1734. ;; indent-tabs-mode: nil
  1735. ;; sentence-end-double-space: nil
  1736. ;; End:
  1737. ;;; mh-folder.el ends here