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) |
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 "+") |
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) |
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))))))) |
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 |
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)) |
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) |
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 |