Mercurial > emacs
comparison lisp/mh-e/mh-speed.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | b35587af8747 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; mh-speed.el --- Speedbar interface for MH-E. | 1 ;;; mh-speed.el --- Speedbar interface for MH-E. |
2 | 2 |
3 ;; Copyright (C) 2002 Free Software Foundation, Inc. | 3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> | 5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> |
6 ;; Maintainer: Bill Wohler <wohler@newt.com> | 6 ;; Maintainer: Bill Wohler <wohler@newt.com> |
7 ;; Keywords: mail | 7 ;; Keywords: mail |
8 ;; See: mh-e.el | 8 ;; See: mh-e.el |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
20 ;; GNU General Public License for more details. | 20 ;; GNU General Public License for more details. |
21 | 21 |
22 ;; You should have received a copy of the GNU General Public License | 22 ;; You should have received a copy of the GNU General Public License |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02111-1307, USA. | 25 ;; Boston, MA 02110-1301, USA. |
26 | 26 |
27 ;;; Commentary: | 27 ;;; Commentary: |
28 ;; Future versions should only use flists. | 28 ;; Future versions should only use flists. |
29 | 29 |
30 ;; Speedbar support for MH-E package. | 30 ;; Speedbar support for MH-E package. |
31 | 31 |
32 ;;; Change Log: | 32 ;;; Change Log: |
33 | 33 |
34 ;; $Id: mh-speed.el,v 1.37 2003/01/31 03:18:18 satyaki Exp $ | |
35 | |
36 ;;; Code: | 34 ;;; Code: |
37 | 35 |
38 ;; Requires | 36 ;;(message "> mh-speed") |
39 (require 'cl) | 37 (eval-when-compile (require 'mh-acros)) |
38 (mh-require-cl) | |
40 (require 'mh-e) | 39 (require 'mh-e) |
41 (require 'speedbar) | 40 (require 'speedbar) |
41 (require 'timer) | |
42 ;;(message "< mh-speed") | |
42 | 43 |
43 ;; Global variables | 44 ;; Global variables |
44 (defvar mh-speed-refresh-flag nil) | 45 (defvar mh-speed-refresh-flag nil) |
45 (defvar mh-speed-last-selected-folder nil) | 46 (defvar mh-speed-last-selected-folder nil) |
46 (defvar mh-speed-folder-map (make-hash-table :test #'equal)) | 47 (defvar mh-speed-folder-map (make-hash-table :test #'equal)) |
60 | 61 |
61 ;; Functions called by speedbar to initialize display... | 62 ;; Functions called by speedbar to initialize display... |
62 ;;;###mh-autoload | 63 ;;;###mh-autoload |
63 (defun mh-folder-speedbar-buttons (buffer) | 64 (defun mh-folder-speedbar-buttons (buffer) |
64 "Interface function to create MH-E speedbar buffer. | 65 "Interface function to create MH-E speedbar buffer. |
65 BUFFER is the MH-E buffer for which the speedbar buffer is to be created." | 66 BUFFER is the MH-E buffer for which the speedbar buffer is to be |
67 created." | |
66 (unless (get-text-property (point-min) 'mh-level) | 68 (unless (get-text-property (point-min) 'mh-level) |
67 (erase-buffer) | 69 (erase-buffer) |
68 (clrhash mh-speed-folder-map) | 70 (clrhash mh-speed-folder-map) |
69 (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil | 71 (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil |
70 'mh-speedbar-folder-face 0) | 72 'mh-speedbar-folder 0) |
71 (forward-line -1) | 73 (forward-line -1) |
72 (setf (gethash nil mh-speed-folder-map) | 74 (setf (gethash nil mh-speed-folder-map) |
73 (set-marker (make-marker) (1+ (line-beginning-position)))) | 75 (set-marker (or (gethash nil mh-speed-folder-map) (make-marker)) |
76 (1+ (line-beginning-position)))) | |
74 (add-text-properties | 77 (add-text-properties |
75 (line-beginning-position) (1+ (line-beginning-position)) | 78 (line-beginning-position) (1+ (line-beginning-position)) |
76 `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) | 79 `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) |
77 (mh-speed-stealth-update t) | 80 (mh-speed-stealth-update t) |
78 (when mh-speed-run-flists-flag | 81 (when (> mh-speed-update-interval 0) |
79 (mh-speed-flists nil)))) | 82 (mh-speed-flists nil)))) |
80 | 83 |
81 ;;;###mh-autoload | 84 ;;;###mh-autoload |
82 (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) | 85 (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons) |
83 ;;;###mh-autoload | 86 ;;;###mh-autoload |
88 "Specialized speedbar keymap for MH-E buffers.") | 91 "Specialized speedbar keymap for MH-E buffers.") |
89 (gnus-define-keys mh-folder-speedbar-key-map | 92 (gnus-define-keys mh-folder-speedbar-key-map |
90 "+" mh-speed-expand-folder | 93 "+" mh-speed-expand-folder |
91 "-" mh-speed-contract-folder | 94 "-" mh-speed-contract-folder |
92 "\r" mh-speed-view | 95 "\r" mh-speed-view |
93 "f" mh-speed-flists | 96 "r" mh-speed-refresh) |
94 "i" mh-speed-invalidate-map) | |
95 | 97 |
96 (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) | 98 (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) |
97 (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) | 99 (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) |
98 | 100 |
99 ;; Menus for speedbar... | 101 ;; Menus for speedbar... |
100 (defvar mh-folder-speedbar-menu-items | 102 (defvar mh-folder-speedbar-menu-items |
101 '(["Visit Folder" mh-speed-view | 103 '("--" |
104 ["Visit Folder" mh-speed-view | |
102 (save-excursion | 105 (save-excursion |
103 (set-buffer speedbar-buffer) | 106 (set-buffer speedbar-buffer) |
104 (get-text-property (line-beginning-position) 'mh-folder))] | 107 (get-text-property (line-beginning-position) 'mh-folder))] |
105 ["Expand nested folders" mh-speed-expand-folder | 108 ["Expand Nested Folders" mh-speed-expand-folder |
106 (and (get-text-property (line-beginning-position) 'mh-children-p) | 109 (and (get-text-property (line-beginning-position) 'mh-children-p) |
107 (not (get-text-property (line-beginning-position) 'mh-expanded)))] | 110 (not (get-text-property (line-beginning-position) 'mh-expanded)))] |
108 ["Contract nested folders" mh-speed-contract-folder | 111 ["Contract Nested Folders" mh-speed-contract-folder |
109 (and (get-text-property (line-beginning-position) 'mh-children-p) | 112 (and (get-text-property (line-beginning-position) 'mh-children-p) |
110 (get-text-property (line-beginning-position) 'mh-expanded))] | 113 (get-text-property (line-beginning-position) 'mh-expanded))] |
111 ["Run Flists" mh-speed-flists t] | 114 ["Refresh Speedbar" mh-speed-refresh t]) |
112 ["Invalidate cached folders" mh-speed-invalidate-map t]) | |
113 "Extra menu items for speedbar.") | 115 "Extra menu items for speedbar.") |
114 | 116 |
115 (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) | 117 (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) |
116 (defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items) | 118 (defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items) |
117 | 119 |
123 '(select-frame speedbar-attached-frame)) | 125 '(select-frame speedbar-attached-frame)) |
124 (t (error "Installed speedbar version not supported by MH-E")))) | 126 (t (error "Installed speedbar version not supported by MH-E")))) |
125 | 127 |
126 (defun mh-speed-update-current-folder (force) | 128 (defun mh-speed-update-current-folder (force) |
127 "Update speedbar highlighting of the current folder. | 129 "Update speedbar highlighting of the current folder. |
128 The function tries to be smart so that work done is minimized. The currently | 130 The function tries to be smart so that work done is minimized. |
129 highlighted folder is cached and no highlighting happens unless it changes. | 131 The currently highlighted folder is cached and no highlighting |
132 happens unless it changes. | |
130 Also highlighting is suspended while the speedbar frame is selected. | 133 Also highlighting is suspended while the speedbar frame is selected. |
131 Otherwise you get the disconcerting behavior of folders popping open on their | 134 Otherwise you get the disconcerting behavior of folders popping open |
132 own when you are trying to navigate around in the speedbar buffer. | 135 on their own when you are trying to navigate around in the speedbar |
136 buffer. | |
133 | 137 |
134 The update is always carried out if FORCE is non-nil." | 138 The update is always carried out if FORCE is non-nil." |
135 (let* ((lastf (selected-frame)) | 139 (let* ((lastf (selected-frame)) |
136 (newcf (save-excursion | 140 (newcf (save-excursion |
137 (mh-speed-select-attached-frame) | 141 (mh-speed-select-attached-frame) |
147 (setq mh-speed-refresh-flag nil) | 151 (setq mh-speed-refresh-flag nil) |
148 (select-frame speedbar-frame) | 152 (select-frame speedbar-frame) |
149 (set-buffer speedbar-buffer) | 153 (set-buffer speedbar-buffer) |
150 | 154 |
151 ;; Remove highlight from previous match... | 155 ;; Remove highlight from previous match... |
152 (mh-speed-highlight mh-speed-last-selected-folder | 156 (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder) |
153 'mh-speedbar-folder-face) | |
154 | 157 |
155 ;; If we found a match highlight it... | 158 ;; If we found a match highlight it... |
156 (when (mh-speed-goto-folder newcf) | 159 (when (mh-speed-goto-folder newcf) |
157 (mh-speed-highlight newcf 'mh-speedbar-selected-folder-face)) | 160 (mh-speed-highlight newcf 'mh-speedbar-selected-folder)) |
158 | 161 |
159 (setq mh-speed-last-selected-folder newcf) | 162 (setq mh-speed-last-selected-folder newcf) |
160 (speedbar-position-cursor-on-line) | 163 (speedbar-position-cursor-on-line) |
161 (set-window-point (frame-first-window speedbar-frame) (point)) | 164 (set-window-point (frame-first-window speedbar-frame) (point)) |
162 (set-buffer lastb) | 165 (set-buffer lastb) |
164 (when (eq lastf speedbar-frame) | 167 (when (eq lastf speedbar-frame) |
165 (setq mh-speed-refresh-flag t)))) | 168 (setq mh-speed-refresh-flag t)))) |
166 | 169 |
167 (defun mh-speed-normal-face (face) | 170 (defun mh-speed-normal-face (face) |
168 "Return normal face for given FACE." | 171 "Return normal face for given FACE." |
169 (cond ((eq face 'mh-speedbar-folder-with-unseen-messages-face) | 172 (cond ((eq face 'mh-speedbar-folder-with-unseen-messages) |
170 'mh-speedbar-folder-face) | 173 'mh-speedbar-folder) |
171 ((eq face 'mh-speedbar-selected-folder-with-unseen-messages-face) | 174 ((eq face 'mh-speedbar-selected-folder-with-unseen-messages) |
172 'mh-speedbar-selected-folder-face) | 175 'mh-speedbar-selected-folder) |
173 (t face))) | 176 (t face))) |
174 | 177 |
175 (defun mh-speed-bold-face (face) | 178 (defun mh-speed-bold-face (face) |
176 "Return bold face for given FACE." | 179 "Return bold face for given FACE." |
177 (cond ((eq face 'mh-speedbar-folder-face) | 180 (cond ((eq face 'mh-speedbar-folder) |
178 'mh-speedbar-folder-with-unseen-messages-face) | 181 'mh-speedbar-folder-with-unseen-messages) |
179 ((eq face 'mh-speedbar-selected-folder-face) | 182 ((eq face 'mh-speedbar-selected-folder) |
180 'mh-speedbar-selected-folder-with-unseen-messages-face) | 183 'mh-speedbar-selected-folder-with-unseen-messages) |
181 (t face))) | 184 (t face))) |
182 | 185 |
183 (defun mh-speed-highlight (folder face) | 186 (defun mh-speed-highlight (folder face) |
184 "Set FOLDER to FACE." | 187 "Set FOLDER to FACE." |
185 (save-excursion | 188 (save-excursion |
236 (beginning-of-line) | 239 (beginning-of-line) |
237 (equal folder (get-text-property (point) 'mh-folder)))) | 240 (equal folder (get-text-property (point) 'mh-folder)))) |
238 | 241 |
239 (defun mh-speed-extract-folder-name (buffer) | 242 (defun mh-speed-extract-folder-name (buffer) |
240 "Given an MH-E BUFFER find the folder that should be highlighted. | 243 "Given an MH-E BUFFER find the folder that should be highlighted. |
241 Do the right thing for the different kinds of buffers that MH-E uses." | 244 Do the right thing for the different kinds of buffers that MH-E |
245 uses." | |
242 (save-excursion | 246 (save-excursion |
243 (set-buffer buffer) | 247 (set-buffer buffer) |
244 (cond ((eq major-mode 'mh-folder-mode) | 248 (cond ((eq major-mode 'mh-folder-mode) |
245 mh-current-folder) | 249 mh-current-folder) |
246 ((eq major-mode 'mh-show-mode) | 250 ((eq major-mode 'mh-show-mode) |
270 (if counts | 274 (if counts |
271 (format " (%s/%s)" (car counts) (cdr counts)) | 275 (format " (%s/%s)" (car counts) (cdr counts)) |
272 "")) | 276 "")) |
273 'mh-speed-view nil | 277 'mh-speed-view nil |
274 (if (and counts (> (car counts) 0)) | 278 (if (and counts (> (car counts) 0)) |
275 'mh-speedbar-folder-with-unseen-messages-face | 279 'mh-speedbar-folder-with-unseen-messages |
276 'mh-speedbar-folder-face) | 280 'mh-speedbar-folder) |
277 level) | 281 level) |
278 (save-excursion | 282 (save-excursion |
279 (forward-line -1) | 283 (forward-line -1) |
280 (setf (gethash folder-name mh-speed-folder-map) | 284 (setf (gethash folder-name mh-speed-folder-map) |
281 (set-marker (make-marker) (1+ (line-beginning-position)))) | 285 (set-marker (or (gethash folder-name mh-speed-folder-map) |
286 (make-marker)) | |
287 (1+ (line-beginning-position)))) | |
282 (add-text-properties | 288 (add-text-properties |
283 (line-beginning-position) (1+ (line-beginning-position)) | 289 (line-beginning-position) (1+ (line-beginning-position)) |
284 `(mh-folder ,folder-name | 290 `(mh-folder ,folder-name |
285 mh-expanded nil | 291 mh-expanded nil |
286 mh-children-p ,(not (not (cdr f))) | 292 mh-children-p ,(not (not (cdr f))) |
289 mh-level ,level)))))) | 295 mh-level ,level)))))) |
290 folder-list))) | 296 folder-list))) |
291 | 297 |
292 ;;;###mh-autoload | 298 ;;;###mh-autoload |
293 (defun mh-speed-toggle (&rest args) | 299 (defun mh-speed-toggle (&rest args) |
294 "Toggle the display of child folders. | 300 "Toggle the display of child folders in the speedbar. |
295 The otional ARGS are ignored and there for compatibilty with speedbar." | 301 The optional ARGS from speedbar are ignored." |
296 (interactive) | 302 (interactive) |
297 (declare (ignore args)) | 303 (declare (ignore args)) |
298 (beginning-of-line) | 304 (beginning-of-line) |
299 (let ((parent (get-text-property (point) 'mh-folder)) | 305 (let ((parent (get-text-property (point) 'mh-folder)) |
300 (kids-p (get-text-property (point) 'mh-children-p)) | 306 (kids-p (get-text-property (point) 'mh-children-p)) |
307 (expanded | 313 (expanded |
308 (forward-line) | 314 (forward-line) |
309 (setq start-region (point)) | 315 (setq start-region (point)) |
310 (while (and (get-text-property (point) 'mh-level) | 316 (while (and (get-text-property (point) 'mh-level) |
311 (> (get-text-property (point) 'mh-level) level)) | 317 (> (get-text-property (point) 'mh-level) level)) |
312 (remhash (get-text-property (point) 'mh-folder) | 318 (let ((folder (get-text-property (point) 'mh-folder))) |
313 mh-speed-folder-map) | 319 (when (gethash folder mh-speed-folder-map) |
320 (set-marker (gethash folder mh-speed-folder-map) nil) | |
321 (remhash folder mh-speed-folder-map))) | |
314 (forward-line)) | 322 (forward-line)) |
315 (delete-region start-region (point)) | 323 (delete-region start-region (point)) |
316 (forward-line -1) | 324 (forward-line -1) |
317 (speedbar-change-expand-button-char ?+) | 325 (speedbar-change-expand-button-char ?+) |
318 (add-text-properties | 326 (add-text-properties |
330 (defalias 'mh-speed-expand-folder 'mh-speed-toggle) | 338 (defalias 'mh-speed-expand-folder 'mh-speed-toggle) |
331 (defalias 'mh-speed-contract-folder 'mh-speed-toggle) | 339 (defalias 'mh-speed-contract-folder 'mh-speed-toggle) |
332 | 340 |
333 ;;;###mh-autoload | 341 ;;;###mh-autoload |
334 (defun mh-speed-view (&rest args) | 342 (defun mh-speed-view (&rest args) |
335 "View folder on current line. | 343 "Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder]. |
336 Optional ARGS are ignored." | 344 The optional ARGS from speedbar are ignored." |
337 (interactive) | 345 (interactive) |
338 (declare (ignore args)) | 346 (declare (ignore args)) |
339 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) | 347 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) |
340 (range (and (stringp folder) (mh-read-msg-range folder)))) | 348 (range (and (stringp folder) |
349 (mh-read-range "Scan" folder t nil nil | |
350 mh-interpret-number-as-range-flag)))) | |
341 (when (stringp folder) | 351 (when (stringp folder) |
342 (speedbar-with-attached-buffer | 352 (speedbar-with-attached-buffer |
343 (mh-visit-folder folder range) | 353 (mh-visit-folder folder range) |
344 (delete-other-windows))))) | 354 (delete-other-windows))))) |
345 | 355 |
346 (defvar mh-speed-current-folder nil) | 356 (defvar mh-speed-current-folder nil) |
347 | 357 (defvar mh-speed-flists-folder nil) |
348 ;;;###mh-autoload | 358 |
349 (defun mh-speed-flists (force) | 359 (defmacro mh-process-kill-without-query (process) |
360 "PROCESS can be killed without query on Emacs exit. | |
361 Avoid using `process-kill-without-query' if possible since it is | |
362 now obsolete." | |
363 (if (fboundp 'set-process-query-on-exit-flag) | |
364 `(set-process-query-on-exit-flag ,process nil) | |
365 `(process-kill-without-query ,process))) | |
366 | |
367 ;;;###mh-autoload | |
368 (defun mh-speed-flists (force &rest folders) | |
350 "Execute flists -recurse and update message counts. | 369 "Execute flists -recurse and update message counts. |
351 If FORCE is non-nil the timer is reset." | 370 If FORCE is non-nil the timer is reset. |
371 | |
372 Any number of optional FOLDERS can be specified. If specified, | |
373 flists is run only for that one folder." | |
352 (interactive (list t)) | 374 (interactive (list t)) |
353 (when force | 375 (when force |
354 (when (timerp mh-speed-flists-timer) | 376 (when mh-speed-flists-timer |
355 (cancel-timer mh-speed-flists-timer)) | 377 (cancel-timer mh-speed-flists-timer) |
356 (setq mh-speed-flists-timer nil) | 378 (setq mh-speed-flists-timer nil)) |
357 (when (and (processp mh-speed-flists-process) | 379 (when (and (processp mh-speed-flists-process) |
358 (not (eq (process-status mh-speed-flists-process) 'exit))) | 380 (not (eq (process-status mh-speed-flists-process) 'exit))) |
381 (set-process-filter mh-speed-flists-process t) | |
359 (kill-process mh-speed-flists-process) | 382 (kill-process mh-speed-flists-process) |
383 (setq mh-speed-partial-line "") | |
360 (setq mh-speed-flists-process nil))) | 384 (setq mh-speed-flists-process nil))) |
385 (setq mh-speed-flists-folder folders) | |
361 (unless mh-speed-flists-timer | 386 (unless mh-speed-flists-timer |
362 (setq mh-speed-flists-timer | 387 (setq mh-speed-flists-timer |
363 (run-at-time | 388 (run-at-time |
364 nil mh-speed-flists-interval | 389 nil (if (> mh-speed-update-interval 0) |
390 mh-speed-update-interval | |
391 nil) | |
365 (lambda () | 392 (lambda () |
366 (unless (and (processp mh-speed-flists-process) | 393 (unless (and (processp mh-speed-flists-process) |
367 (not (eq (process-status mh-speed-flists-process) | 394 (not (eq (process-status mh-speed-flists-process) |
368 'exit))) | 395 'exit))) |
369 (setq mh-speed-current-folder | 396 (setq mh-speed-current-folder |
370 (concat | 397 (concat |
371 (with-temp-buffer | 398 (if mh-speed-flists-folder |
372 (call-process (expand-file-name "folder" mh-progs) | 399 (substring (car (reverse mh-speed-flists-folder)) 1) |
373 nil '(t nil) nil "-fast") | 400 (with-temp-buffer |
374 (buffer-substring (point-min) (1- (point-max)))) | 401 (call-process (expand-file-name "folder" mh-progs) |
402 nil '(t nil) nil "-fast") | |
403 (buffer-substring (point-min) (1- (point-max))))) | |
375 "+")) | 404 "+")) |
376 (setq mh-speed-flists-process | 405 (setq mh-speed-flists-process |
377 (start-process "*flists*" nil | 406 (apply #'start-process "*flists*" nil |
378 (expand-file-name "flists" mh-progs) | 407 (expand-file-name "flists" mh-progs) |
379 "-recurse" | 408 (if mh-speed-flists-folder "-noall" "-all") |
380 "-sequence" (symbol-name mh-unseen-seq))) | 409 "-sequence" (symbol-name mh-unseen-seq) |
410 (or mh-speed-flists-folder '("-recurse")))) | |
411 ;; Run flists on all folders the next time around... | |
412 (setq mh-speed-flists-folder nil) | |
413 (mh-process-kill-without-query mh-speed-flists-process) | |
381 (set-process-filter mh-speed-flists-process | 414 (set-process-filter mh-speed-flists-process |
382 'mh-speed-parse-flists-output))))))) | 415 'mh-speed-parse-flists-output))))))) |
383 | 416 |
384 ;; Copied from mh-make-folder-list-filter... | 417 ;; Copied from mh-make-folder-list-filter... |
385 (defun mh-speed-parse-flists-output (process output) | 418 (defun mh-speed-parse-flists-output (process output) |
386 "Parse the incremental results from flists. | 419 "Parse the incremental results from flists. |
387 PROCESS is the flists process and OUTPUT is the results that must be handled | 420 PROCESS is the flists process and OUTPUT is the results that must |
388 next." | 421 be handled next." |
389 (let ((prevailing-match-data (match-data)) | 422 (let ((prevailing-match-data (match-data)) |
390 (position 0) | 423 (position 0) |
391 line-end line folder unseen total) | 424 line-end line folder unseen total) |
392 (unwind-protect | 425 (unwind-protect |
393 (while (setq line-end (string-match "\n" output position)) | 426 (while (setq line-end (string-match "\n" output position)) |
395 mh-speed-partial-line | 428 mh-speed-partial-line |
396 (substring output position line-end)) | 429 (substring output position line-end)) |
397 mh-speed-partial-line "") | 430 mh-speed-partial-line "") |
398 (multiple-value-setq (folder unseen total) | 431 (multiple-value-setq (folder unseen total) |
399 (mh-parse-flist-output-line line mh-speed-current-folder)) | 432 (mh-parse-flist-output-line line mh-speed-current-folder)) |
400 (when (and folder unseen total) | 433 (when (and folder unseen total |
434 (let ((old-pair (gethash folder mh-speed-flists-cache))) | |
435 (or (not (equal (car old-pair) unseen)) | |
436 (not (equal (cdr old-pair) total))))) | |
401 (setf (gethash folder mh-speed-flists-cache) (cons unseen total)) | 437 (setf (gethash folder mh-speed-flists-cache) (cons unseen total)) |
402 (save-excursion | 438 (save-excursion |
403 (when (buffer-live-p (get-buffer speedbar-buffer)) | 439 (when (buffer-live-p (get-buffer speedbar-buffer)) |
404 (set-buffer speedbar-buffer) | 440 (set-buffer speedbar-buffer) |
405 (speedbar-with-writable | 441 (speedbar-with-writable |
464 (speedbar-with-writable | 500 (speedbar-with-writable |
465 (mh-speedbar-change-expand-button-char parent-change) | 501 (mh-speedbar-change-expand-button-char parent-change) |
466 (add-text-properties | 502 (add-text-properties |
467 (line-beginning-position) (1+ (line-beginning-position)) | 503 (line-beginning-position) (1+ (line-beginning-position)) |
468 `(mh-children-p ,(equal parent-change ?+))))) | 504 `(mh-children-p ,(equal parent-change ?+))))) |
469 (mh-speed-highlight mh-speed-last-selected-folder | 505 (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder) |
470 'mh-speedbar-folder-face) | |
471 (setq mh-speed-last-selected-folder nil) | 506 (setq mh-speed-last-selected-folder nil) |
472 (setq mh-speed-refresh-flag t))) | 507 (setq mh-speed-refresh-flag t))) |
473 (when (equal folder "") | 508 (when (equal folder "") |
474 (clrhash mh-sub-folders-cache))))) | 509 (clrhash mh-sub-folders-cache))))) |
510 | |
511 (defun mh-speed-refresh () | |
512 "Regenerates the list of folders in the speedbar. | |
513 | |
514 Run this command if you've added or deleted a folder, or want to | |
515 update the unseen message count before the next automatic | |
516 update." | |
517 (interactive) | |
518 (mh-speed-flists t) | |
519 (mh-speed-invalidate-map "")) | |
475 | 520 |
476 ;;;###mh-autoload | 521 ;;;###mh-autoload |
477 (defun mh-speed-add-folder (folder) | 522 (defun mh-speed-add-folder (folder) |
478 "Add FOLDER since it is being created. | 523 "Add FOLDER since it is being created. |
479 The function invalidates the latest ancestor that is present." | 524 The function invalidates the latest ancestor that is present." |
512 (backward-char 2) | 557 (backward-char 2) |
513 (delete-char 1) | 558 (delete-char 1) |
514 (insert-char char 1 t) | 559 (insert-char char 1 t) |
515 (put-text-property (point) (1- (point)) 'invisible nil) | 560 (put-text-property (point) (1- (point)) 'invisible nil) |
516 ;; make sure we fix the image on the text here. | 561 ;; make sure we fix the image on the text here. |
517 (speedbar-insert-image-button-maybe (- (point) 2) 3))))) | 562 (mh-funcall-if-exists |
563 speedbar-insert-image-button-maybe (- (point) 2) 3))))) | |
518 | 564 |
519 (provide 'mh-speed) | 565 (provide 'mh-speed) |
520 | 566 |
521 ;;; Local Variables: | 567 ;; Local Variables: |
522 ;;; indent-tabs-mode: nil | 568 ;; indent-tabs-mode: nil |
523 ;;; sentence-end-double-space: nil | 569 ;; sentence-end-double-space: nil |
524 ;;; End: | 570 ;; End: |
525 | 571 |
572 ;; arch-tag: d38ddcd4-3c00-4e37-99bf-8b89dda7b32c | |
526 ;;; mh-speed.el ends here | 573 ;;; mh-speed.el ends here |