/[emacs]/emacs/lisp/mh-e/mh-speed.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-speed.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2.4.1 by miles, Fri Apr 4 06:20:30 2003 UTC revision 1.2.4.2 by miles, Tue Oct 14 23:39:26 2003 UTC
# Line 1  Line 1 
1  ;;; mh-speed.el --- Speedbar interface for MH-E.  ;;; mh-speed.el --- Speedbar interface for MH-E.
2    
3  ;; Copyright (C) 2002 Free Software Foundation, Inc.  ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>  ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
# Line 31  Line 31 
31    
32  ;;; Change Log:  ;;; Change Log:
33    
 ;; $Id$  
   
34  ;;; Code:  ;;; Code:
35    
36  ;; Requires  ;; Requires
# Line 70  BUFFER is the MH-E buffer for which the Line 68  BUFFER is the MH-E buffer for which the
68                              'mh-speedbar-folder-face 0)                              'mh-speedbar-folder-face 0)
69      (forward-line -1)      (forward-line -1)
70      (setf (gethash nil mh-speed-folder-map)      (setf (gethash nil mh-speed-folder-map)
71            (set-marker (make-marker) (1+ (line-beginning-position))))            (set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
72                          (1+ (line-beginning-position))))
73      (add-text-properties      (add-text-properties
74       (line-beginning-position) (1+ (line-beginning-position))       (line-beginning-position) (1+ (line-beginning-position))
75       `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))       `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
# Line 278  Do the right thing for the different kin Line 277  Do the right thing for the different kin
277             (save-excursion             (save-excursion
278               (forward-line -1)               (forward-line -1)
279               (setf (gethash folder-name mh-speed-folder-map)               (setf (gethash folder-name mh-speed-folder-map)
280                     (set-marker (make-marker) (1+ (line-beginning-position))))                     (set-marker (or (gethash folder-name mh-speed-folder-map)
281                                       (make-marker))
282                                   (1+ (line-beginning-position))))
283               (add-text-properties               (add-text-properties
284                (line-beginning-position) (1+ (line-beginning-position))                (line-beginning-position) (1+ (line-beginning-position))
285                `(mh-folder ,folder-name                `(mh-folder ,folder-name
# Line 309  The otional ARGS are ignored and there f Line 310  The otional ARGS are ignored and there f
310               (setq start-region (point))               (setq start-region (point))
311               (while (and (get-text-property (point) 'mh-level)               (while (and (get-text-property (point) 'mh-level)
312                           (> (get-text-property (point) 'mh-level) level))                           (> (get-text-property (point) 'mh-level) level))
313                 (remhash (get-text-property (point) 'mh-folder)                 (let ((folder (get-text-property (point) 'mh-folder)))
314                          mh-speed-folder-map)                   (when (gethash folder mh-speed-folder-map)
315                       (set-marker (gethash folder mh-speed-folder-map) nil)
316                       (remhash folder mh-speed-folder-map)))
317                 (forward-line))                 (forward-line))
318               (delete-region start-region (point))               (delete-region start-region (point))
319               (forward-line -1)               (forward-line -1)
# Line 344  Optional ARGS are ignored." Line 347  Optional ARGS are ignored."
347         (delete-other-windows)))))         (delete-other-windows)))))
348    
349  (defvar mh-speed-current-folder nil)  (defvar mh-speed-current-folder nil)
350    (defvar mh-speed-flists-folder nil)
351    
352  ;;;###mh-autoload  ;;;###mh-autoload
353  (defun mh-speed-flists (force)  (defun mh-speed-flists (force &optional folder)
354    "Execute flists -recurse and update message counts.    "Execute flists -recurse and update message counts.
355  If FORCE is non-nil the timer is reset."  If FORCE is non-nil the timer is reset. If FOLDER is non-nil then flists is run
356    only for that one folder."
357    (interactive (list t))    (interactive (list t))
358    (when force    (when force
359      (when (timerp mh-speed-flists-timer)      (when mh-speed-flists-timer
360        (cancel-timer mh-speed-flists-timer))        (cancel-timer mh-speed-flists-timer)
361      (setq mh-speed-flists-timer nil)        (setq mh-speed-flists-timer nil))
362      (when (and (processp mh-speed-flists-process)      (when (and (processp mh-speed-flists-process)
363                 (not (eq (process-status mh-speed-flists-process) 'exit)))                 (not (eq (process-status mh-speed-flists-process) 'exit)))
364          (set-process-filter mh-speed-flists-process t)
365        (kill-process mh-speed-flists-process)        (kill-process mh-speed-flists-process)
366          (setq mh-speed-partial-line "")
367        (setq mh-speed-flists-process nil)))        (setq mh-speed-flists-process nil)))
368      (setq mh-speed-flists-folder folder)
369    (unless mh-speed-flists-timer    (unless mh-speed-flists-timer
370      (setq mh-speed-flists-timer      (setq mh-speed-flists-timer
371            (run-at-time            (run-at-time
372             nil mh-speed-flists-interval             nil (and mh-speed-run-flists-flag mh-speed-flists-interval)
373             (lambda ()             (lambda ()
374               (unless (and (processp mh-speed-flists-process)               (unless (and (processp mh-speed-flists-process)
375                            (not (eq (process-status mh-speed-flists-process)                            (not (eq (process-status mh-speed-flists-process)
# Line 376  If FORCE is non-nil the timer is reset." Line 384  If FORCE is non-nil the timer is reset."
384                 (setq mh-speed-flists-process                 (setq mh-speed-flists-process
385                       (start-process "*flists*" nil                       (start-process "*flists*" nil
386                                      (expand-file-name "flists" mh-progs)                                      (expand-file-name "flists" mh-progs)
387                                      "-recurse"                                      (or mh-speed-flists-folder "-recurse")
388                                        (if mh-speed-flists-folder "-noall" "-all")
389                                      "-sequence" (symbol-name mh-unseen-seq)))                                      "-sequence" (symbol-name mh-unseen-seq)))
390                   ;; Run flists on all folders the next time around...
391                   (setq mh-speed-flists-folder nil)
392                 (set-process-filter mh-speed-flists-process                 (set-process-filter mh-speed-flists-process
393                                     'mh-speed-parse-flists-output)))))))                                     'mh-speed-parse-flists-output)))))))
394    
# Line 397  next." Line 408  next."
408                  mh-speed-partial-line "")                  mh-speed-partial-line "")
409            (multiple-value-setq (folder unseen total)            (multiple-value-setq (folder unseen total)
410              (mh-parse-flist-output-line line mh-speed-current-folder))              (mh-parse-flist-output-line line mh-speed-current-folder))
411            (when (and folder unseen total)            (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)))))
415              (setf (gethash folder mh-speed-flists-cache) (cons unseen total))              (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
416              (save-excursion              (save-excursion
417                (when (buffer-live-p (get-buffer speedbar-buffer))                (when (buffer-live-p (get-buffer speedbar-buffer))
# Line 514  The function invalidates the latest ance Line 528  The function invalidates the latest ance
528            (insert-char char 1 t)            (insert-char char 1 t)
529            (put-text-property (point) (1- (point)) 'invisible nil)            (put-text-property (point) (1- (point)) 'invisible nil)
530            ;; make sure we fix the image on the text here.            ;; make sure we fix the image on the text here.
531            (speedbar-insert-image-button-maybe (- (point) 2) 3)))))            (mh-funcall-if-exists
532               speedbar-insert-image-button-maybe (- (point) 2) 3)))))
533    
534  (provide 'mh-speed)  (provide 'mh-speed)
535    
# Line 523  The function invalidates the latest ance Line 538  The function invalidates the latest ance
538  ;;; sentence-end-double-space: nil  ;;; sentence-end-double-space: nil
539  ;;; End:  ;;; End:
540    
541    ;;; arch-tag: d38ddcd4-3c00-4e37-99bf-8b89dda7b32c
542  ;;; mh-speed.el ends here  ;;; mh-speed.el ends here

Legend:
Removed from v.1.2.4.1  
changed lines
  Added in v.1.2.4.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26