Mercurial > emacs

comparison lisp/mh-e/mh-speed.el @ 50702:7dd3d5eae9c7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgraded to MH-E version 7.3. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
author Bill Wohler <wohler@newt.com>
date Fri, 25 Apr 2003 05:52:00 +0000
parents b35587af8747
children 695cf19ef79e
comparison
equal deleted inserted replaced
50701:cb5f0a5d5b36 50702:7dd3d5eae9c7
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 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
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
34 ;; $Id: mh-speed.el,v 1.37 2003/01/31 03:18:18 satyaki Exp $
35 33
36 ;;; Code: 34 ;;; Code:
37 35
38 ;; Requires 36 ;; Requires
39 (require 'cl) 37 (require 'cl)
68 (clrhash mh-speed-folder-map) 66 (clrhash mh-speed-folder-map)
69 (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil 67 (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
70 'mh-speedbar-folder-face 0) 68 'mh-speedbar-folder-face 0)
71 (forward-line -1) 69 (forward-line -1)
72 (setf (gethash nil mh-speed-folder-map) 70 (setf (gethash nil mh-speed-folder-map)
73 (set-marker (make-marker) (1+ (line-beginning-position)))) 71 (set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
72 (1+ (line-beginning-position))))
74 (add-text-properties 73 (add-text-properties
75 (line-beginning-position) (1+ (line-beginning-position)) 74 (line-beginning-position) (1+ (line-beginning-position))
76 `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) 75 `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
77 (mh-speed-stealth-update t) 76 (mh-speed-stealth-update t)
78 (when mh-speed-run-flists-flag 77 (when mh-speed-run-flists-flag
276 'mh-speedbar-folder-face) 275 'mh-speedbar-folder-face)
277 level) 276 level)
278 (save-excursion 277 (save-excursion
279 (forward-line -1) 278 (forward-line -1)
280 (setf (gethash folder-name mh-speed-folder-map) 279 (setf (gethash folder-name mh-speed-folder-map)
281 (set-marker (make-marker) (1+ (line-beginning-position)))) 280 (set-marker (or (gethash folder-name mh-speed-folder-map)
281 (make-marker))
282 (1+ (line-beginning-position))))
282 (add-text-properties 283 (add-text-properties
283 (line-beginning-position) (1+ (line-beginning-position)) 284 (line-beginning-position) (1+ (line-beginning-position))
284 `(mh-folder ,folder-name 285 `(mh-folder ,folder-name
285 mh-expanded nil 286 mh-expanded nil
286 mh-children-p ,(not (not (cdr f))) 287 mh-children-p ,(not (not (cdr f)))
307 (expanded 308 (expanded
308 (forward-line) 309 (forward-line)
309 (setq start-region (point)) 310 (setq start-region (point))
310 (while (and (get-text-property (point) 'mh-level) 311 (while (and (get-text-property (point) 'mh-level)
311 (> (get-text-property (point) 'mh-level) level)) 312 (> (get-text-property (point) 'mh-level) level))
312 (remhash (get-text-property (point) 'mh-folder) 313 (let ((folder (get-text-property (point) 'mh-folder)))
313 mh-speed-folder-map) 314 (when (gethash folder mh-speed-folder-map)
315 (set-marker (gethash folder mh-speed-folder-map) nil)
316 (remhash folder mh-speed-folder-map)))
314 (forward-line)) 317 (forward-line))
315 (delete-region start-region (point)) 318 (delete-region start-region (point))
316 (forward-line -1) 319 (forward-line -1)
317 (speedbar-change-expand-button-char ?+) 320 (speedbar-change-expand-button-char ?+)
318 (add-text-properties 321 (add-text-properties
342 (speedbar-with-attached-buffer 345 (speedbar-with-attached-buffer
343 (mh-visit-folder folder range) 346 (mh-visit-folder folder range)
344 (delete-other-windows))))) 347 (delete-other-windows)))))
345 348
346 (defvar mh-speed-current-folder nil) 349 (defvar mh-speed-current-folder nil)
347 350 (defvar mh-speed-flists-folder nil)
348 ;;;###mh-autoload 351
349 (defun mh-speed-flists (force) 352 ;;;###mh-autoload
353 (defun mh-speed-flists (force &optional folder)
350 "Execute flists -recurse and update message counts. 354 "Execute flists -recurse and update message counts.
351 If FORCE is non-nil the timer is reset." 355 If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run
356 only for that one folder."
352 (interactive (list t)) 357 (interactive (list t))
353 (when force 358 (when force
354 (when (timerp mh-speed-flists-timer) 359 (when mh-speed-flists-timer
355 (cancel-timer mh-speed-flists-timer)) 360 (cancel-timer mh-speed-flists-timer)
356 (setq mh-speed-flists-timer nil) 361 (setq mh-speed-flists-timer nil))
357 (when (and (processp mh-speed-flists-process) 362 (when (and (processp mh-speed-flists-process)
358 (not (eq (process-status mh-speed-flists-process) 'exit))) 363 (not (eq (process-status mh-speed-flists-process) 'exit)))
364 (set-process-filter mh-speed-flists-process t)
359 (kill-process mh-speed-flists-process) 365 (kill-process mh-speed-flists-process)
366 (setq mh-speed-partial-line "")
360 (setq mh-speed-flists-process nil))) 367 (setq mh-speed-flists-process nil)))
368 (setq mh-speed-flists-folder folder)
361 (unless mh-speed-flists-timer 369 (unless mh-speed-flists-timer
362 (setq mh-speed-flists-timer 370 (setq mh-speed-flists-timer
363 (run-at-time 371 (run-at-time
364 nil mh-speed-flists-interval 372 nil (and mh-speed-run-flists-flag mh-speed-flists-interval)
365 (lambda () 373 (lambda ()
366 (unless (and (processp mh-speed-flists-process) 374 (unless (and (processp mh-speed-flists-process)
367 (not (eq (process-status mh-speed-flists-process) 375 (not (eq (process-status mh-speed-flists-process)
368 'exit))) 376 'exit)))
369 (setq mh-speed-current-folder 377 (setq mh-speed-current-folder
374 (buffer-substring (point-min) (1- (point-max)))) 382 (buffer-substring (point-min) (1- (point-max))))
375 "+")) 383 "+"))
376 (setq mh-speed-flists-process 384 (setq mh-speed-flists-process
377 (start-process "*flists*" nil 385 (start-process "*flists*" nil
378 (expand-file-name "flists" mh-progs) 386 (expand-file-name "flists" mh-progs)
379 "-recurse" 387 (or mh-speed-flists-folder "-recurse")
388 (if mh-speed-flists-folder "-noall" "-all")
380 "-sequence" (symbol-name mh-unseen-seq))) 389 "-sequence" (symbol-name mh-unseen-seq)))
390 ;; Run flists on all folders the next time around...
391 (setq mh-speed-flists-folder nil)
381 (set-process-filter mh-speed-flists-process 392 (set-process-filter mh-speed-flists-process
382 'mh-speed-parse-flists-output))))))) 393 'mh-speed-parse-flists-output)))))))
383 394
384 ;; Copied from mh-make-folder-list-filter... 395 ;; Copied from mh-make-folder-list-filter...
385 (defun mh-speed-parse-flists-output (process output) 396 (defun mh-speed-parse-flists-output (process output)
395 mh-speed-partial-line 406 mh-speed-partial-line
396 (substring output position line-end)) 407 (substring output position line-end))
397 mh-speed-partial-line "") 408 mh-speed-partial-line "")
398 (multiple-value-setq (folder unseen total) 409 (multiple-value-setq (folder unseen total)
399 (mh-parse-flist-output-line line mh-speed-current-folder)) 410 (mh-parse-flist-output-line line mh-speed-current-folder))
400 (when (and folder unseen total) 411 (when (and folder unseen total
412 (let ((old-pair (gethash folder mh-speed-flists-cache)))
413 (or (not (equal (car old-pair) unseen))
414 (not (equal (cdr old-pair) total)))))
401 (setf (gethash folder mh-speed-flists-cache) (cons unseen total)) 415 (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
402 (save-excursion 416 (save-excursion
403 (when (buffer-live-p (get-buffer speedbar-buffer)) 417 (when (buffer-live-p (get-buffer speedbar-buffer))
404 (set-buffer speedbar-buffer) 418 (set-buffer speedbar-buffer)
405 (speedbar-with-writable 419 (speedbar-with-writable
512 (backward-char 2) 526 (backward-char 2)
513 (delete-char 1) 527 (delete-char 1)
514 (insert-char char 1 t) 528 (insert-char char 1 t)
515 (put-text-property (point) (1- (point)) 'invisible nil) 529 (put-text-property (point) (1- (point)) 'invisible nil)
516 ;; make sure we fix the image on the text here. 530 ;; make sure we fix the image on the text here.
517 (speedbar-insert-image-button-maybe (- (point) 2) 3))))) 531 (mh-funcall-if-exists
532 speedbar-insert-image-button-maybe (- (point) 2) 3)))))
518 533
519 (provide 'mh-speed) 534 (provide 'mh-speed)
520 535
521 ;;; Local Variables: 536 ;;; Local Variables:
522 ;;; indent-tabs-mode: nil 537 ;;; indent-tabs-mode: nil