Make MH-E use completion-at-point
* lisp/mh-e/mh-letter.el (mh-letter-completion-at-point): New function, extracted from mh-letter-complete (mh-letter-mode, mh-letter-complete, mh-letter-complete-or-space): Use it. (mh-complete-word): Only use the common-substring arg when it works. (mh-folder-expand-at-point): * lisp/mh-e/mh-alias.el (mh-alias-letter-expand-alias): Return data suitable for completion-at-point-functions. * lisp/mh-e/mh-utils.el (mh-folder-completion-function): Make it work like file-name completion, so partial-completion can do its job. * lisp/minibuffer.el (completion-at-point, completion-help-at-point): Don't presume that a given completion-at-point-function will always use the same calling convention.
This commit is contained in:
Stefan Monnier
parent
d178f87164
commit
d1bb662322
6 changed files with 111 additions and 55 deletions
|
|
@ -1,3 +1,17 @@
|
|||
2011-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* mh-utils.el (mh-folder-completion-function): Make it work like
|
||||
file-name completion, so partial-completion can do its job.
|
||||
|
||||
* mh-letter.el (mh-letter-completion-at-point): New function, extracted
|
||||
from mh-letter-complete
|
||||
(mh-letter-mode, mh-letter-complete, mh-letter-complete-or-space):
|
||||
Use it.
|
||||
(mh-complete-word): Only use the common-substring arg when it works.
|
||||
(mh-folder-expand-at-point):
|
||||
* mh-alias.el (mh-alias-letter-expand-alias): Return data suitable for
|
||||
completion-at-point-functions.
|
||||
|
||||
2011-04-06 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* mh-funcs.el (mh-undo-folder): Accept and ignore arguments,
|
||||
|
|
|
|||
|
|
@ -296,16 +296,28 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(defun mh-alias-letter-expand-alias ()
|
||||
"Expand mail alias before point."
|
||||
(mh-alias-reload-maybe)
|
||||
(let* ((end (point))
|
||||
(begin (mh-beginning-of-word))
|
||||
(input (buffer-substring-no-properties begin end)))
|
||||
(mh-complete-word input mh-alias-alist begin end)
|
||||
(when mh-alias-expand-aliases-flag
|
||||
(let* ((end (point))
|
||||
(expansion (mh-alias-expand (buffer-substring begin end))))
|
||||
(delete-region begin end)
|
||||
(insert expansion)))))
|
||||
|
||||
(let* ((begin (mh-beginning-of-word))
|
||||
(end (save-excursion
|
||||
(goto-char begin)
|
||||
(mh-beginning-of-word -1))))
|
||||
(when (>= end (point))
|
||||
(list
|
||||
begin (if (fboundp 'completion-at-point) end (point))
|
||||
(if (not mh-alias-expand-aliases-flag)
|
||||
mh-alias-alist
|
||||
(lambda (string pred action)
|
||||
(case action
|
||||
((nil)
|
||||
(let ((res (try-completion string mh-alias-alist pred)))
|
||||
(if (or (eq res t)
|
||||
(and (stringp res)
|
||||
(eq t (try-completion res mh-alias-alist pred))))
|
||||
(or (mh-alias-expand (if (stringp res) res string))
|
||||
res)
|
||||
res)))
|
||||
((t) (all-completions string mh-alias-alist pred))
|
||||
((lambda) (if (fboundp 'test-completion)
|
||||
(test-completion string mh-alias-alist pred))))))))))
|
||||
|
||||
|
||||
;;; Alias File Updating
|
||||
|
|
|
|||
|
|
@ -1179,7 +1179,7 @@ lowercase for mailing lists and uppercase for people."
|
|||
"*Non-nil means to expand aliases entered in the minibuffer.
|
||||
|
||||
In other words, aliases entered in the minibuffer will be
|
||||
expanded to the full address in the message draft. By default,
|
||||
expanded to the full address in the message draft. By default,
|
||||
this expansion is not performed."
|
||||
:type 'boolean
|
||||
:group 'mh-alias
|
||||
|
|
|
|||
|
|
@ -185,7 +185,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
|
||||
"\M-\t" mh-letter-complete ;; FIXME: completion-at-point
|
||||
"\t" mh-letter-next-header-field-or-indent
|
||||
[backtab] mh-letter-previous-header-field)
|
||||
|
||||
|
|
@ -346,6 +346,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 +490,38 @@ In a program, you can pass in a signature FILE."
|
|||
(message "No signature found")))))
|
||||
(force-mode-line-update))
|
||||
|
||||
(defun mh-letter-complete (arg)
|
||||
"Perform completion on header field or word preceding point.
|
||||
(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)))
|
||||
|
||||
(defalias 'mh-letter-complete
|
||||
(if (fboundp 'completion-at-point) #'completion-at-point
|
||||
(lambda ()
|
||||
"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.
|
||||
|
|
@ -521,11 +537,12 @@ one space."
|
|||
(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 ()
|
||||
|
|
@ -862,18 +879,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)
|
||||
;; 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))
|
||||
|
|
@ -889,8 +905,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-subtring' 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)
|
||||
|
|
|
|||
|
|
@ -596,6 +596,7 @@ Expects FOLDER to have already been normalized with
|
|||
(setq name (substring name 0 (1- (length name)))))
|
||||
(push
|
||||
(cons name
|
||||
;; FIXME: what is this used for? --Stef
|
||||
(search-forward "(others)" (mh-line-end-position) t))
|
||||
results))))
|
||||
(forward-line 1))))
|
||||
|
|
@ -702,32 +703,33 @@ See Info node `(elisp) Programmed Completion' for details."
|
|||
(remainder (cond (last-complete (substring name (1+ last-slash)))
|
||||
(name (substring name 1))
|
||||
(t ""))))
|
||||
(cond ((eq flag nil)
|
||||
(cond ((eq (car-safe flag) 'boundaries)
|
||||
(list* 'boundaries
|
||||
(let ((slash (mh-search-from-end ?/ orig-name)))
|
||||
(if slash (1+ slash)
|
||||
(if (string-match "\\`\\+" orig-name) 1 0)))
|
||||
(if (cdr flag) (string-match "/" (cdr flag)))))
|
||||
((eq flag nil)
|
||||
(let ((try-res
|
||||
(try-completion
|
||||
name
|
||||
(mapcar (lambda (x)
|
||||
(cons (concat (or last-complete "+") (car x))
|
||||
(cdr x)))
|
||||
(mh-sub-folders last-complete t))
|
||||
remainder
|
||||
(mh-sub-folders last-complete t)
|
||||
predicate)))
|
||||
(cond ((eq try-res nil) nil)
|
||||
((and (eq try-res t) (equal name orig-name)) t)
|
||||
((eq try-res t) name)
|
||||
(t try-res))))
|
||||
(t (concat (or last-complete "+") try-res)))))
|
||||
((eq flag t)
|
||||
(mapcar (lambda (x)
|
||||
(concat (or last-complete "+") x))
|
||||
(all-completions
|
||||
remainder (mh-sub-folders last-complete t) predicate)))
|
||||
(all-completions
|
||||
remainder (mh-sub-folders last-complete t) predicate))
|
||||
((eq flag 'lambda)
|
||||
(let ((path (concat (unless (and (> (length name) 1)
|
||||
(eq (aref name 1) ?/))
|
||||
mh-user-path)
|
||||
(substring name 1))))
|
||||
(cond (mh-allow-root-folder-flag (file-exists-p path))
|
||||
(cond (mh-allow-root-folder-flag (file-directory-p path))
|
||||
((equal path mh-user-path) nil)
|
||||
(t (file-exists-p path))))))))
|
||||
(t (file-directory-p path))))))))
|
||||
|
||||
;; Shush compiler.
|
||||
(defvar completion-root-regexp) ; XEmacs
|
||||
|
|
|
|||
|
|
@ -1377,6 +1377,10 @@ Currently supported properties are:
|
|||
"List of well-behaved functions found on `completion-at-point-functions'.")
|
||||
|
||||
(defun completion--capf-wrapper (fun which)
|
||||
;; FIXME: The safe/misbehave handling assumes that a given function will
|
||||
;; always return the same kind of data, but this breaks down with functions
|
||||
;; like comint-completion-at-point or mh-letter-completion-at-point, which
|
||||
;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
|
||||
(if (case which
|
||||
(all t)
|
||||
(safe (member fun completion--capf-safe-funs))
|
||||
|
|
@ -1408,7 +1412,7 @@ The completion method is determined by `completion-at-point-functions'."
|
|||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(eq (car (funcall hookfun)) start))))
|
||||
(eq (car-safe (funcall hookfun)) start))))
|
||||
(completion-in-region start end collection
|
||||
(plist-get plist :predicate))))
|
||||
;; Maybe completion already happened and the function returned t.
|
||||
|
|
@ -1433,7 +1437,7 @@ The completion method is determined by `completion-at-point-functions'."
|
|||
(completion-in-region-mode-predicate
|
||||
(lambda ()
|
||||
;; We're still in the same completion field.
|
||||
(eq (car (funcall hookfun)) start)))
|
||||
(eq (car-safe (funcall hookfun)) start)))
|
||||
(ol (make-overlay start end nil nil t)))
|
||||
;; FIXME: We should somehow (ab)use completion-in-region-function or
|
||||
;; introduce a corresponding hook (plus another for word-completion,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue