comparison lisp/mail/pmail.el @ 101077:22a55aabcdba

(pmail-count-screen-lines, pmail-use-collection-buffer) (pmail-use-viewer-buffer): Fns deleted. Other functions reordered but not changed.

101076:6c4177798438

    (unwind-protect
	(let ((modp (buffer-modified-p)))
;;;	  (save-match-data
;;;	    (let ((case-fold-search nil))
;;;	      (unless (or (string-match "PMAIL" (buffer-name))
;;;			  (string-match "xmail" (buffer-name)))
;;;		(debug))))
	  (buffer-swap-text buffer-swapped-with)
	  (set-buffer-modified-p modp)
	  ad-do-it)
      (buffer-swap-text buffer-swapped-with)

  ;; current message back and forth.  This model is based on Stefan
  ;; Monnier's solution for tar-mode.
  (and (buffer-live-p pmail-view-buffer)
       (> (buffer-size pmail-view-buffer) (buffer-size))))

(defun pmail-mode-kill-buffer-hook ()
  (if (buffer-live-p pmail-view-buffer) (kill-buffer pmail-view-buffer)))

;; Set up the permanent locals associated with an Pmail file.
(defun pmail-perm-variables ()

    (goto-char (pmail-msgend pmail-current-message))
    (insert string)
    (pmail-forget-messages)
    (pmail-show-message-maybe number)
    (message "Message duplicated")))

;;;###autoload
(defun pmail-input (filename)
  "Run Pmail on file FILENAME."
  (interactive "FRun pmail on PMAIL file: ")
  (pmail filename))

	    (if (search-forward "\n\nFrom " nil 'move)
		(forward-char -5))
	    (setq start (point))))
	count))))

;;;; *** Pmail Message Formatting and Header Manipulation ***

(defun pmail-copy-headers (beg end &optional ignored-headers)
  "Copy displayed header fields to the message viewer buffer.
BEG and END marks the start and end positions of the message in
the mbox buffer.  If the optional argument IGNORED-HEADERS is
non-nil, ignore all header fields whose names match that regexp.
Otherwise, if `rmail-displayed-headers' is non-nil, copy only
those header fields whose names match that regexp.  Otherwise,
copy all header fields whose names do not match
`rmail-ignored-headers' (unless they also match
`rmail-nonignored-headers')."
  (let ((header-start-regexp "\n[^ \t]")
	lim)
    (with-current-buffer pmail-buffer
      (when (search-forward "\n\n" nil t)
	(forward-char -1)
	(save-restriction
	  ;; Put point right after the From header line.
	  (narrow-to-region beg (point))
	  (goto-char (point-min))
	  (unless (re-search-forward header-start-regexp nil t)
	    (pmail-error-bad-format))
	  (forward-char -1)
	  (cond
	   ;; Handle the case where all headers should be copied.
	   ((eq pmail-header-style 'full)
	    (prepend-to-buffer pmail-view-buffer beg (point-max)))
	   ;; Handle the case where the headers matching the diplayed
	   ;; headers regexp should be copied.
	   ((and pmail-displayed-headers (null ignored-headers))
	    (while (not (eobp))
	      (save-excursion
		(setq lim (if (re-search-forward header-start-regexp nil t)
			      (1+ (match-beginning 0))
			    (point-max))))
	      (when (looking-at pmail-displayed-headers)
		(append-to-buffer pmail-view-buffer (point) lim))
	      (goto-char lim)))
	   ;; Handle the ignored headers.
	   ((or ignored-headers (setq ignored-headers pmail-ignored-headers))
	    (while (and ignored-headers (not (eobp)))
	      (save-excursion
		(setq lim (if (re-search-forward header-start-regexp nil t)
			      (1+ (match-beginning 0))
			    (point-max))))
	      (if (and (looking-at ignored-headers)
		       (not (looking-at pmail-nonignored-headers)))
		  (goto-char lim)
		(append-to-buffer pmail-view-buffer (point) lim)
		(goto-char lim))))
	   (t (error "No headers selected for display!"))))))))

(defun pmail-toggle-header (&optional arg)
  "Show original message header if pruned header currently shown, or vice versa.
With argument ARG, show the message header pruned if ARG is greater than zero;
otherwise, show it in full."
  (interactive "P")
  (setq pmail-header-style
	(cond
	 ((and (numberp arg) (> arg 0)) 'normal)
	 ((eq pmail-header-style 'full) 'normal)
	 (t 'full)))
  (pmail-show-message-maybe))

;; Lifted from repos-count-screen-lines.
;; Return number of screen lines between START and END.
(defun pmail-count-screen-lines (start end)
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (vertical-motion (- (point-max) (point-min))))))

(defun pmail-get-header (name &optional msgnum)
  "Return the value of message header NAME, nil if it has none.
MSGNUM specifies the message number to get it from.
If MSGNUM is nil, use the current message."
  (with-current-buffer pmail-buffer

Return non-nil if the unseen attribute is set, nil otherwise."
  (pmail-message-attr-p msgnum "......U"))

;;;; *** Pmail Message Selection And Support ***

;; (defun pmail-get-collection-buffer ()
;;   "Return the buffer containing the mbox formatted messages."
;;   (if (eq major-mode 'pmail-mode)
;;       (if pmail-buffers-swapped-p
;; 	  pmail-view-buffer
;; 	pmail-buffer)
;;     (error "The current buffer must be in Pmail mode.")))

(defun pmail-use-collection-buffer ()
  "Insure that the Pmail buffer contains the message collection.
Return the current message number if the Pmail buffer is in a
swapped state, i.e. it currently contains a single decoded
message rather than an entire message collection, nil otherwise."
  (let (result)
    (when (pmail-buffers-swapped-p)
      (let ((modp (buffer-modified-p)))
	(buffer-swap-text pmail-view-buffer)
	(set-buffer-modified-p modp))
      (setq buffer-swapped-with nil
	    result pmail-current-message))
    result))

(defun pmail-use-viewer-buffer (&optional msgnum)
  "Insure that the Pmail buffer contains the current message.
If message MSGNUM is non-nil make it the current message and
display it.  Return nil."
  (let (result)
    (cond
     ((not (pmail-buffers-swapped-p))
      (let ((message (or msgnum pmail-current-message)))
	(pmail-show-message message)))
     ((and msgnum (/= msgnum pmail-current-message))
      (pmail-show-message msgnum))
     (t))
    result))

(defun pmail-msgend (n)
  (marker-position (aref pmail-message-vector (1+ n))))

(defun pmail-msgbeg (n)
  (marker-position (aref pmail-message-vector n)))

	;; Note: we don't use save-restriction because that does not work right
	;; if changes are made outside the saved restriction
	;; before that restriction is restored.
      (narrow-to-region (pmail-msgbeg pmail-current-message)
			(pmail-msgend pmail-current-message)))))

(defun pmail-forget-messages ()
  (unwind-protect
      (if (vectorp pmail-message-vector)
	  (let* ((i 0)

      (goto-char (point-min)))
    (unless (not (looking-at "From "))
      (pmail-collect-deleted start)
      (setq messages-head (cons (point-marker) messages-head)
	    total-messages (1+ total-messages)))))

(defun pmail-beginning-of-message ()
  "Show current message starting from the beginning."
  (interactive)
  (let ((pmail-show-message-hook

			 (format "Add `%s' to `mail-mailing-lists'? "
				 addr)))
	       (customize-save-variable 'mail-mailing-lists
					(cons addr mail-mailing-lists)))))))))

(defun pmail-swap-buffers-maybe ()
  "Determine if the Pmail buffer is showing a message.
If so restore the actual mbox message collection."
  (with-current-buffer pmail-buffer
    (when (pmail-buffers-swapped-p)
      (let ((modp (buffer-modified-p)))
	(buffer-swap-text pmail-view-buffer)
	(set-buffer-modified-p modp))
      (setq buffer-swapped-with nil))))

(defun pmail-widen ()
  "Display the entire mailbox file."
  (interactive)
  (pmail-swap-buffers-maybe)
  (widen))

(defun pmail-show-message-maybe (&optional n no-summary)
  "Show message number N (prefix argument), counting from start of file.
If summary buffer is currently displayed, update current message there also."
  (interactive "p")
  (or (eq major-mode 'pmail-mode)

	(set-buffer-modified-p modp))
      (setq buffer-swapped-with pmail-view-buffer)
      (run-hooks 'pmail-show-message-hook))
    blurb))

;; Find all occurrences of certain fields, and highlight them.
(defun pmail-highlight-headers ()
  ;; Do this only if the system supports faces.
  (if (and (fboundp 'internal-find-face)
	   pmail-highlighted-headers)

	      (if (string= "/dev/null" folder)
		  (pmail-delete-message)
		(pmail-output folder 1 t)
		(setq d nil))))
	(setq d (cdr d))))))

(defun pmail-next-message (n)
  "Show following message whether deleted or not.
With prefix arg N, moves forward N messages, or backward if N is negative."
  (interactive "p")

  (interactive)
  (pmail-maybe-set-message-counters)
  (pmail-show-message-maybe pmail-total-messages))

(defun pmail-what-message ()
  (let ((where (point))
	(low 1)
	(high pmail-total-messages)
	(mid (/ pmail-total-messages 2)))
    (while (> (- high low) 1)

	  (setq low mid)
	(setq high mid))
      (setq mid (+ low (/ (- high low) 2))))
    (if (>= where (pmail-msgbeg high)) high low)))

(defun pmail-search-message (msg regexp)
  "Return non-nil, if for message number MSG, regexp REGEXP matches."
  ;; This is adequate because its only caller, pmail-search,
  ;; unswaps the buffers.
  (goto-char (pmail-msgbeg msg))

	    ((not pmail-search-last-regexp)
	     (error "No previous Pmail search string")))
      (list pmail-search-last-regexp
	    (prefix-numeric-value current-prefix-arg))))
  (pmail-search regexp (- (or n 1))))


(defun pmail-first-unseen-message ()
  "Return the message index for the first message which has the
`unseen' attribute."
  (pmail-maybe-set-message-counters)
  (let ((current 1)
	found)
    (save-restriction
      (widen)

(defun pmail-delete-backward ()
  "Delete this message and move to previous nondeleted one.
Deleted messages stay in the file until the \\[pmail-expunge] command is given."
  (interactive)
  (pmail-delete-forward t))

;; Compute the message number a given message would have after expunging.
;; The present number of the message is OLDNUM.
;; DELETEDVEC should be pmail-deleted-vector.
;; The value is nil for a message that would be deleted.

		   (aref pmail-msgref-vector msgnum))
		 pmail-answered-attr-index))
     nil
     (list (cons "References" (concat (mapconcat 'identity references " ")
				      " " message-id))))))

(defun pmail-mark-message (buffer msgnum-list attribute)
  "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.
This is use in the send-actions for message buffers.
MSGNUM-LIST is a list of the form (MSGNUM)
which is an element of pmail-msgref-vector."

101077:22a55aabcdba

    (unwind-protect
	(let ((modp (buffer-modified-p)))
;;;	  (save-match-data
;;;	    (let ((case-fold-search nil))
;;;	      (unless (or (string-match "PMAIL" (buffer-name))
;;;			  (string-match "xmail" (buffer-name))
;;;			  (string-match "mbox" (buffer-name)))
;;;		(debug))))
	  (buffer-swap-text buffer-swapped-with)
	  (set-buffer-modified-p modp)
	  ad-do-it)
      (buffer-swap-text buffer-swapped-with)

  ;; current message back and forth.  This model is based on Stefan
  ;; Monnier's solution for tar-mode.
  (and (buffer-live-p pmail-view-buffer)
       (> (buffer-size pmail-view-buffer) (buffer-size))))

(defun pmail-swap-buffers-maybe ()
  "Determine if the Pmail buffer is showing a message.
If so restore the actual mbox message collection."
  (with-current-buffer pmail-buffer
    (when (pmail-buffers-swapped-p)
      (let ((modp (buffer-modified-p)))
	(buffer-swap-text pmail-view-buffer)
	(set-buffer-modified-p modp))
      (setq buffer-swapped-with nil))))

(defun pmail-mode-kill-buffer-hook ()
  (if (buffer-live-p pmail-view-buffer) (kill-buffer pmail-view-buffer)))

;; Set up the permanent locals associated with an Pmail file.
(defun pmail-perm-variables ()

    (goto-char (pmail-msgend pmail-current-message))
    (insert string)
    (pmail-forget-messages)
    (pmail-show-message-maybe number)
    (message "Message duplicated")))

;;;###autoload
(defun pmail-input (filename)
  "Run Pmail on file FILENAME."
  (interactive "FRun pmail on PMAIL file: ")
  (pmail filename))

	    (if (search-forward "\n\nFrom " nil 'move)
		(forward-char -5))
	    (setq start (point))))
	count))))

(defun pmail-get-header (name &optional msgnum)
  "Return the value of message header NAME, nil if it has none.
MSGNUM specifies the message number to get it from.
If MSGNUM is nil, use the current message."
  (with-current-buffer pmail-buffer

Return non-nil if the unseen attribute is set, nil otherwise."
  (pmail-message-attr-p msgnum "......U"))

;;;; *** Pmail Message Selection And Support ***

(defun pmail-msgend (n)
  (marker-position (aref pmail-message-vector (1+ n))))

(defun pmail-msgbeg (n)
  (marker-position (aref pmail-message-vector n)))

	;; Note: we don't use save-restriction because that does not work right
	;; if changes are made outside the saved restriction
	;; before that restriction is restored.
      (narrow-to-region (pmail-msgbeg pmail-current-message)
			(pmail-msgend pmail-current-message)))))

;; Manage the message vectors and counters.

(defun pmail-forget-messages ()
  (unwind-protect
      (if (vectorp pmail-message-vector)
	  (let* ((i 0)

      (goto-char (point-min)))
    (unless (not (looking-at "From "))
      (pmail-collect-deleted start)
      (setq messages-head (cons (point-marker) messages-head)
	    total-messages (1+ total-messages)))))

;; Display a message.

;;;; *** Pmail Message Formatting and Header Manipulation ***

(defun pmail-toggle-header (&optional arg)
  "Show original message header if pruned header currently shown, or vice versa.
With argument ARG, show the message header pruned if ARG is greater than zero;
otherwise, show it in full."
  (interactive "P")
  (setq pmail-header-style
	(cond
	 ((and (numberp arg) (> arg 0)) 'normal)
	 ((eq pmail-header-style 'full) 'normal)
	 (t 'full)))
  (pmail-show-message-maybe))

(defun pmail-beginning-of-message ()
  "Show current message starting from the beginning."
  (interactive)
  (let ((pmail-show-message-hook

			 (format "Add `%s' to `mail-mailing-lists'? "
				 addr)))
	       (customize-save-variable 'mail-mailing-lists
					(cons addr mail-mailing-lists)))))))))

(defun pmail-widen ()
  "Display the entire mailbox file."
  (interactive)
  (pmail-swap-buffers-maybe)
  (widen))

(defun pmail-show-message-maybe (&optional n no-summary)
  "Show message number N (prefix argument), counting from start of file.
If summary buffer is currently displayed, update current message there also."
  (interactive "p")
  (or (eq major-mode 'pmail-mode)

	(set-buffer-modified-p modp))
      (setq buffer-swapped-with pmail-view-buffer)
      (run-hooks 'pmail-show-message-hook))
    blurb))

(defun pmail-copy-headers (beg end &optional ignored-headers)
  "Copy displayed header fields to the message viewer buffer.
BEG and END marks the start and end positions of the message in
the mbox buffer.  If the optional argument IGNORED-HEADERS is
non-nil, ignore all header fields whose names match that regexp.
Otherwise, if `rmail-displayed-headers' is non-nil, copy only
those header fields whose names match that regexp.  Otherwise,
copy all header fields whose names do not match
`rmail-ignored-headers' (unless they also match
`rmail-nonignored-headers')."
  (let ((header-start-regexp "\n[^ \t]")
	lim)
    (with-current-buffer pmail-buffer
      (when (search-forward "\n\n" nil t)
	(forward-char -1)
	(save-restriction
	  ;; Put point right after the From header line.
	  (narrow-to-region beg (point))
	  (goto-char (point-min))
	  (unless (re-search-forward header-start-regexp nil t)
	    (pmail-error-bad-format))
	  (forward-char -1)
	  (cond
	   ;; Handle the case where all headers should be copied.
	   ((eq pmail-header-style 'full)
	    (prepend-to-buffer pmail-view-buffer beg (point-max)))
	   ;; Handle the case where the headers matching the diplayed
	   ;; headers regexp should be copied.
	   ((and pmail-displayed-headers (null ignored-headers))
	    (while (not (eobp))
	      (save-excursion
		(setq lim (if (re-search-forward header-start-regexp nil t)
			      (1+ (match-beginning 0))
			    (point-max))))
	      (when (looking-at pmail-displayed-headers)
		(append-to-buffer pmail-view-buffer (point) lim))
	      (goto-char lim)))
	   ;; Handle the ignored headers.
	   ((or ignored-headers (setq ignored-headers pmail-ignored-headers))
	    (while (and ignored-headers (not (eobp)))
	      (save-excursion
		(setq lim (if (re-search-forward header-start-regexp nil t)
			      (1+ (match-beginning 0))
			    (point-max))))
	      (if (and (looking-at ignored-headers)
		       (not (looking-at pmail-nonignored-headers)))
		  (goto-char lim)
		(append-to-buffer pmail-view-buffer (point) lim)
		(goto-char lim))))
	   (t (error "No headers selected for display!"))))))))

;; Find all occurrences of certain fields, and highlight them.
(defun pmail-highlight-headers ()
  ;; Do this only if the system supports faces.
  (if (and (fboundp 'internal-find-face)
	   pmail-highlighted-headers)

	      (if (string= "/dev/null" folder)
		  (pmail-delete-message)
		(pmail-output folder 1 t)
		(setq d nil))))
	(setq d (cdr d))))))

;; Simple message motion commands.

(defun pmail-next-message (n)
  "Show following message whether deleted or not.
With prefix arg N, moves forward N messages, or backward if N is negative."
  (interactive "p")

  (interactive)
  (pmail-maybe-set-message-counters)
  (pmail-show-message-maybe pmail-total-messages))

(defun pmail-what-message ()
  "For debugging Pmail: find the message number that point is in."
  (let ((where (point))
	(low 1)
	(high pmail-total-messages)
	(mid (/ pmail-total-messages 2)))
    (while (> (- high low) 1)

	  (setq low mid)
	(setq high mid))
      (setq mid (+ low (/ (- high low) 2))))
    (if (>= where (pmail-msgbeg high)) high low)))

;; Searching in Pmail file.

(defun pmail-search-message (msg regexp)
  "Return non-nil, if for message number MSG, regexp REGEXP matches."
  ;; This is adequate because its only caller, pmail-search,
  ;; unswaps the buffers.
  (goto-char (pmail-msgbeg msg))

	    ((not pmail-search-last-regexp)
	     (error "No previous Pmail search string")))
      (list pmail-search-last-regexp
	    (prefix-numeric-value current-prefix-arg))))
  (pmail-search regexp (- (or n 1))))

;; Scan for attributes, and compare subjects.

(defun pmail-first-unseen-message ()
  "Return message number of first message which has `unseen' attribute."
  (pmail-maybe-set-message-counters)
  (let ((current 1)
	found)
    (save-restriction
      (widen)

(defun pmail-delete-backward ()
  "Delete this message and move to previous nondeleted one.
Deleted messages stay in the file until the \\[pmail-expunge] command is given."
  (interactive)
  (pmail-delete-forward t))

;; Expunging.

;; Compute the message number a given message would have after expunging.
;; The present number of the message is OLDNUM.
;; DELETEDVEC should be pmail-deleted-vector.
;; The value is nil for a message that would be deleted.

		   (aref pmail-msgref-vector msgnum))
		 pmail-answered-attr-index))
     nil
     (list (cons "References" (concat (mapconcat 'identity references " ")
				      " " message-id))))))

(defun pmail-mark-message (buffer msgnum-list attribute)
  "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.
This is use in the send-actions for message buffers.
MSGNUM-LIST is a list of the form (MSGNUM)
which is an element of pmail-msgref-vector."