From: Karl Heuer Date: Fri, 3 Nov 1995 02:29:09 +0000 (+0000) Subject: (mh-goto-msg): binary search (much faster!). X-Git-Tag: emacs-19.34~2474 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b3470e4c6b3b911f791446cf99170387c0900ad8;p=emacs.git (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 cc06c774cd6..a77205a26d0 100644 --- 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