(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))))))))))
\f
;;; Alias File Updating
"\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)
(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)
- "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.
(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 ()
(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))
((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)
(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))))
(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
"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))
(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.
(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,
projects / emacs.git / commitdiff