;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(define-key completion-map " " 'minibuffer-complete-word)
(define-key completion-map "?" 'minibuffer-completion-help)
- (define-key must-match-map "\t" 'minibuffer-complete)
- (define-key must-match-map " " 'minibuffer-complete-word)
(define-key must-match-map "\r" 'minibuffer-complete-and-exit)
(define-key must-match-map "\n" 'minibuffer-complete-and-exit)
- (define-key must-match-map "?" 'minibuffer-completion-help)
(define-key global-map [remap lisp-complete-symbol] nil))
(PC-default-bindings
(define-key completion-map "\e\n" 'PC-force-complete-and-exit)
(define-key completion-map "\e?" 'PC-completion-help)
- (define-key must-match-map "\t" 'PC-complete)
- (define-key must-match-map " " 'PC-complete-word)
(define-key must-match-map "\r" 'PC-complete-and-exit)
(define-key must-match-map "\n" 'PC-complete-and-exit)
- (define-key must-match-map "?" 'PC-completion-help)
- (define-key must-match-map "\e\t" 'PC-complete)
- (define-key must-match-map "\e " 'PC-complete-word)
(define-key must-match-map "\e\r" 'PC-complete-and-exit)
(define-key must-match-map "\e\n" 'PC-complete-and-exit)
- (define-key must-match-map "\e?" 'PC-completion-help)
(define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol)))))
(defvar PC-do-completion-end nil
"Internal variable used by `PC-do-completion'.")
+(make-variable-buffer-local 'PC-do-completion-end)
+
(defvar PC-goto-end nil
"Internal variable set in `PC-do-completion', used in
`choose-completion-string-functions'.")
+(make-variable-buffer-local 'PC-goto-end)
+
;;;###autoload
(define-minor-mode partial-completion-mode
"Toggle Partial Completion mode.
(remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
((not PC-disable-includes)
(add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
- ;; ... with some underhand redefining.
- (cond ((not partial-completion-mode)
- (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file)
- (ad-activate 'read-file-name-internal))
- ((not PC-disable-includes)
- (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file)
- (ad-activate 'read-file-name-internal)))
;; Adjust the completion selection in *Completion* buffers to the way
;; we work. The default minibuffer completion code only completes the
;; text before point and leaves the text after point alone (new in
(PC-do-complete-and-exit)))
(defun PC-do-complete-and-exit ()
- (if (= (point-max) (minibuffer-prompt-end)) ; Duplicate the "bug" that Info-menu relies on...
- (exit-minibuffer)
+ (cond
+ ((= (point-max) (minibuffer-prompt-end))
+ ;; Duplicate the "bug" that Info-menu relies on...
+ (exit-minibuffer))
+ ((eq minibuffer-completion-confirm 'confirm-only)
+ (if (or (eq last-command this-command)
+ (test-completion (field-string)
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (exit-minibuffer)
+ (PC-temp-minibuffer-message " [Confirm]")))
+ (t
(let ((flag (PC-do-completion 'exit)))
(and flag
(if (or (eq flag 'complete)
(not minibuffer-completion-confirm))
(exit-minibuffer)
- (PC-temp-minibuffer-message " [Confirm]"))))))
+ (PC-temp-minibuffer-message " [Confirm]")))))))
(defun PC-completion-help ()
GOTO-END is non-nil, however, it instead replaces up to END."
(or beg (setq beg (minibuffer-prompt-end)))
(or end (setq end (point-max)))
- (let* ((table minibuffer-completion-table)
+ (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal)
+ 'PC-read-file-name-internal
+ minibuffer-completion-table))
(pred minibuffer-completion-predicate)
(filename (funcall PC-completion-as-file-name-predicate))
(dirname nil) ; non-nil only if a filename is being completed
env-on
regex
p offset
+ abbreviated
(poss nil)
helpposs
(case-fold-search completion-ignore-case))
(insert str)
(setq end (+ beg (length str)))))
(if origstr
- ;; If the wildcards were introduced by us, it's possible
- ;; that read-file-name-internal (especially our
- ;; PC-include-file advice) can still find matches for the
- ;; original string even if we couldn't, so remove the
- ;; added wildcards.
+ ;; If the wildcards were introduced by us, it's
+ ;; possible that PC-read-file-name-internal can
+ ;; still find matches for the original string
+ ;; even if we couldn't, so remove the added
+ ;; wildcards.
(setq str origstr)
(setq filename nil table nil pred nil)))))
pred nil))
;; Find an initial list of possible completions
- (if (not (setq p (string-match (concat PC-delim-regex
+ (unless (setq p (string-match (concat PC-delim-regex
(if filename "\\|\\*" ""))
str
- (+ (length dirname) offset))))
+ (+ (length dirname) offset)))
;; Minibuffer contains no hyphens -- simple case!
- (setq poss (all-completions (if env-on
- basestr str)
+ (setq poss (all-completions (if env-on basestr str)
table
pred))
-
+ (unless poss
+ ;; Try completion as an abbreviation, e.g. "mvb" ->
+ ;; "m-v-b" -> "multiple-value-bind"
+ (setq origstr str
+ abbreviated t)
+ (if filename
+ (cond
+ ;; "alpha" or "/alpha" -> expand whole path.
+ ((string-match "^/?\\([A-Za-z0-9]+\\)$" str)
+ (setq
+ basestr ""
+ p nil
+ poss (PC-expand-many-files
+ (concat "/"
+ (mapconcat #'list (match-string 1 str) "*/")
+ "*"))
+ beg (1- beg)))
+ ;; Alphanumeric trailer -> expand trailing file
+ ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str)
+ (setq regex (concat "\\`"
+ (mapconcat #'list
+ (match-string 2 str)
+ "[A-Za-z0-9]*[^A-Za-z0-9]"))
+ p (1+ (length (match-string 1 str))))))
+ (setq regex (concat "\\`" (mapconcat #'list str "[^-]*-"))
+ p 1))))
+ (when p
;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C!
(let ((compl (all-completions (if env-on
table
pred)))
(setq p compl)
+ (when (and compl abbreviated)
+ (if filename
+ (progn
+ (setq p nil)
+ (dolist (x compl)
+ (when (string-match regex x)
+ (push x p)))
+ (setq basestr (try-completion "" p)))
+ (setq basestr (mapconcat 'list str "-"))
+ (delete-region beg end)
+ (setq end (+ beg (length basestr)))
+ (insert basestr))))
(while p
(and (string-match regex (car p))
(progn
(set-text-properties 0 (length (car p)) '() (car p))
(setq poss (cons (car p) poss))))
- (setq p (cdr p)))))
+ (setq p (cdr p))))
;; If table had duplicates, they can be here.
(delete-dups poss)
(and p (setq poss p))))
;; Now we have a list of possible completions
+
(cond
;; No valid completions found
(let ((PC-word-failed-flag t))
(delete-backward-char 1)
(PC-do-completion 'word))
+ (when abbreviated
+ (delete-region beg end)
+ (insert origstr))
(beep)
(PC-temp-minibuffer-message (if ambig
" [Ambiguous dir name]"
(let ((prompt-end (minibuffer-prompt-end)))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list (sort helpposs 'string-lessp))
+ (setq PC-do-completion-end end
+ PC-goto-end goto-end)
(with-current-buffer standard-output
;; Record which part of the buffer we are completing
;; so that choosing a completion from the list
;; plays around with point.
(setq completion-base-size (if dirname
dirlength
- (- beg prompt-end))
- PC-do-completion-end end
- PC-goto-end goto-end))))
- (PC-temp-minibuffer-message " [Next char not unique]"))
- nil)))))
+ (- beg prompt-end))))))
+ (PC-temp-minibuffer-message " [Next char not unique]"))
+ ;; Expansion of filenames is not reversible,
+ ;; so just keep the prefix.
+ (when (and abbreviated filename)
+ (delete-region (point) end))
+ nil)))))
;; Only one possible completion
(t
(if (and (equal basestr (car poss))
- (not (and env-on filename)))
+ (not (and env-on filename))
+ (not abbreviated))
(if (null mode)
(PC-temp-minibuffer-message " [Sole completion]"))
(delete-region beg end)
Otherwise, all symbols with function definitions, values
or properties are considered."
(interactive)
- (let* ((end (point))
- ;; To complete the word under point, rather than just the portion
- ;; before point, use this:
-;;; (save-excursion
-;;; (with-syntax-table lisp-mode-syntax-table
-;;; (forward-sexp 1)
-;;; (point))))
+ (let* ((end
+ (save-excursion
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "_w")
+ (point))))
(beg (save-excursion
(with-syntax-table lisp-mode-syntax-table
(backward-sexp 1)
(point-min) t)
(+ (point) 2)
(point-min)))
- (minibuffer-completion-table 'read-file-name-internal)
+ (minibuffer-completion-table 'PC-read-file-name-internal)
(minibuffer-completion-predicate "")
(PC-not-minibuffer t))
(goto-char end)
(setq sorted (cdr sorted)))
compressed))))
-(defadvice read-file-name-internal (around PC-include-file disable)
- (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0))
- (let* ((string (ad-get-arg 0))
- (action (ad-get-arg 2))
- (name (match-string 1 string))
+(defun PC-read-file-name-internal (string dir action)
+ "Extend `read-file-name-internal' to handle include files.
+This is only used by "
+ (if (string-match "<\\([^\"<>]*\\)>?\\'" string)
+ (let* ((name (match-string 1 string))
(str2 (substring string (match-beginning 0)))
(completion-table
(mapcar (lambda (x)
(format (if (string-match "/\\'" x) "<%s" "<%s>") x))
(PC-include-file-all-completions
name (PC-include-file-path)))))
- (setq ad-return-value
(cond
((not completion-table) nil)
((eq action 'lambda) (test-completion str2 completion-table nil))
((eq action nil) (PC-try-completion str2 completion-table nil))
- ((eq action t) (all-completions str2 completion-table nil)))))
- ad-do-it))
+ ((eq action t) (all-completions str2 completion-table nil))))
+ (read-file-name-internal string dir action)))
\f
(provide 'complete)