PageRenderTime 40ms CodeModel.GetById 17ms RepoModel.GetById 0ms app.codeStats 0ms

/incoming/mew-1.94.2/contrib/mew-f.el

https://github.com/emacsmirror/ohio-archive
Emacs Lisp | 229 lines | 177 code | 37 blank | 15 comment | 6 complexity | a1331eea6af27613c3deb41c4c93c9aa MD5 | raw file
  1. ;; mew-f.el --
  2. ;; Author : Kai Grossjohann
  3. ;; Created On : Fri Oct 29 13:38:34 1993
  4. ;; Last Modified By: Linn H. Stanton to translate from mh to mew
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6. (defvar mew-f-folder-list nil
  7. "This is a list of (FOLDERNAME . NUMMSGS) pairs, one for each entry
  8. in mew-folder-alist, containing all the names of the folders together
  9. with the number of messages in each folder.")
  10. (defvar mew-f-buffername "* Mew: Folders *"
  11. "The name of the folder list buffer.")
  12. (defvar mew-f-folder-sets nil
  13. "This is an alist of pairs of a folder set name and a regexp matching
  14. all folder names to be shown.")
  15. (defvar mew-f-current-set "all") ; being defined in function mew-f
  16. (defvar mew-f-default-set "all") ; being defined in function mew-f
  17. (defvar mew-f-show-empty t
  18. "Folders with 0 messages in them will be shown in folder list iff t")
  19. (defun mew-f-folder-size (folder)
  20. (interactive)
  21. (length (directory-files (mew-expand-folder folder)
  22. t
  23. "^[0-9]+$"
  24. nil)))
  25. (defun mew-f-display-folders (regexp)
  26. "Go through the list of folders and display one line for each folder
  27. matching the regexp."
  28. (interactive)
  29. (switch-to-buffer (get-buffer-create mew-f-buffername))
  30. (delete-other-windows)
  31. (erase-buffer)
  32. (mapcar '(lambda (folder)
  33. (if (string-match regexp (car folder))
  34. (if (or mew-f-show-empty (not (zerop (cdr folder))))
  35. (insert (format "%10d : %s\n"
  36. (cdr folder)
  37. (car folder))))))
  38. mew-f-folder-list)
  39. (mew-f-first-folder))
  40. (defun mew-f-define-set (name regexp)
  41. "Add the NAME, REGEXP pair to the mew-f-folder-sets alist if there is no
  42. folder set with this name in it."
  43. (interactive)
  44. (if (assoc name mew-f-folder-sets)
  45. ()
  46. (setq mew-f-folder-sets (cons (cons name regexp) mew-f-folder-sets))))
  47. (defun mew-f-current-folder ()
  48. "Return the name of the folder displayed on the line the cursor is on."
  49. (interactive)
  50. (save-excursion
  51. (beginning-of-line)
  52. (looking-at "[ \t]*\\([0-9]+\\)[ \t]*:[ \t]+\\(\\+.*\\)$")
  53. (buffer-substring (match-beginning 2) (match-end 2))))
  54. ;;
  55. ;; User accessible functions
  56. ;;
  57. (defun mew-f-recalculate-folder-list ()
  58. "For each folder in mew-folder-alist, determine the number of messages in
  59. it and update mew-f-folder-list."
  60. (interactive)
  61. (message "Recalculating folder list...")
  62. (setq mew-f-folder-list
  63. (mapcar '(lambda (f)
  64. (cons (car f) (mew-f-folder-size (car f))))
  65. mew-folder-alist))
  66. (setq mew-f-folder-list (sort mew-f-folder-list
  67. '(lambda (a b) (string< (car a) (car b)))))
  68. (message "Recalculating folder list...done"))
  69. (defun mew-f-view-set (&optional name)
  70. "In the list of folders, display folders belonging to folder set NAME
  71. only."
  72. (interactive)
  73. (let ((setname
  74. (or name
  75. (completing-read "Name of folder set: "
  76. mew-f-folder-sets
  77. nil
  78. t))))
  79. (setq mew-f-current-set setname)
  80. (mew-f-display-folders (cdr (assoc setname mew-f-folder-sets)))))
  81. (defun mew-f-previous-folder (num)
  82. "Go up NUM lines in the folder list. Do not go past first line."
  83. (interactive "p")
  84. (forward-line (- num))
  85. (search-forward " : "))
  86. (defun mew-f-next-folder (num)
  87. "Go down NUM lines in the folder list. Do not go past last line."
  88. (interactive "p")
  89. (forward-line num)
  90. (if (not (eobp))
  91. (search-forward " : ")))
  92. (defun mew-f-first-folder ()
  93. "Go to the first folder in the folder list."
  94. (interactive)
  95. (beginning-of-buffer)
  96. (search-forward " : "))
  97. (defun mew-f-last-folder ()
  98. "Go to the last folder in the folder list."
  99. (interactive)
  100. (end-of-buffer)
  101. (if (looking-at "^$")
  102. (forward-line -1))
  103. (search-forward " : "))
  104. (defun mew-f-visit-this-folder ()
  105. "Call mew-goto-folder-subr with folder on the line the cursor is on."
  106. (interactive)
  107. (mew-summary-goto-folder-subr (mew-f-current-folder) t))
  108. (defun mew-f-toggle-show-empty ()
  109. "Invert the mew-f-show-empty variable. See there for more info."
  110. (interactive)
  111. (setq mew-f-show-empty (not mew-f-show-empty))
  112. (mew-f-display-folders (cdr (assoc mew-f-current-set mew-f-folder-sets)))
  113. (message
  114. (if mew-f-show-empty "Showing empty folders." "Not showing empty folders.")))
  115. (defun mew-f-show-empty-on ()
  116. "Show empty folders in the list of folders."
  117. (interactive)
  118. (setq mew-f-show-empty t))
  119. (defun mew-f-show-empty-off ()
  120. "Do not show empty folders in the list of folders."
  121. (interactive)
  122. (setq mew-f-show-empty nil))
  123. ;;
  124. ;; Keymaps
  125. ;;
  126. (defvar mew-f-mode-map (make-keymap))
  127. (suppress-keymap mew-f-mode-map)
  128. (define-key mew-f-mode-map "n" 'mew-f-next-folder)
  129. (define-key mew-f-mode-map "p" 'mew-f-previous-folder)
  130. (define-key mew-f-mode-map "<" 'mew-f-first-folder)
  131. (define-key mew-f-mode-map ">" 'mew-f-last-folder)
  132. (define-key mew-f-mode-map "v" 'mew-f-view-set)
  133. (define-key mew-f-mode-map " " 'mew-f-visit-this-folder)
  134. (define-key mew-f-mode-map "\C-m" 'mew-f-visit-this-folder)
  135. (define-key mew-f-mode-map "e" 'mew-f-toggle-show-empty)
  136. (define-key mew-f-mode-map "m" 'mew-summary-send)
  137. (define-key mew-f-mode-map "f" 'mew-summary-goto-folder)
  138. (define-key mew-f-mode-map "r" 'mew-f-reenter)
  139. (define-key mew-f-mode-map "q" 'mew-f-reenter)
  140. (define-key mew-f-mode-map "g" 'mew-f-reenter)
  141. (define-key mew-summary-mode-map "q" 'mew-f-reenter)
  142. ;;
  143. ;; entry points
  144. ;;
  145. (defun mew-f ()
  146. "Show a list of folders with the number of messages for
  147. each. Variable mew-f-folder-sets contains a number of regexps that match
  148. certain folder names to be displayed. Provides functions to go up and
  149. down the list and to change the regexp."
  150. (interactive)
  151. (message "Mew: reading folder list")
  152. (mew-f-recalculate-folder-list)
  153. (message "Mew: reading folder list...done")
  154. (mew-f-define-set "all" ".*")
  155. (mew-f-view-set mew-f-default-set)
  156. (mew-f-mode))
  157. (defun mew-f-reenter ()
  158. "Like mew-f but assume the list of folders buffer has already been
  159. generated. Just update the numbers of messages in each folder."
  160. (interactive)
  161. (mew-f-recalculate-folder-list)
  162. (mew-f-view-set mew-f-current-set))
  163. (defun mew-f-mode ()
  164. "Show list of folders; extension of mew which is required for this to work.
  165. A list of folders is shown. You can move among the folders and select
  166. a folder. An additional feature is that you can define sets of folders
  167. based on regular expressions and switch among the view of the folder
  168. sets. This works as follows:
  169. In your .emacs file, put lines like the following:
  170. (mew-f-define-set \"news\" \"\\\\+news\\\\.\")
  171. This defines the folder set `news' to be all folders whose names begin
  172. with the string `+news.'. You can switch between the folder sets with
  173. \\[mew-f-view-set].
  174. \\{mew-f-mode-map}
  175. mew-f uses the following variables:
  176. mew-f-buffername (\"* MEW-F: Folders *\")
  177. The name of the folder list buffer.
  178. mew-f-show-empty (t)
  179. Folders with 0 messages in the will be show in folder list iff t.
  180. "
  181. (interactive)
  182. (setq major-mode 'mew-f-mode)
  183. (setq mode-name "mew-f")
  184. (use-local-map mew-f-mode-map))
  185. (mew-f-define-set "incoming" "\\+inbox\\|+auto\\.")
  186. (mew-f-define-set "cypherpunks" "\\+cypherpunks\\.")
  187. (mew-f-define-set "sun-managers" "\\+sun-managers\\.")
  188. (mew-f-define-set "libernet" "\\+libernet\\.")
  189. (mew-f-define-set "porchephiles" "\\+porchephiles\\.")
  190. (mew-f-define-set "sug" "\\+sug\\.")
  191. (provide 'mew-f)
  192. ;; -- mew-f ends here