X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/99a33b77e15b9a075024701d060d912b2fd87caf..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/mh-e/mh-letter.el diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 2ced886c05..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") @@ -185,7 +187,7 @@ semi-obsolete and is only used if `mail-citation-hook' is nil.") "\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) @@ -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) @@ -502,10 +505,13 @@ This provides alias and folder completion in header fields according to (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 @@ -521,7 +527,7 @@ alias completion. In the body of the message, this command runs (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. @@ -531,8 +537,7 @@ 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) @@ -720,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")))) @@ -889,7 +896,6 @@ downcasing the field name." ;;;###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)) @@ -907,7 +913,7 @@ Any match found replaces the text from BEGIN to END." (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