Mercurial > emacs

comparison lisp/mh-e/mh-speed.el @ 49578:b35587af8747

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgraded to MH-E version 7.2. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
author Bill Wohler <wohler@newt.com>
date Mon, 03 Feb 2003 20:55:30 +0000
parents 06b77df47802
children 7dd3d5eae9c7 d7ddb3e565de
comparison
equal deleted inserted replaced
49577:dad6f3184ccd 49578:b35587af8747
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.2 2003/01/08 23:21:16 wohler Exp $ 34 ;; $Id: mh-speed.el,v 1.37 2003/01/31 03:18:18 satyaki Exp $
35 35
36 ;;; Code: 36 ;;; Code:
37 37
38 ;; Requires 38 ;; Requires
39 (require 'cl) 39 (require 'cl)
42 42
43 ;; Global variables 43 ;; Global variables
44 (defvar mh-speed-refresh-flag nil) 44 (defvar mh-speed-refresh-flag nil)
45 (defvar mh-speed-last-selected-folder nil) 45 (defvar mh-speed-last-selected-folder nil)
46 (defvar mh-speed-folder-map (make-hash-table :test #'equal)) 46 (defvar mh-speed-folder-map (make-hash-table :test #'equal))
47 (defvar mh-speed-folders-cache (make-hash-table :test #'equal))
48 (defvar mh-speed-flists-cache (make-hash-table :test #'equal)) 47 (defvar mh-speed-flists-cache (make-hash-table :test #'equal))
49 (defvar mh-speed-flists-process nil) 48 (defvar mh-speed-flists-process nil)
50 (defvar mh-speed-flists-timer nil) 49 (defvar mh-speed-flists-timer nil)
51 (defvar mh-speed-partial-line "") 50 (defvar mh-speed-partial-line "")
52 51
254 (when directory-end 253 (when directory-end
255 (format "+%s" (substring rel-path 0 directory-end))))))))) 254 (format "+%s" (substring rel-path 0 directory-end)))))))))
256 255
257 (defun mh-speed-add-buttons (folder level) 256 (defun mh-speed-add-buttons (folder level)
258 "Add speedbar button for FOLDER which is at indented by LEVEL amount." 257 "Add speedbar button for FOLDER which is at indented by LEVEL amount."
259 (let ((folder-list (mh-speed-folders folder))) 258 (let ((folder-list (mh-sub-folders folder)))
260 (mapc 259 (mapc
261 (lambda (f) 260 (lambda (f)
262 (let* ((folder-name (format "%s%s%s" (or folder "+") 261 (let* ((folder-name (format "%s%s%s" (or folder "+")
263 (if folder "/" "") (car f))) 262 (if folder "/" "") (car f)))
264 (counts (gethash folder-name mh-speed-flists-cache))) 263 (counts (gethash folder-name mh-speed-flists-cache)))
342 (when (stringp folder) 341 (when (stringp folder)
343 (speedbar-with-attached-buffer 342 (speedbar-with-attached-buffer
344 (mh-visit-folder folder range) 343 (mh-visit-folder folder range)
345 (delete-other-windows))))) 344 (delete-other-windows)))))
346 345
347 (defun mh-speed-folders (folder) 346 (defvar mh-speed-current-folder nil)
348 "Find the subfolders of FOLDER.
349 The function avoids running folders unnecessarily by caching the results of
350 the actual folders call."
351 (let ((match (gethash folder mh-speed-folders-cache 'no-result)))
352 (cond ((eq match 'no-result)
353 (setf (gethash folder mh-speed-folders-cache)
354 (mh-speed-folders-actual folder)))
355 (t match))))
356
357 (defun mh-speed-folders-actual (folder)
358 "Execute the command folders to return the sub-folders of FOLDER.
359 Filters out the folder names that start with \".\" so that directories that
360 aren't usually mail folders are hidden."
361 (let* ((folder (cond ((and (stringp folder)
362 (equal (substring folder 0 1) "+"))
363 folder)
364 (t nil)))
365 (arg-list `(,(expand-file-name "folders" mh-progs)
366 nil (t nil) nil "-noheader" "-norecurse"
367 ,@(if (stringp folder) (list folder) ())))
368 (results ()))
369 (with-temp-buffer
370 (apply #'call-process arg-list)
371 (goto-char (point-min))
372 (while (not (and (eolp) (bolp)))
373 (goto-char (line-end-position))
374 (let ((has-pos (search-backward " has " (line-beginning-position) t)))
375 (when (integerp has-pos)
376 (while (or (equal (char-after has-pos) ? )
377 (equal (char-after has-pos) ?+))
378 (decf has-pos))
379 (incf has-pos)
380 (let ((name (buffer-substring (line-beginning-position) has-pos)))
381 (let ((first-char (substring name 0 1)))
382 (unless (or (string-equal first-char ".")
383 (string-equal first-char "#")
384 (string-equal first-char ","))
385 (push
386 (cons name
387 (search-forward "(others)" (line-end-position) t))
388 results)))))
389 (forward-line 1))))
390 (setq results (nreverse results))
391 (when (stringp folder)
392 (setq results (cdr results))
393 (let ((folder-name-len (length (format "%s/" (substring folder 1)))))
394 (setq results (mapcar (lambda (f)
395 (cons (substring (car f) folder-name-len)
396 (cdr f)))
397 results))))
398 results))
399 347
400 ;;;###mh-autoload 348 ;;;###mh-autoload
401 (defun mh-speed-flists (force) 349 (defun mh-speed-flists (force)
402 "Execute flists -recurse and update message counts. 350 "Execute flists -recurse and update message counts.
403 If FORCE is non-nil the timer is reset." 351 If FORCE is non-nil the timer is reset."
416 nil mh-speed-flists-interval 364 nil mh-speed-flists-interval
417 (lambda () 365 (lambda ()
418 (unless (and (processp mh-speed-flists-process) 366 (unless (and (processp mh-speed-flists-process)
419 (not (eq (process-status mh-speed-flists-process) 367 (not (eq (process-status mh-speed-flists-process)
420 'exit))) 368 '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 "+"))
421 (setq mh-speed-flists-process 376 (setq mh-speed-flists-process
422 (start-process (expand-file-name "flists" mh-progs) nil 377 (start-process "*flists*" nil
423 "flists" "-recurse" 378 (expand-file-name "flists" mh-progs)
379 "-recurse"
424 "-sequence" (symbol-name mh-unseen-seq))) 380 "-sequence" (symbol-name mh-unseen-seq)))
425 (set-process-filter mh-speed-flists-process 381 (set-process-filter mh-speed-flists-process
426 'mh-speed-parse-flists-output))))))) 382 'mh-speed-parse-flists-output)))))))
427 383
428 ;; Copied from mh-make-folder-list-filter... 384 ;; Copied from mh-make-folder-list-filter...
438 (setq line (format "%s%s" 394 (setq line (format "%s%s"
439 mh-speed-partial-line 395 mh-speed-partial-line
440 (substring output position line-end)) 396 (substring output position line-end))
441 mh-speed-partial-line "") 397 mh-speed-partial-line "")
442 (multiple-value-setq (folder unseen total) 398 (multiple-value-setq (folder unseen total)
443 (mh-parse-flist-output-line line)) 399 (mh-parse-flist-output-line line mh-speed-current-folder))
444 (when (and folder unseen total) 400 (when (and folder unseen total)
445 (setf (gethash folder mh-speed-flists-cache) (cons unseen total)) 401 (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
446 (save-excursion 402 (save-excursion
447 (when (buffer-live-p (get-buffer speedbar-buffer)) 403 (when (buffer-live-p (get-buffer speedbar-buffer))
448 (set-buffer speedbar-buffer) 404 (set-buffer speedbar-buffer)
487 (let* ((speedbar-update-flag nil) 443 (let* ((speedbar-update-flag nil)
488 (last-slash (mh-search-from-end ?/ folder)) 444 (last-slash (mh-search-from-end ?/ folder))
489 (parent (if last-slash (substring folder 0 last-slash) nil)) 445 (parent (if last-slash (substring folder 0 last-slash) nil))
490 (parent-position (gethash parent mh-speed-folder-map)) 446 (parent-position (gethash parent mh-speed-folder-map))
491 (parent-change nil)) 447 (parent-change nil))
492 (remhash parent mh-speed-folders-cache)
493 (remhash folder mh-speed-folders-cache)
494 (when parent-position 448 (when parent-position
495 (let ((parent-kids (mh-speed-folders parent))) 449 (let ((parent-kids (mh-sub-folders parent)))
496 (cond ((null parent-kids) 450 (cond ((null parent-kids)
497 (setq parent-change ?+)) 451 (setq parent-change ?+))
498 ((and (null (cdr parent-kids)) 452 ((and (null (cdr parent-kids))
499 (equal (if last-slash 453 (equal (if last-slash
500 (substring folder (1+ last-slash)) 454 (substring folder (1+ last-slash))
515 (mh-speed-highlight mh-speed-last-selected-folder 469 (mh-speed-highlight mh-speed-last-selected-folder
516 'mh-speedbar-folder-face) 470 'mh-speedbar-folder-face)
517 (setq mh-speed-last-selected-folder nil) 471 (setq mh-speed-last-selected-folder nil)
518 (setq mh-speed-refresh-flag t))) 472 (setq mh-speed-refresh-flag t)))
519 (when (equal folder "") 473 (when (equal folder "")
520 (clrhash mh-speed-folders-cache))))) 474 (clrhash mh-sub-folders-cache)))))
521 475
522 ;;;###mh-autoload 476 ;;;###mh-autoload
523 (defun mh-speed-add-folder (folder) 477 (defun mh-speed-add-folder (folder)
524 "Add FOLDER since it is being created. 478 "Add FOLDER since it is being created.
525 The function invalidates the latest ancestor that is present." 479 The function invalidates the latest ancestor that is present."
543 (add-text-properties 497 (add-text-properties
544 (line-beginning-position) (1+ (line-beginning-position)) 498 (line-beginning-position) (1+ (line-beginning-position))
545 `(mh-children-p t))) 499 `(mh-children-p t)))
546 (when (get-text-property (line-beginning-position) 'mh-expanded) 500 (when (get-text-property (line-beginning-position) 'mh-expanded)
547 (mh-speed-toggle)) 501 (mh-speed-toggle))
548 (remhash ancestor mh-speed-folders-cache)
549 (setq mh-speed-refresh-flag t)))) 502 (setq mh-speed-refresh-flag t))))
550 503
551 ;; Make it slightly more general to allow for [ ] buttons to be changed to 504 ;; Make it slightly more general to allow for [ ] buttons to be changed to
552 ;; [+]. 505 ;; [+].
553 (defun mh-speedbar-change-expand-button-char (char) 506 (defun mh-speedbar-change-expand-button-char (char)