lisp/mh-e/mh-speed.el

   1 ;;; mh-speed.el --- MH-E speedbar support
   2
   3 ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
   6 ;; Maintainer: Bill Wohler <wohler@newt.com>
   7 ;; Keywords: mail
   8 ;; See: mh-e.el
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Future versions should only use flists.
  28
  29 ;;; Change Log:
  30
  31 ;;; Code:
  32
  33 (require 'mh-e)
  34 (mh-require-cl)
  35
  36 (require 'gnus-util)
  37 (require 'speedbar)
  38 (require 'timer)
  39
  40 ;; Global variables.
  41 (defvar mh-speed-refresh-flag nil)
  42 (defvar mh-speed-last-selected-folder nil)
  43 (defvar mh-speed-folder-map (make-hash-table :test #'equal))
  44 (defvar mh-speed-flists-cache (make-hash-table :test #'equal))
  45 (defvar mh-speed-flists-process nil)
  46 (defvar mh-speed-flists-timer nil)
  47 (defvar mh-speed-partial-line "")
  48
  49 \f
  50
  51 ;;; Speedbar Hook
  52
  53 (unless (member 'mh-speed-stealth-update
  54                 (cdr (assoc "files" speedbar-stealthy-function-list)))
  55   ;; Is changing constant lists in elisp safe?
  56   (setq speedbar-stealthy-function-list
  57         (copy-tree speedbar-stealthy-function-list))
  58   (push 'mh-speed-stealth-update
  59         (cdr (assoc "files" speedbar-stealthy-function-list))))
  60
  61 \f
  62
  63 ;;; Speedbar Menus
  64
  65 (defvar mh-folder-speedbar-menu-items
  66   '("--"
  67     ["Visit Folder" mh-speed-view
  68      (with-current-buffer speedbar-buffer
  69        (get-text-property (mh-line-beginning-position) 'mh-folder))]
  70     ["Expand Nested Folders" mh-speed-expand-folder
  71      (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
  72           (not (get-text-property (mh-line-beginning-position) 'mh-expanded)))]
  73     ["Contract Nested Folders" mh-speed-contract-folder
  74      (and (get-text-property (mh-line-beginning-position) 'mh-children-p)
  75           (get-text-property (mh-line-beginning-position) 'mh-expanded))]
  76     ["Refresh Speedbar" mh-speed-refresh t])
  77   "Extra menu items for speedbar.")
  78
  79 (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
  80 (defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
  81
  82 \f
  83
  84 ;;; Speedbar Keys
  85
  86 (defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
  87   "Specialized speedbar keymap for MH-E buffers.")
  88
  89 (gnus-define-keys mh-folder-speedbar-key-map
  90   "+"           mh-speed-expand-folder
  91   "-"           mh-speed-contract-folder
  92   "\r"          mh-speed-view
  93   "r"           mh-speed-refresh)
  94
  95 (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
  96 (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
  97
  98 \f
  99
 100 ;;; Speedbar Commands
 101
 102 ;; Alphabetical.
 103
 104 (defalias 'mh-speed-contract-folder 'mh-speed-toggle)
 105
 106 (defalias 'mh-speed-expand-folder 'mh-speed-toggle)
 107
 108 (defun mh-speed-refresh ()
 109   "Regenerates the list of folders in the speedbar.
 110
 111 Run this command if you've added or deleted a folder, or want to
 112 update the unseen message count before the next automatic
 113 update."
 114   (interactive)
 115   (mh-speed-flists t)
 116   (mh-speed-invalidate-map ""))
 117
 118 (defun mh-speed-stealth-update (&optional force)
 119   "Do stealth update.
 120 With non-nil FORCE, the update is always carried out."
 121   (cond ((with-current-buffer speedbar-buffer
 122            (get-text-property (point-min) 'mh-level))
 123          ;; Execute this hook and *don't* run anything else
 124          (mh-speed-update-current-folder force)
 125          nil)
 126         ;; Otherwise on to your regular programming
 127         (t t)))
 128
 129 (defun mh-speed-toggle (&rest ignored)
 130   "Toggle the display of child folders in the speedbar.
 131 The optional arguments from speedbar are IGNORED."
 132   (interactive)
 133   (declare (ignore args))
 134   (beginning-of-line)
 135   (let ((parent (get-text-property (point) 'mh-folder))
 136         (kids-p (get-text-property (point) 'mh-children-p))
 137         (expanded (get-text-property (point) 'mh-expanded))
 138         (level (get-text-property (point) 'mh-level))
 139         (point (point))
 140         start-region)
 141     (speedbar-with-writable
 142       (cond ((not kids-p) nil)
 143             (expanded
 144              (forward-line)
 145              (setq start-region (point))
 146              (while (and (get-text-property (point) 'mh-level)
 147                          (> (get-text-property (point) 'mh-level) level))
 148                (let ((folder (get-text-property (point) 'mh-folder)))
 149                  (when (gethash folder mh-speed-folder-map)
 150                    (set-marker (gethash folder mh-speed-folder-map) nil)
 151                    (remhash folder mh-speed-folder-map)))
 152                (forward-line))
 153              (delete-region start-region (point))
 154              (forward-line -1)
 155              (speedbar-change-expand-button-char ?+)
 156              (add-text-properties
 157               (mh-line-beginning-position) (1+ (line-beginning-position))
 158               '(mh-expanded nil)))
 159             (t
 160              (forward-line)
 161              (mh-speed-add-buttons parent (1+ level))
 162              (goto-char point)
 163              (speedbar-change-expand-button-char ?-)
 164              (add-text-properties
 165               (mh-line-beginning-position) (1+ (line-beginning-position))
 166               `(mh-expanded t)))))))
 167
 168 (defun mh-speed-view (&rest ignored)
 169   "Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
 170 The optional arguments from speedbar are IGNORED."
 171   (interactive)
 172   (declare (ignore args))
 173   (let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
 174          (range (and (stringp folder)
 175                      (mh-read-range "Scan" folder t nil nil
 176                                     mh-interpret-number-as-range-flag))))
 177     (when (stringp folder)
 178       (dframe-with-attached-buffer
 179        (mh-visit-folder folder range)
 180        (delete-other-windows)))))
 181
 182 \f
 183
 184 ;;; Support Routines
 185
 186 ;;;###mh-autoload
 187 (defun mh-folder-speedbar-buttons (buffer)
 188   "Interface function to create MH-E speedbar buffer.
 189 BUFFER is the MH-E buffer for which the speedbar buffer is to be
 190 created."
 191   (unless (get-text-property (point-min) 'mh-level)
 192     (erase-buffer)
 193     (clrhash mh-speed-folder-map)
 194     (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
 195                             'mh-speedbar-folder 0)
 196     (forward-line -1)
 197     (setf (gethash nil mh-speed-folder-map)
 198           (set-marker (or (gethash nil mh-speed-folder-map) (make-marker))
 199                       (1+ (mh-line-beginning-position))))
 200     (add-text-properties
 201      (mh-line-beginning-position) (1+ (line-beginning-position))
 202      `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
 203     (mh-speed-stealth-update t)
 204     (when (> mh-speed-update-interval 0)
 205       (mh-speed-flists nil))))
 206
 207 ;;;###mh-autoload
 208 (defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
 209 ;;;###mh-autoload
 210 (defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
 211
 212 (defmacro mh-speed-select-attached-frame ()
 213   "Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
 214   (cond ((fboundp 'dframe-select-attached-frame)
 215          '(dframe-select-attached-frame speedbar-frame))
 216         ((boundp 'speedbar-attached-frame)
 217          '(select-frame speedbar-attached-frame))
 218         (t (error "Installed speedbar version not supported by MH-E"))))
 219
 220 (defun mh-speed-update-current-folder (force)
 221   "Update speedbar highlighting of the current folder.
 222 The function tries to be smart so that work done is minimized.
 223 The currently highlighted folder is cached and no highlighting
 224 happens unless it changes.
 225 Also highlighting is suspended while the speedbar frame is selected.
 226 Otherwise you get the disconcerting behavior of folders popping open
 227 on their own when you are trying to navigate around in the speedbar
 228 buffer.
 229
 230 The update is always carried out if FORCE is non-nil."
 231   (let* ((lastf (selected-frame))
 232          (newcf (save-excursion
 233                   (mh-speed-select-attached-frame)
 234                   (prog1 (mh-speed-extract-folder-name (buffer-name))
 235                     (select-frame lastf))))
 236          (lastb (current-buffer))
 237          (case-fold-search t))
 238     (when (or force
 239               (and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
 240               (and (stringp newcf)
 241                    (equal (substring newcf 0 1) "+")
 242                    (not (equal newcf mh-speed-last-selected-folder))))
 243       (setq mh-speed-refresh-flag nil)
 244       (select-frame speedbar-frame)
 245       (set-buffer speedbar-buffer)
 246
 247       ;; Remove highlight from previous match...
 248       (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder)
 249
 250       ;; If we found a match highlight it...
 251       (when (mh-speed-goto-folder newcf)
 252         (mh-speed-highlight newcf 'mh-speedbar-selected-folder))
 253
 254       (setq mh-speed-last-selected-folder newcf)
 255       (speedbar-position-cursor-on-line)
 256       (set-window-point (frame-first-window speedbar-frame) (point))
 257       (set-buffer lastb)
 258       (select-frame lastf))
 259     (when (eq lastf speedbar-frame)
 260       (setq mh-speed-refresh-flag t))))
 261
 262 (defun mh-speed-highlight (folder face)
 263   "Set FOLDER to FACE."
 264   (save-excursion
 265     (speedbar-with-writable
 266       (goto-char (gethash folder mh-speed-folder-map (point)))
 267       (beginning-of-line)
 268       (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (mh-line-end-position) t)
 269           (setq face (mh-speed-bold-face face))
 270         (setq face (mh-speed-normal-face face)))
 271       (beginning-of-line)
 272       (when (re-search-forward "\\[.\\] " (mh-line-end-position) t)
 273         (put-text-property (point) (mh-line-end-position) 'face face)))))
 274
 275 (defun mh-speed-normal-face (face)
 276   "Return normal face for given FACE."
 277   (cond ((eq face 'mh-speedbar-folder-with-unseen-messages)
 278          'mh-speedbar-folder)
 279         ((eq face 'mh-speedbar-selected-folder-with-unseen-messages)
 280          'mh-speedbar-selected-folder)
 281         (t face)))
 282
 283 (defun mh-speed-bold-face (face)
 284   "Return bold face for given FACE."
 285   (cond ((eq face 'mh-speedbar-folder)
 286          'mh-speedbar-folder-with-unseen-messages)
 287         ((eq face 'mh-speedbar-selected-folder)
 288          'mh-speedbar-selected-folder-with-unseen-messages)
 289         (t face)))
 290
 291 (defun mh-speed-goto-folder (folder)
 292   "Move point to line containing FOLDER.
 293 The function will expand out parent folders of FOLDER if needed."
 294   (let ((prefix folder)
 295         (suffix-list ())
 296         (last-slash t))
 297     (while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
 298       (setq last-slash (mh-search-from-end ?/ prefix))
 299       (when (integerp last-slash)
 300         (push (substring prefix (1+ last-slash)) suffix-list)
 301         (setq prefix (substring prefix 0 last-slash))))
 302     (let ((prefix-position (gethash prefix mh-speed-folder-map)))
 303       (if prefix-position
 304           (goto-char prefix-position)
 305         (goto-char (point-min))
 306         (mh-speed-toggle)
 307         (unless (get-text-property (point) 'mh-expanded)
 308           (mh-speed-toggle))
 309         (goto-char (gethash prefix mh-speed-folder-map))))
 310     (while suffix-list
 311       ;; We always need atleast one toggle. We need two if the directory list
 312       ;; is stale since a folder was added.
 313       (when (equal prefix (get-text-property (mh-line-beginning-position)
 314                                              'mh-folder))
 315         (mh-speed-toggle)
 316         (unless (get-text-property (point) 'mh-expanded)
 317           (mh-speed-toggle)))
 318       (setq prefix (format "%s/%s" prefix (pop suffix-list)))
 319       (goto-char (gethash prefix mh-speed-folder-map (point))))
 320     (beginning-of-line)
 321     (equal folder (get-text-property (point) 'mh-folder))))
 322
 323 (defun mh-speed-extract-folder-name (buffer)
 324   "Given an MH-E BUFFER find the folder that should be highlighted.
 325 Do the right thing for the different kinds of buffers that MH-E
 326 uses."
 327   (with-current-buffer buffer
 328     (cond ((eq major-mode 'mh-folder-mode)
 329            mh-current-folder)
 330           ((eq major-mode 'mh-show-mode)
 331            (set-buffer mh-show-folder-buffer)
 332            mh-current-folder)
 333           ((eq major-mode 'mh-letter-mode)
 334            (when (string-match mh-user-path buffer-file-name)
 335              (let* ((rel-path (substring buffer-file-name (match-end 0)))
 336                     (directory-end (mh-search-from-end ?/ rel-path)))
 337                (when directory-end
 338                  (format "+%s" (substring rel-path 0 directory-end)))))))))
 339
 340 (defun mh-speed-add-buttons (folder level)
 341   "Add speedbar button for FOLDER which is at indented by LEVEL amount."
 342   (let ((folder-list (mh-sub-folders folder)))
 343     (mapc
 344      (lambda (f)
 345        (let* ((folder-name (format "%s%s%s" (or folder "+")
 346                                    (if folder "/" "") (car f)))
 347               (counts (gethash folder-name mh-speed-flists-cache)))
 348          (speedbar-with-writable
 349            (speedbar-make-tag-line
 350             'bracket (if (cdr f) ?+ ? )
 351             'mh-speed-toggle nil
 352             (format "%s%s"
 353                     (car f)
 354                     (if counts
 355                         (format " (%s/%s)" (car counts) (cdr counts))
 356                       ""))
 357             'mh-speed-view nil
 358             (if (and counts (> (car counts) 0))
 359                 'mh-speedbar-folder-with-unseen-messages
 360               'mh-speedbar-folder)
 361             level)
 362            (save-excursion
 363              (forward-line -1)
 364              (setf (gethash folder-name mh-speed-folder-map)
 365                    (set-marker (or (gethash folder-name mh-speed-folder-map)
 366                                    (make-marker))
 367                                (1+ (mh-line-beginning-position))))
 368              (add-text-properties
 369               (mh-line-beginning-position) (1+ (mh-line-beginning-position))
 370               `(mh-folder ,folder-name
 371                           mh-expanded nil
 372                           mh-children-p ,(not (not (cdr f)))
 373                           ,@(if counts `(mh-count
 374                                          (,(car counts) . ,(cdr counts))) ())
 375                           mh-level ,level))))))
 376      folder-list)))
 377
 378 (defvar mh-speed-current-folder nil)
 379 (defvar mh-speed-flists-folder nil)
 380
 381 (defmacro mh-process-kill-without-query (process)
 382   "PROCESS can be killed without query on Emacs exit.
 383 Avoid using `process-kill-without-query' if possible since it is
 384 now obsolete."
 385   (if (fboundp 'set-process-query-on-exit-flag)
 386       `(set-process-query-on-exit-flag ,process nil)
 387     `(process-kill-without-query ,process)))
 388
 389 ;;;###mh-autoload
 390 (defun mh-speed-flists (force &rest folders)
 391   "Execute flists -recurse and update message counts.
 392 If FORCE is non-nil the timer is reset.
 393
 394 Any number of optional FOLDERS can be specified. If specified,
 395 flists is run only for that one folder."
 396   (interactive (list t))
 397   (when force
 398     (when mh-speed-flists-timer
 399       (mh-cancel-timer mh-speed-flists-timer)
 400       (setq mh-speed-flists-timer nil))
 401     (when (and (processp mh-speed-flists-process)
 402                (not (eq (process-status mh-speed-flists-process) 'exit)))
 403       (set-process-filter mh-speed-flists-process t)
 404       (kill-process mh-speed-flists-process)
 405       (setq mh-speed-partial-line "")
 406       (setq mh-speed-flists-process nil)))
 407   (setq mh-speed-flists-folder folders)
 408   (unless mh-speed-flists-timer
 409     (setq mh-speed-flists-timer
 410           (run-at-time
 411            nil (if (> mh-speed-update-interval 0)
 412                    mh-speed-update-interval
 413                  nil)
 414            (lambda ()
 415              (unless (and (processp mh-speed-flists-process)
 416                           (not (eq (process-status mh-speed-flists-process)
 417                                    'exit)))
 418                (setq mh-speed-current-folder
 419                      (concat
 420                       (if mh-speed-flists-folder
 421                           (substring (car (reverse mh-speed-flists-folder)) 1)
 422                         (with-temp-buffer
 423                           (call-process (expand-file-name "folder" mh-progs)
 424                                         nil '(t nil) nil "-fast")
 425                           (buffer-substring (point-min) (1- (point-max)))))
 426                       "+"))
 427                (setq mh-speed-flists-process
 428                      (apply #'start-process "*flists*" nil
 429                             (expand-file-name "flists" mh-progs)
 430                             (if mh-speed-flists-folder "-noall" "-all")
 431                             "-sequence" (symbol-name mh-unseen-seq)
 432                             (or mh-speed-flists-folder '("-recurse"))))
 433                ;; Run flists on all folders the next time around...
 434                (setq mh-speed-flists-folder nil)
 435                (mh-process-kill-without-query mh-speed-flists-process)
 436                (set-process-filter mh-speed-flists-process
 437                                    'mh-speed-parse-flists-output)))))))
 438
 439 ;; Copied from mh-make-folder-list-filter...
 440 ;; XXX Refactor to use mh-make-folder-list-filer?
 441 (defun mh-speed-parse-flists-output (process output)
 442   "Parse the incremental results from flists.
 443 PROCESS is the flists process and OUTPUT is the results that must
 444 be handled next."
 445   (let ((prevailing-match-data (match-data))
 446         (position 0)
 447         line-end line folder unseen total)
 448     (unwind-protect
 449         (while (setq line-end (string-match "\n" output position))
 450           (setq line (format "%s%s"
 451                              mh-speed-partial-line
 452                              (substring output position line-end))
 453                 mh-speed-partial-line "")
 454           (multiple-value-setq (folder unseen total)
 455             (values-list
 456              (mh-parse-flist-output-line line mh-speed-current-folder)))
 457           (when (and folder unseen total
 458                      (let ((old-pair (gethash folder mh-speed-flists-cache)))
 459                        (or (not (equal (car old-pair) unseen))
 460                            (not (equal (cdr old-pair) total)))))
 461             (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
 462             (when (buffer-live-p (get-buffer speedbar-buffer))
 463               (with-current-buffer speedbar-buffer
 464                 (speedbar-with-writable
 465                   (when (get-text-property (point-min) 'mh-level)
 466                     (let ((pos (gethash folder mh-speed-folder-map))
 467                           face)
 468                       (when pos
 469                         (goto-char pos)
 470                         (goto-char (mh-line-beginning-position))
 471                         (cond
 472                          ((null (get-text-property (point) 'mh-count))
 473                           (goto-char (mh-line-end-position))
 474                           (setq face (get-text-property (1- (point)) 'face))
 475                           (insert (format " (%s/%s)" unseen total))
 476                           (mh-speed-highlight 'unknown face)
 477                           (goto-char (mh-line-beginning-position))
 478                           (add-text-properties (point) (1+ (point))
 479                                                `(mh-count (,unseen . ,total))))
 480                          ((not (equal (get-text-property (point) 'mh-count)
 481                                       (cons unseen total)))
 482                           (goto-char (mh-line-end-position))
 483                           (setq face (get-text-property (1- (point)) 'face))
 484                           (re-search-backward " " (mh-line-beginning-position) t)
 485                           (delete-region (point) (mh-line-end-position))
 486                           (insert (format " (%s/%s)" unseen total))
 487                           (mh-speed-highlight 'unknown face)
 488                           (goto-char (mh-line-beginning-position))
 489                           (add-text-properties
 490                            (point) (1+ (point))
 491                            `(mh-count (,unseen . ,total))))))))))))
 492           (setq position (1+ line-end)))
 493       (set-match-data prevailing-match-data))
 494     (setq mh-speed-partial-line (substring output position))))
 495
 496 ;;;###mh-autoload
 497 (defun mh-speed-invalidate-map (folder)
 498   "Remove FOLDER from various optimization caches."
 499   (interactive (list ""))
 500   (with-current-buffer speedbar-buffer
 501     (let* ((speedbar-update-flag nil)
 502            (last-slash (mh-search-from-end ?/ folder))
 503            (parent (if last-slash (substring folder 0 last-slash) nil))
 504            (parent-position (gethash parent mh-speed-folder-map))
 505            (parent-change nil))
 506       (when parent-position
 507         (let ((parent-kids (mh-sub-folders parent)))
 508           (cond ((null parent-kids)
 509                  (setq parent-change ?+))
 510                 ((and (null (cdr parent-kids))
 511                       (equal (if last-slash
 512                                  (substring folder (1+ last-slash))
 513                                (substring folder 1))
 514                              (caar parent-kids)))
 515                  (setq parent-change ? ))))
 516         (goto-char parent-position)
 517         (when (equal (get-text-property (mh-line-beginning-position) 'mh-folder)
 518                      parent)
 519           (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
 520             (mh-speed-toggle))
 521           (when parent-change
 522             (speedbar-with-writable
 523               (mh-speedbar-change-expand-button-char parent-change)
 524               (add-text-properties
 525                (mh-line-beginning-position) (1+ (mh-line-beginning-position))
 526                `(mh-children-p ,(equal parent-change ?+)))))
 527           (mh-speed-highlight mh-speed-last-selected-folder 'mh-speedbar-folder)
 528           (setq mh-speed-last-selected-folder nil)
 529           (setq mh-speed-refresh-flag t)))
 530       (when (equal folder "")
 531         (mh-clear-sub-folders-cache)))))
 532
 533 ;; Make it slightly more general to allow for [ ] buttons to be
 534 ;; changed to [+].
 535 (defun mh-speedbar-change-expand-button-char (char)
 536   "Change the expansion button character to CHAR for the current line."
 537   (save-excursion
 538     (beginning-of-line)
 539     (if (re-search-forward "\\[.\\]" (mh-line-end-position) t)
 540         (speedbar-with-writable
 541           (backward-char 2)
 542           (delete-char 1)
 543           (insert-char char 1 t)
 544           (put-text-property (point) (1- (point)) 'invisible nil)
 545           ;; make sure we fix the image on the text here.
 546           (mh-funcall-if-exists
 547            speedbar-insert-image-button-maybe (- (point) 2) 3)))))
 548
 549 ;;;###mh-autoload
 550 (defun mh-speed-add-folder (folder)
 551   "Add FOLDER since it is being created.
 552 The function invalidates the latest ancestor that is present."
 553   (with-current-buffer speedbar-buffer
 554     (let ((speedbar-update-flag nil)
 555           (last-slash (mh-search-from-end ?/ folder))
 556           (ancestor folder)
 557           (ancestor-pos nil))
 558       (block while-loop
 559         (while last-slash
 560           (setq ancestor (substring ancestor 0 last-slash))
 561           (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
 562           (when ancestor-pos
 563             (return-from while-loop))
 564           (setq last-slash (mh-search-from-end ?/ ancestor))))
 565       (unless ancestor-pos (setq ancestor nil))
 566       (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
 567       (speedbar-with-writable
 568         (mh-speedbar-change-expand-button-char ?+)
 569         (add-text-properties
 570          (mh-line-beginning-position) (1+ (mh-line-beginning-position))
 571          `(mh-children-p t)))
 572       (when (get-text-property (mh-line-beginning-position) 'mh-expanded)
 573         (mh-speed-toggle))
 574       (setq mh-speed-refresh-flag t))))
 575
 576 (provide 'mh-speed)
 577
 578 ;; Local Variables:
 579 ;; indent-tabs-mode: nil
 580 ;; sentence-end-double-space: nil
 581 ;; End:
 582
 583 ;;; mh-speed.el ends here