cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-f.el

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