/[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.1 by wohler, Sun Jan 26 02:38:37 2003 UTC revision 1.2 by wohler, Mon Feb 3 20:55:30 2003 UTC
# Line 44  Line 44 
44  (defvar mh-speed-refresh-flag nil)  (defvar mh-speed-refresh-flag nil)
45  (defvar mh-speed-last-selected-folder nil)  (defvar mh-speed-last-selected-folder nil)
46  (defvar mh-speed-folder-map (make-hash-table :test #'equal))  (defvar mh-speed-folder-map (make-hash-table :test #'equal))
 (defvar mh-speed-folders-cache (make-hash-table :test #'equal))  
47  (defvar mh-speed-flists-cache (make-hash-table :test #'equal))  (defvar mh-speed-flists-cache (make-hash-table :test #'equal))
48  (defvar mh-speed-flists-process nil)  (defvar mh-speed-flists-process nil)
49  (defvar mh-speed-flists-timer nil)  (defvar mh-speed-flists-timer nil)
# Line 256  Do the right thing for the different kin Line 255  Do the right thing for the different kin
255    
256  (defun mh-speed-add-buttons (folder level)  (defun mh-speed-add-buttons (folder level)
257    "Add speedbar button for FOLDER which is at indented by LEVEL amount."    "Add speedbar button for FOLDER which is at indented by LEVEL amount."
258    (let ((folder-list (mh-speed-folders folder)))    (let ((folder-list (mh-sub-folders folder)))
259      (mapc      (mapc
260       (lambda (f)       (lambda (f)
261         (let* ((folder-name (format "%s%s%s" (or folder "+")         (let* ((folder-name (format "%s%s%s" (or folder "+")
# Line 344  Optional ARGS are ignored." Line 343  Optional ARGS are ignored."
343         (mh-visit-folder folder range)         (mh-visit-folder folder range)
344         (delete-other-windows)))))         (delete-other-windows)))))
345    
346  (defun mh-speed-folders (folder)  (defvar mh-speed-current-folder nil)
   "Find the subfolders of FOLDER.  
 The function avoids running folders unnecessarily by caching the results of  
 the actual folders call."  
   (let ((match (gethash folder mh-speed-folders-cache 'no-result)))  
     (cond ((eq match 'no-result)  
            (setf (gethash folder mh-speed-folders-cache)  
                  (mh-speed-folders-actual folder)))  
           (t match))))  
   
 (defun mh-speed-folders-actual (folder)  
   "Execute the command folders to return the sub-folders of FOLDER.  
 Filters out the folder names that start with \".\" so that directories that  
 aren't usually mail folders are hidden."  
   (let* ((folder (cond ((and (stringp folder)  
                              (equal (substring folder 0 1) "+"))  
                         folder)  
                        (t nil)))  
          (arg-list `(,(expand-file-name "folders" mh-progs)  
                      nil (t nil) nil "-noheader" "-norecurse"  
                      ,@(if (stringp folder) (list folder) ())))  
          (results ()))  
     (with-temp-buffer  
       (apply #'call-process arg-list)  
       (goto-char (point-min))  
       (while (not (and (eolp) (bolp)))  
         (goto-char (line-end-position))  
         (let ((has-pos (search-backward " has " (line-beginning-position) t)))  
           (when (integerp has-pos)  
             (while (or (equal (char-after has-pos) ? )  
                        (equal (char-after has-pos) ?+))  
               (decf has-pos))  
             (incf has-pos)  
             (let ((name (buffer-substring (line-beginning-position) has-pos)))  
               (let ((first-char (substring name 0 1)))  
                 (unless (or (string-equal first-char ".")  
                             (string-equal first-char "#")  
                             (string-equal first-char ","))  
                   (push  
                    (cons name  
                          (search-forward "(others)" (line-end-position) t))  
                    results)))))  
           (forward-line 1))))  
     (setq results (nreverse results))  
     (when (stringp folder)  
       (setq results (cdr results))  
       (let ((folder-name-len (length (format "%s/" (substring folder 1)))))  
         (setq results (mapcar (lambda (f)  
                                 (cons (substring (car f) folder-name-len)  
                                       (cdr f)))  
                               results))))  
     results))  
347    
348  ;;;###mh-autoload  ;;;###mh-autoload
349  (defun mh-speed-flists (force)  (defun mh-speed-flists (force)
# Line 418  If FORCE is non-nil the timer is reset." Line 366  If FORCE is non-nil the timer is reset."
366               (unless (and (processp mh-speed-flists-process)               (unless (and (processp mh-speed-flists-process)
367                            (not (eq (process-status mh-speed-flists-process)                            (not (eq (process-status mh-speed-flists-process)
368                                     'exit)))                                     'exit)))
369                   (setq mh-speed-current-folder
370                         (concat
371                          (with-temp-buffer
372                            (call-process (expand-file-name "folder" mh-progs)
373                                          nil '(t nil) nil "-fast")
374                            (buffer-substring (point-min) (1- (point-max))))
375                          "+"))
376                 (setq mh-speed-flists-process                 (setq mh-speed-flists-process
377                       (start-process (expand-file-name "flists" mh-progs) nil                       (start-process "*flists*" nil
378                                      "flists" "-recurse"                                      (expand-file-name "flists" mh-progs)
379                                        "-recurse"
380                                      "-sequence" (symbol-name mh-unseen-seq)))                                      "-sequence" (symbol-name mh-unseen-seq)))
381                 (set-process-filter mh-speed-flists-process                 (set-process-filter mh-speed-flists-process
382                                     'mh-speed-parse-flists-output)))))))                                     'mh-speed-parse-flists-output)))))))
# Line 440  next." Line 396  next."
396                               (substring output position line-end))                               (substring output position line-end))
397                  mh-speed-partial-line "")                  mh-speed-partial-line "")
398            (multiple-value-setq (folder unseen total)            (multiple-value-setq (folder unseen total)
399              (mh-parse-flist-output-line line))              (mh-parse-flist-output-line line mh-speed-current-folder))
400            (when (and folder unseen total)            (when (and folder unseen total)
401              (setf (gethash folder mh-speed-flists-cache) (cons unseen total))              (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
402              (save-excursion              (save-excursion
# Line 489  next." Line 445  next."
445             (parent (if last-slash (substring folder 0 last-slash) nil))             (parent (if last-slash (substring folder 0 last-slash) nil))
446             (parent-position (gethash parent mh-speed-folder-map))             (parent-position (gethash parent mh-speed-folder-map))
447             (parent-change nil))             (parent-change nil))
       (remhash parent mh-speed-folders-cache)  
       (remhash folder mh-speed-folders-cache)  
448        (when parent-position        (when parent-position
449          (let ((parent-kids (mh-speed-folders parent)))          (let ((parent-kids (mh-sub-folders parent)))
450            (cond ((null parent-kids)            (cond ((null parent-kids)
451                   (setq parent-change ?+))                   (setq parent-change ?+))
452                  ((and (null (cdr parent-kids))                  ((and (null (cdr parent-kids))
# Line 517  next." Line 471  next."
471            (setq mh-speed-last-selected-folder nil)            (setq mh-speed-last-selected-folder nil)
472            (setq mh-speed-refresh-flag t)))            (setq mh-speed-refresh-flag t)))
473        (when (equal folder "")        (when (equal folder "")
474          (clrhash mh-speed-folders-cache)))))          (clrhash mh-sub-folders-cache)))))
475    
476  ;;;###mh-autoload  ;;;###mh-autoload
477  (defun mh-speed-add-folder (folder)  (defun mh-speed-add-folder (folder)
# Line 545  The function invalidates the latest ance Line 499  The function invalidates the latest ance
499           `(mh-children-p t)))           `(mh-children-p t)))
500        (when (get-text-property (line-beginning-position) 'mh-expanded)        (when (get-text-property (line-beginning-position) 'mh-expanded)
501          (mh-speed-toggle))          (mh-speed-toggle))
       (remhash ancestor mh-speed-folders-cache)  
502        (setq mh-speed-refresh-flag t))))        (setq mh-speed-refresh-flag t))))
503    
504  ;; Make it slightly more general to allow for [ ] buttons to be changed to  ;; Make it slightly more general to allow for [ ] buttons to be changed to

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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