Mercurial > emacs

--- a/lisp/mail/mh-utils.el	Fri Nov 03 02:28:52 1995 +0000
+++ b/lisp/mail/mh-utils.el	Fri Nov 03 02:29:09 1995 +0000
@@ -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 @@
 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 @@
 (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 @@

 (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 @@
 	  (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 @@
 	     (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 @@
       (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 @@
     (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 @@
   (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 @@
 	     (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 @@
   ;; 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 @@
 (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 @@

 (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