;;; mh-letter.el --- MH-Letter mode
-;; Copyright (C) 1993, 1995, 1997,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
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.")
+(make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
\f
;;; 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.
+;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-letter-mode 'mode-class 'special)
;;;###mh-autoload
(mh-do-in-gnu-emacs
(unless mh-letter-tool-bar-map
(mh-tool-bar-letter-buttons-init))
- (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)))
(mh-do-in-xemacs
(mh-tool-bar-init :letter))
;; Set the local value of mh-mail-header-separator according to what is
(define-key mh-letter-mode-map [menu-bar mail] 'undefined)
(mh-do-in-xemacs (easy-menu-remove mail-menubar-menu))
(setq fill-column mh-letter-fill-column)
+ (add-hook 'completion-at-point-functions
+ 'mh-letter-completion-at-point nil 'local)
;; If text-mode-hook turned on auto-fill, tune it for messages
(when auto-fill-function
(make-local-variable 'auto-fill-function)
(message "No signature found")))))
(force-mode-line-update))
-(defun mh-letter-complete (arg)
+(defun mh-letter-completion-at-point ()
+ "Return the completion data at point for MH letters.
+This provides alias and folder completion in header fields according to
+`mh-letter-complete-function-alist' and falls back on
+`mh-letter-complete-function-alist' elsewhere."
+ (let ((func (and (mh-in-header-p)
+ (cdr (assoc (mh-letter-header-field-at-point)
+ mh-letter-complete-function-alist)))))
+ (if func
+ (or (funcall func) #'ignore)
+ mh-letter-complete-function)))
+
+;; 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
alias completion. In the body of the message, this command runs
`mh-letter-complete-function' instead, which is set to
-`ispell-complete-word' by default. This command takes a prefix
-argument ARG that is passed to the
-`mh-letter-complete-function'."
- (interactive "P")
- (let ((func nil))
- (cond ((not (mh-in-header-p))
- (funcall mh-letter-complete-function arg))
- ((setq func (cdr (assoc (mh-letter-header-field-at-point)
- mh-letter-complete-function-alist)))
- (funcall func))
- (t (funcall mh-letter-complete-function arg)))))
+`ispell-complete-word' by default."
+ (interactive)
+ (let ((data (mh-letter-completion-at-point)))
+ (cond
+ ((functionp data) (funcall data))
+ ((consp data)
+ (let ((start (nth 0 data))
+ (end (nth 1 data))
+ (table (nth 2 data)))
+ (mh-complete-word (buffer-substring-no-properties 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)
(self-insert-command arg))
- ((not (mh-in-header-p)) (self-insert-command arg))
+ ;; FIXME: This > test is redundant now that all the completion
+ ;; functions do it anyway.
((> (point) end-of-prev) (self-insert-command arg))
- ((setq func (cdr (assoc (mh-letter-header-field-at-point)
- mh-letter-complete-function-alist)))
- (funcall func))
+ ((let ((mh-letter-complete-function nil))
+ (mh-letter-completion-at-point))
+ (mh-letter-complete))
(t (self-insert-command arg)))))
(defun mh-letter-confirm-address ()
mh-default-folder-for-message-function)))
"")
t)))
- (let ((last-input-char ?\C-f))
+ (let ((last-input-event ?\C-f))
(expand-abbrev)
(save-excursion
(mh-to-field)
Set the mark to point before moving."
(interactive)
(expand-abbrev)
- (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
+ (let ((target (cdr (or (assoc (char-to-string (logior last-input-event ?`))
mh-to-field-choices)
;; also look for a char for version 4 compat
- (assoc (logior last-input-char ?`)
+ (assoc (logior last-input-event ?`)
mh-to-field-choices))))
(case-fold-search t))
(push-mark)
(let ((eol (point)))
(skip-chars-backward " \t")
(delete-region (point) eol))
- (if (and (not (eq (logior last-input-char ?`) ?s))
+ (if (and (not (eq (logior last-input-event ?`) ?s))
(save-excursion
(backward-char 1)
(not (looking-at "[:,]"))))
and `mh-ins-buf-prefix' is not inserted."
(interactive)
(if (and mh-sent-from-folder
- (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
- (save-excursion (set-buffer mh-sent-from-folder)
- (get-buffer mh-show-buffer))
+ (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)))
(defun mh-folder-expand-at-point ()
"Do folder name completion in Fcc header field."
- (let* ((end (point))
- (beg (mh-beginning-of-word))
- (folder (buffer-substring-no-properties beg end))
- (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
- (choices (mapcar (lambda (x) (list x))
- (mh-folder-completion-function folder nil t))))
- (unless leading-plus
- (setq folder (concat "+" folder)))
- (mh-complete-word folder choices beg end)))
+ (let* ((beg (mh-beginning-of-word))
+ (end (save-excursion
+ (goto-char beg)
+ (mh-beginning-of-word -1))))
+ (when (>= end (point))
+ (list beg (if (fboundp 'completion-at-point) end (point))
+ #'mh-folder-completion-function))))
;;;###mh-autoload
(defun mh-complete-word (word choices begin end)
- "Complete WORD at from CHOICES.
+ "Complete WORD from CHOICES.
Any match found replaces the text from BEGIN to END."
(let ((completion (try-completion word choices))
(completions-buffer "*Completions*"))
((stringp completion)
(if (equal word completion)
(with-output-to-temp-buffer completions-buffer
- (mh-display-completion-list (all-completions word choices)
- word))
+ (mh-display-completion-list
+ (all-completions word choices)
+ ;; The `common-substring' arg only works if it's a prefix.
+ (unless (and (functionp choices)
+ (let ((bounds
+ (funcall choices
+ word nil '(boundaries . ""))))
+ (and (eq 'boundaries (car-safe bounds))
+ (< 0 (cadr bounds)))))
+ word)))
(ignore-errors
(kill-buffer completions-buffer))
(delete-region begin end)
;; sentence-end-double-space: nil
;; End:
-;; arch-tag: 0548632c-aadb-4e3b-bb80-bbd62ff90bf3
;;; mh-letter.el ends here
HCoop / bpt / emacs.git / blobdiff