;;; mh-letter.el --- MH-Letter mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
And each hook function should leave point and mark around the
citation text as modified.
-This is a normal hook, misnamed for historical reasons. It is
-semi-obsolete and is only used if `mail-citation-hook' is nil.")
+This is a normal hook, misnamed for historical reasons.
+It is obsolete and is only used if `mail-citation-hook' is nil.")
+(mh-make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
\f
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
"\C-c\M-d" mh-insert-auto-fields
- "\M-\t" mh-letter-complete ;; FIXME: completion-at-point
+ "\M-\t" mh-letter-complete
"\t" mh-letter-next-header-field-or-indent
[backtab] mh-letter-previous-header-field)
;;; MH-Letter Mode
;; Shush compiler.
-(defvar font-lock-defaults) ; XEmacs
+(mh-do-in-xemacs
+ (defvar font-lock-defaults))
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-letter-mode 'mode-class 'special)
(or (funcall func) #'ignore)
mh-letter-complete-function)))
-(defalias 'mh-letter-complete
- (if (fboundp 'completion-at-point) #'completion-at-point
- (lambda ()
- "Perform completion on header field or word preceding point.
+;; TODO Now that completion-at-point performs the task of
+;; mh-letter-complete, perhaps mh-letter-complete along with
+;; mh-complete-word should be rewritten as a more general function for
+;; XEmacs, renamed to mh-completion-at-point, and moved to
+;; mh-compat.el.
+(defun-mh mh-letter-complete completion-at-point ()
+ "Perform completion on header field or word preceding point.
If the field contains addresses (for example, \"To:\" or \"Cc:\")
or folders (for example, \"Fcc:\") then this command will provide
(end (nth 1 data))
(table (nth 2 data)))
(mh-complete-word (buffer-substring-no-properties start end)
- table start end))))))))
+ table start end))))))
(defun mh-letter-complete-or-space (arg)
"Perform completion or insert space.
space is inserted; use a prefix argument ARG to specify more than
one space."
(interactive "p")
- (let ((func nil)
- (end-of-prev (save-excursion
+ (let ((end-of-prev (save-excursion
(goto-char (mh-beginning-of-word))
(mh-beginning-of-word -1))))
(cond ((not mh-compose-space-does-completion-flag)
the supercite flavors, the hook `mail-citation-hook' is ignored
and `mh-ins-buf-prefix' is not inserted."
(interactive)
- (if (and mh-sent-from-folder
- (with-current-buffer mh-sent-from-folder mh-show-buffer)
- (with-current-buffer mh-sent-from-folder
- (get-buffer mh-show-buffer))
- mh-sent-from-msg)
- (let ((to-point (point))
- (to-buffer (current-buffer)))
- (set-buffer mh-sent-from-folder)
- (if mh-delete-yanked-msg-window-flag
- (delete-windows-on mh-show-buffer))
- (set-buffer mh-show-buffer) ; Find displayed message
- (let* ((from-attr (mh-extract-from-attribution))
- (yank-region (mh-mark-active-p nil))
- (mh-ins-str
- (cond ((and yank-region
- (or (eq 'supercite mh-yank-behavior)
- (eq 'autosupercite mh-yank-behavior)
- (eq t mh-yank-behavior)))
- ;; supercite needs the full header
- (concat
- (buffer-substring (point-min) (mh-mail-header-end))
- "\n"
- (buffer-substring (region-beginning) (region-end))))
- (yank-region
- (buffer-substring (region-beginning) (region-end)))
- ((or (eq 'body mh-yank-behavior)
- (eq 'attribution mh-yank-behavior)
- (eq 'autoattrib mh-yank-behavior))
- (buffer-substring
- (save-excursion
- (goto-char (point-min))
- (mh-goto-header-end 1)
- (point))
- (point-max)))
- ((or (eq 'supercite mh-yank-behavior)
- (eq 'autosupercite mh-yank-behavior)
- (eq t mh-yank-behavior))
- (buffer-substring (point-min) (point-max)))
- (t
- (buffer-substring (point) (point-max))))))
- (set-buffer to-buffer)
- (save-restriction
- (narrow-to-region to-point to-point)
- (insert (mh-filter-out-non-text mh-ins-str))
- (goto-char (point-max)) ;Needed for sc-cite-original
- (push-mark) ;Needed for sc-cite-original
- (goto-char (point-min)) ;Needed for sc-cite-original
- (mh-insert-prefix-string mh-ins-buf-prefix)
- (when (or (eq 'attribution mh-yank-behavior)
- (eq 'autoattrib mh-yank-behavior))
- (insert from-attr)
- (mh-identity-insert-attribution-verb nil)
- (insert "\n\n"))
- ;; If the user has selected a region, he has already "edited" the
- ;; text, so leave the cursor at the end of the yanked text. In
- ;; either case, leave a mark at the opposite end of the included
- ;; text to make it easy to jump or delete to the other end of the
- ;; text.
- (push-mark)
- (goto-char (point-max))
- (if (null yank-region)
- (mh-exchange-point-and-mark-preserving-active-mark)))))
- (error "There is no current message")))
+ (let ((show-buffer))
+ (if (and mh-sent-from-folder
+ (with-current-buffer mh-sent-from-folder mh-show-buffer)
+ (setq show-buffer (with-current-buffer mh-sent-from-folder
+ (get-buffer mh-show-buffer)))
+ mh-sent-from-msg)
+ (let ((to-point (point))
+ (to-buffer (current-buffer)))
+ (if mh-delete-yanked-msg-window-flag
+ (with-current-buffer mh-sent-from-folder
+ (delete-windows-on show-buffer)))
+ ;; Find displayed message
+ (with-current-buffer show-buffer
+ (let* ((from-attr (mh-extract-from-attribution))
+ (yank-region (mh-mark-active-p nil))
+ (mh-ins-str
+ (cond ((and yank-region
+ (or (eq 'supercite mh-yank-behavior)
+ (eq 'autosupercite mh-yank-behavior)
+ (eq t mh-yank-behavior)))
+ ;; supercite needs the full header
+ (concat
+ (buffer-substring (point-min) (mh-mail-header-end))
+ "\n"
+ (buffer-substring (region-beginning) (region-end))))
+ (yank-region
+ (buffer-substring (region-beginning) (region-end)))
+ ((or (eq 'body mh-yank-behavior)
+ (eq 'attribution mh-yank-behavior)
+ (eq 'autoattrib mh-yank-behavior))
+ (buffer-substring
+ (save-excursion
+ (goto-char (point-min))
+ (mh-goto-header-end 1)
+ (point))
+ (point-max)))
+ ((or (eq 'supercite mh-yank-behavior)
+ (eq 'autosupercite mh-yank-behavior)
+ (eq t mh-yank-behavior))
+ (buffer-substring (point-min) (point-max)))
+ (t
+ (buffer-substring (point) (point-max))))))
+ (with-current-buffer to-buffer
+ (save-restriction
+ (narrow-to-region to-point to-point)
+ (insert (mh-filter-out-non-text mh-ins-str))
+ (goto-char (point-max)) ;Needed for sc-cite-original
+ (push-mark) ;Needed for sc-cite-original
+ (goto-char (point-min)) ;Needed for sc-cite-original
+ (mh-insert-prefix-string mh-ins-buf-prefix)
+ (when (or (eq 'attribution mh-yank-behavior)
+ (eq 'autoattrib mh-yank-behavior))
+ (insert from-attr)
+ (mh-identity-insert-attribution-verb nil)
+ (insert "\n\n"))
+ ;; If the user has selected a region, he has already "edited" the
+ ;; text, so leave the cursor at the end of the yanked text. In
+ ;; either case, leave a mark at the opposite end of the included
+ ;; text to make it easy to jump or delete to the other end of the
+ ;; text.
+ (push-mark)
+ (goto-char (point-max))
+ (if (null yank-region)
+ (mh-exchange-point-and-mark-preserving-active-mark)))))))
+ (error "There is no current message"))))
\f
;;;###mh-autoload
(defun mh-complete-word (word choices begin end)
- ;; FIXME: Only needed when completion-at-point doesn't exist.
"Complete WORD from CHOICES.
Any match found replaces the text from BEGIN to END."
(let ((completion (try-completion word choices))
(with-output-to-temp-buffer completions-buffer
(mh-display-completion-list
(all-completions word choices)
- ;; The `common-subtring' arg only works if it's a prefix.
+ ;; The `common-substring' arg only works if it's a prefix.
(unless (and (functionp choices)
(let ((bounds
(funcall choices