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