X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2f043267ee5d544100fdf62f54e38b72fdf08216..4ed1626da6e9f060129808273b7b94e3d4f69dc9:/lisp/mh-e/mh-letter.el diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 8b22d7dee0..8aed187334 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -1,7 +1,6 @@ ;;; 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-2012 Free Software Foundation, Inc. ;; Author: Bill Wohler ;; Maintainer: Bill Wohler @@ -10,10 +9,10 @@ ;; 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 @@ -21,9 +20,7 @@ ;; 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 . ;;; Commentary: @@ -276,9 +273,10 @@ searching for `mh-mail-header-separator' in the buffer." ;;; 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 @@ -312,7 +310,8 @@ order). (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 @@ -348,6 +347,8 @@ order). (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) @@ -490,24 +491,41 @@ In a program, you can pass in a signature FILE." (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. @@ -517,17 +535,17 @@ this command to perform completion in the header. Otherwise, a 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 () @@ -618,7 +636,7 @@ a copy of the draft." 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) @@ -648,10 +666,10 @@ Create the field if it does not exist. 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) @@ -659,7 +677,7 @@ Set the mark to point before moving." (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 "[:,]")))) @@ -706,9 +724,9 @@ 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 - (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))) @@ -864,19 +882,17 @@ downcasing the field name." (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*")) @@ -891,8 +907,16 @@ Any match found replaces the text from BEGIN to END." ((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) @@ -960,5 +984,4 @@ Otherwise, simply insert MH-INS-STRING before each line." ;; sentence-end-double-space: nil ;; End: -;; arch-tag: 0548632c-aadb-4e3b-bb80-bbd62ff90bf3 ;;; mh-letter.el ends here