(mh-goto-msg): binary search (much faster!).

(mh-prompt-for-folder): error if regular file.

diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el
index cc06c774cd6fe2988dd59aa94f3f5cb2f576b2a4..a77205a26d03312242d1caf02e6f6c50766fc318 100644 (file)
--- a/lisp/mail/mh-utils.el
+++ b/lisp/mail/mh-utils.el
@@ -1,9 +1,9 @@
 ;;; mh-utils.el --- mh-e code needed for both sending and reading
-;; Time-stamp: <95/02/10 14:20:14 gildea>
+;; Time-stamp: <95/10/22 17:58:16 gildea>
 
 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
 
-;; This file is part of GNU Emacs.
+;; This file is part of mh-e, part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -25,7 +25,7 @@
 
 ;;; Change Log:
 
-;; $Id: mh-utils.el,v 1.4 1995/04/10 00:19:38 kwzh Exp kwzh $
+;; $Id: mh-utils.el,v 1.5 1995/04/25 22:27:45 kwzh Exp kwzh $
 
 ;;; Code:
 
@@ -95,6 +95,7 @@ Nil means don't use mhl to format messages when showing; mhl is still used,
 with the default format file, to format messages when printing them.
 The format used should specify a non-zero value for overflowoffset so
 the message continues to conform to RFC 822 and mh-e can parse the headers.")
+(put 'mhl-formfile 'info-file "mh-e")
 
 (defvar mh-default-folder-for-message-function nil
   "Function to select a default folder for refiling or Fcc.
@@ -158,6 +159,8 @@ First argument is folder name.  Second is message number.")
 (defvar mh-show-buffer nil)            ;Buffer that displays message for this folder.
 
 (defvar mh-folder-filename nil)                ;Full path of directory for this folder.
+  
+(defvar mh-msg-count nil)              ;Number of msgs in buffer.
 
 (defvar mh-showing nil)                        ;If non-nil, show the message in a separate window.
 
@@ -421,7 +424,7 @@ Type \"\\[mh-header-display]\" to see the message with all its headers."
 
 (defun mh-delete-line (lines)
   ;; Delete version of kill-line.
-  (delete-region (point) (save-excursion (forward-line lines) (point))))
+  (delete-region (point) (progn (forward-line lines) (point))))
 
 
 (defun mh-notate (msg notation offset)
@@ -437,34 +440,59 @@ Type \"\\[mh-header-display]\" to see the message with all its headers."
          (insert notation)))))
 
 
+(defun mh-find-msg-get-num (step)
+  ;; Return the message number of the message on the current scan line
+  ;; or one nearby.  Jumps over non-message lines, such as inc errors.
+  ;; STEP tells whether to search forward or backward if we have to search.
+  (or (mh-get-msg-num nil)
+      (let ((msg-num nil)
+           (nreverses 0))
+       (while (and (not msg-num)
+                   (< nreverses 2))
+         (cond ((eobp)
+                (setq step -1)
+                (setq nreverses (1+ nreverses)))
+               ((bobp)
+                (setq step 1)
+                (setq nreverses (1+ nreverses))))
+         (forward-line step)
+         (setq msg-num (mh-get-msg-num nil)))
+       msg-num)))
+
 (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
   "Position the cursor at message NUMBER.
 Optional non-nil second argument means return nil instead of
-signaling an error if message does not exist.
+signaling an error if message does not exist; in this case,
+the cursor is positioned near where the message would have been.
 Non-nil third argument means not to show the message."
   (interactive "NGo to message: ")
   (setq number (prefix-numeric-value number)) ;Emacs 19
-  (let ((cur-msg (mh-get-msg-num nil))
-       (starting-place (point))
-       (msg-pattern (mh-msg-search-pat number)))
-    (cond ((cond ((and cur-msg (= cur-msg number)) t)
-                ((and cur-msg
-                      (< cur-msg number)
-                      (re-search-forward msg-pattern nil t)) t)
-                ((and cur-msg
-                      (> cur-msg number)
-                      (re-search-backward msg-pattern nil t)) t)
-                (t                     ; Do thorough search of buffer
-                 (goto-char (point-max))
-                 (re-search-backward msg-pattern nil t)))
-           (beginning-of-line)
-           (if (not dont-show) (mh-maybe-show number))
-           t)
-         (t
-          (goto-char starting-place)
-          (if (not no-error-if-no-message)
-              (error "No message %d" number))
-          nil))))
+  ;; This basic routine tries to be as fast as possible,
+  ;; using a binary search and minimal regexps.
+  (let ((cur-msg (mh-find-msg-get-num -1))
+       (jump-size mh-msg-count))
+    (while (and (> jump-size 1)
+               cur-msg
+               (not (eq cur-msg number)))
+      (cond ((< cur-msg number)
+            (setq jump-size (min (- number cur-msg)
+                                 (ash (1+ jump-size) -1)))
+            (forward-line jump-size)
+            (setq cur-msg (mh-find-msg-get-num 1)))
+           (t
+            (setq jump-size (min (- cur-msg number)
+                                 (ash (1+ jump-size) -1)))
+            (forward-line (- jump-size))
+            (setq cur-msg (mh-find-msg-get-num -1)))))
+    (if (eq cur-msg number)
+       (progn
+         (beginning-of-line)
+         (or dont-show
+             (mh-maybe-show number)
+             t))
+      (if (not no-error-if-no-message)
+         (error "No message %d" number)))))
+
 
 (defun mh-msg-search-pat (n)
   ;; Return a search pattern for message N in the scan listing.
@@ -484,6 +512,7 @@ Non-nil third argument means not to show the message."
             (end-of-line)
             (buffer-substring start (point)))))))
 
+(defvar mua-paradigm "MH-E")           ;from mua.el
 
 (defun mh-find-path ()
   ;; Set mh-progs and mh-lib.
@@ -527,6 +556,7 @@ Non-nil third argument means not to show the message."
       (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
       (if mh-previous-seq
          (setq mh-previous-seq (intern mh-previous-seq)))
+      (setq mua-paradigm "MH-E")
       (run-hooks 'mh-find-path-hook))))
 
 (defun mh-find-progs ()
@@ -565,13 +595,17 @@ Non-nil third argument means not to show the message."
     (setq path (cdr path)))
   (car path))
 
+(defvar mh-no-install nil)             ;do not run install-mh
+
 (defun mh-install (profile error-val)
   ;; Called to do error recovery if we fail to read the profile file.
   ;; If possible, initialize the MH environment.
   (if (or (getenv "MH")
-         (file-exists-p profile))
-      (error "Cannot read MH profile \"%s\": %s"
-            profile (car (cdr (cdr error-val)))))
+         (file-exists-p profile)
+         mh-no-install)
+      (signal (car error-val)
+             (list (format "Cannot read MH profile \"%s\"" profile)
+                   (car (cdr (cdr error-val))))))
   ;; The "install-mh" command will output a short note which
   ;; mh-exec-cmd will display to the user.
   ;; The MH 5 version of install-mh might try prompt the user
@@ -582,8 +616,9 @@ Non-nil third argument means not to show the message."
   (condition-case err
       (insert-file-contents profile)
     (file-error
-     (error "Cannot read MH profile \"%s\": %s"
-           profile (car (cdr (cdr err)))))))
+     (signal (car err)                 ;re-signal with more specific msg
+            (list (format "Cannot read MH profile \"%s\"" profile)
+                  (car (cdr (cdr err))))))))
 
 
 (defun mh-set-folder-modified-p (flag)
@@ -658,6 +693,9 @@ Non-nil third argument means not to show the message."
             (run-hooks 'mh-folder-list-change-hook))
            (new-file-p
             (error "Folder %s is not created" folder-name))
+           ((not (file-directory-p (mh-expand-file-name folder-name)))
+            (error "\"%s\" is not a directory"
+                   (mh-expand-file-name folder-name)))
            ((and (null (assoc read-name mh-folder-list))
                  (null (assoc (concat read-name "/") mh-folder-list)))
             (setq mh-folder-list (cons (list read-name) mh-folder-list))
@@ -692,7 +730,7 @@ Non-nil third argument means not to show the message."
   ;; Call mh-set-folder-list to wait for the result.
   (cond
    ((not mh-make-folder-list-process)
-    (mh-find-progs)
+    (mh-find-path)
     (let ((process-connection-type nil))
       (setq mh-make-folder-list-process
            (start-process "folders" nil (expand-file-name "folders" mh-progs)
@@ -707,32 +745,35 @@ Non-nil third argument means not to show the message."
 (defun mh-make-folder-list-filter (process output)
   ;; parse output from "folders -fast"
   (let ((position 0)
-       (line-end t)
-       new-folder)
-    (while line-end
-      (setq line-end (string-match "\n" output position))
-      (cond
-       (line-end                       ;make sure got complete line
-       (setq new-folder (format "+%s%s"
-                                mh-folder-list-partial-line
-                                (substring output position line-end)))
-       (setq mh-folder-list-partial-line "")
-       ;; is new folder a subfolder of previous?
-       (if (and mh-folder-list-temp
-                (string-match (regexp-quote
-                               (concat (car (car mh-folder-list-temp)) "/"))
-                              new-folder))
-           ;; append slash to parent folder for better completion
-           ;; (undone by mh-prompt-for-folder)
+       line-end
+       new-folder
+       (prevailing-match-data (match-data)))
+    (unwind-protect
+       ;; make sure got complete line
+       (while (setq line-end (string-match "\n" output position))
+         (setq new-folder (format "+%s%s"
+                                  mh-folder-list-partial-line
+                                  (substring output position line-end)))
+         (setq mh-folder-list-partial-line "")
+         ;; is new folder a subfolder of previous?
+         (if (and mh-folder-list-temp
+                  (string-match
+                   (regexp-quote
+                    (concat (car (car mh-folder-list-temp)) "/"))
+                   new-folder))
+             ;; append slash to parent folder for better completion
+             ;; (undone by mh-prompt-for-folder)
+             (setq mh-folder-list-temp
+                   (cons
+                    (list new-folder)
+                    (cons
+                     (list (concat (car (car mh-folder-list-temp)) "/"))
+                     (cdr mh-folder-list-temp))))
            (setq mh-folder-list-temp
                  (cons (list new-folder)
-                       (cons
-                        (list (concat (car (car mh-folder-list-temp)) "/"))
-                        (cdr mh-folder-list-temp))))
-         (setq mh-folder-list-temp
-               (cons (list new-folder)
-                     mh-folder-list-temp)))
-       (setq position (1+ line-end)))))
+                       mh-folder-list-temp)))
+         (setq position (1+ line-end)))
+      (store-match-data prevailing-match-data))
     (setq mh-folder-list-partial-line (substring output position))))
 
 
@@ -903,6 +944,9 @@ Non-nil third argument means not to show the message."
 
 (and (not noninteractive)
      mh-auto-folder-collect
-     (mh-make-folder-list-background))
+     (let ((mh-no-install t))          ;only get folders if MH installed
+       (condition-case err
+          (mh-make-folder-list-background)
+        (file-error))))                ;so don't complain if not installed
 
 ;;; mh-utils.el ends here