X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4ffd0d6b569d252e4e807d4e9c9d6a5bd5b08640..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/mh-e/mh-letter.el diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index eebc30aa4c..b4d8b62558 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -1,6 +1,7 @@ ;;; 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 ;; Maintainer: Bill Wohler @@ -66,8 +67,9 @@ Each hook function can find the citation between point and mark. 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") @@ -273,7 +275,8 @@ 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. (put 'mh-letter-mode 'mode-class 'special) @@ -346,6 +349,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) @@ -488,24 +493,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. @@ -515,17 +537,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 () @@ -703,69 +725,71 @@ not inserted. If the option `mh-yank-behavior' is set to one of 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")))) @@ -862,15 +886,13 @@ 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) @@ -889,8 +911,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)