diff options
author | Kenichi Handa <handa@gnu.org> | 2013-09-08 21:17:12 +0900 |
---|---|---|
committer | Kenichi Handa <handa@gnu.org> | 2013-09-08 21:17:12 +0900 |
commit | 3aff2f57cc348b90c0f8b5926027cd0f0f378070 (patch) | |
tree | ff714b2645779c262a714ed7ae1d97a155d21438 /lisp | |
parent | 0ca754d0d8df545ce4c09d65a337f67213e2f82b (diff) | |
parent | e8dd0787d9c19e81344552d185e9008031f58723 (diff) | |
download | emacs-3aff2f57cc348b90c0f8b5926027cd0f0f378070.tar.gz |
merge trunk
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ChangeLog | 139 | ||||
-rw-r--r-- | lisp/abbrev.el | 19 | ||||
-rw-r--r-- | lisp/arc-mode.el | 23 | ||||
-rw-r--r-- | lisp/dired-x.el | 32 | ||||
-rw-r--r-- | lisp/dired.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/crm.el | 62 | ||||
-rw-r--r-- | lisp/epa.el | 71 | ||||
-rw-r--r-- | lisp/epg.el | 5 | ||||
-rw-r--r-- | lisp/icomplete.el | 24 | ||||
-rw-r--r-- | lisp/info.el | 11 | ||||
-rw-r--r-- | lisp/minibuffer.el | 225 | ||||
-rw-r--r-- | lisp/net/tramp-gvfs.el | 6 | ||||
-rw-r--r-- | lisp/net/tramp.el | 107 | ||||
-rw-r--r-- | lisp/progmodes/cc-engine.el | 54 | ||||
-rw-r--r-- | lisp/progmodes/cc-langs.el | 5 | ||||
-rw-r--r-- | lisp/progmodes/ruby-mode.el | 4 | ||||
-rw-r--r-- | lisp/replace.el | 9 | ||||
-rw-r--r-- | lisp/textmodes/bibtex.el | 2 |
18 files changed, 453 insertions, 347 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 30d00750926..e919a8407ec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -3,6 +3,121 @@ * international/characters.el: Set category "^" (Combining) for more characters. +2013-09-07 Alan Mackenzie <acm@muc.de> + + Correctly fontify Java class constructors. + * progmodes/cc-langs.el (c-type-decl-suffix-key): Now matches ")" + in Java Mode. + (c-recognize-typeless-decls): Set the Java value to t. + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): While + handling a "(", add a check for, effectively, Java, and handle a + "typeless" declaration there. + +2013-09-07 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-biblatex-entry-alist): Add optional + field subtitle for entry type book. + +2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el: Make minibuffer-complete call completion-in-region + rather than other way around. + (completion--some, completion-pcm--find-all-completions): + Don't delay signals when debugging. + (minibuffer-completion-contents): Beware fields within the + minibuffer contents. + (completion-all-sorted-completions): Use defvar-local. + (completion--do-completion, completion--cache-all-sorted-completions) + (completion-all-sorted-completions, minibuffer-force-complete): + Add args `beg' and `end'. + (completion--in-region-1): New fun, extracted from minibuffer-complete. + (minibuffer-complete): Use completion-in-region. + (completion-complete-and-exit): New fun, extracted from + minibuffer-complete-and-exit. + (minibuffer-complete-and-exit): Use it. + (completion--complete-and-exit): Rename from + minibuffer--complete-and-exit. + (completion-in-region--single-word): New function, extracted from + minibuffer-complete-word. + (minibuffer-complete-word): Use it. + (display-completion-list): Make `common-substring' argument obsolete. + (completion--in-region): Call completion--in-region-1 instead of + minibuffer-complete. + (completion-help-at-point): Pass boundaries to + minibuffer-completion-help as args rather than via an overlay. + (completion-pcm--string->pattern): Use `any-delim'. + (completion-pcm--optimize-pattern): New function. + (completion-pcm--pattern->regex): Handle `any-delim'. + * icomplete.el (icomplete-forward-completions) + (icomplete-backward-completions, icomplete-completions): + Adjust calls to completion-all-sorted-completions and + completion--cache-all-sorted-completions. + (icomplete-with-completion-tables): Default to t. + * emacs-lisp/crm.el (crm--current-element): Rename from + crm--select-current-element. Don't put an overlay but return the + boundaries instead. + (crm--completion-command): Take two new args to bind to the boundaries. + (crm-completion-help): Adjust accordingly. + (crm-complete): Use completion-in-region. + (crm-complete-word): Use completion-in-region--single-word. + (crm-complete-and-exit): Use completion-complete-and-exit. + +2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * dired-x.el (dired-mark-sexp): Bind the vars lexically rather + than dynamically. + +2013-09-06 Juri Linkov <juri@jurta.org> + + * info.el (Info-display-images-node): When image file doesn't exist + display text version of the image if it's provided in the Info file. + Otherwise, display the location of missing image from SRC attribute. + Add help-echo text property from ALT attribute. (Bug#15279) + +2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * abbrev.el (edit-abbrevs-mode-map): Rename from edit-abbrevs-map. + (edit-abbrevs-mode): Use define-derived-mode. + + * epa.el (epa--encode-coding-string, epa--decode-coding-string) + (epa--select-safe-coding-system, epa--derived-mode-p): Make it obvious + that it's defined. + (epa-key-list-mode, epa-key-mode, epa-info-mode): + Use define-derived-mode. + + * epg.el (epg-start-encrypt): Minor CSE simplification. + +2013-09-06 William Xu <william.xwl@gmail.com> + + * arc-mode.el: Add support for 7za (bug#15264). + (archive-7z-program): New var. + (archive-zip-extract, archive-zip-expunge, archive-zip-update) + (archive-zip-update-case, archive-7z-extract, archive-7z-expunge) + (archive-7z-update, archive-zip-extract, archive-7z-summarize): Use it. + +2013-09-06 Michael Albinus <michael.albinus@gmx.de> + + Remove URL syntax. + + * net/tramp.el (tramp-syntax, tramp-prefix-format) + (tramp-postfix-method-format, tramp-prefix-ipv6-format) + (tramp-postfix-ipv6-format, tramp-prefix-port-format) + (tramp-postfix-host-format, tramp-file-name-regexp) + (tramp-completion-file-name-regexp) + (tramp-completion-dissect-file-name) + (tramp-handle-substitute-in-file-name): Remove 'url case. + (tramp-file-name-regexp-url) + (tramp-completion-file-name-regexp-url): Remove constants. + +2013-09-06 Glenn Morris <rgm@gnu.org> + + * replace.el (replace-string): Doc fix re start/end. (Bug#15275) + +2013-09-05 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move "Perl-ish + keywords" below "here-doc beginnings" (Bug#15270). + 2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (pop): Use `car-safe'. @@ -64,6 +179,30 @@ 2013-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + * vc/vc-dispatcher.el (vc-run-delayed): New macro. + (vc-do-command, vc-set-async-update): + * vc/vc-mtn.el (vc-mtn-dir-status): + * vc/vc-hg.el (vc-hg-dir-status, vc-hg-dir-status-files) + (vc-hg-pull, vc-hg-merge-branch): + * vc/vc-git.el (vc-git-dir-status-goto-stage, vc-git-pull) + (vc-git-merge-branch): + * vc/vc-cvs.el (vc-cvs-print-log, vc-cvs-dir-status) + (vc-cvs-dir-status-files): + * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch, vc-bzr-dir-status) + (vc-bzr-dir-status-files): + * vc/vc-arch.el (vc-arch-dir-status): Use vc-run-delayed. + * vc/vc-annotate.el: Use lexical-binding. + (vc-annotate-display-select, vc-annotate): Use vc-run-delayed. + (vc-sentinel-movepoint): Declare. + (vc-annotate): Don't use `goto-line'. + * vc/vc.el (vc-diff-internal): Prefer a closure to `(lambda...). + (vc-diff-internal, vc-log-internal-common): Use vc-run-delayed. + (vc-sentinel-movepoint): Declare. + * vc/vc-svn.el: Use lexical-binding. + (vc-svn-dir-status, vc-svn-dir-status-files): Use vc-run-delayed. + * vc/vc-sccs.el: + * vc/vc-rcs.el: Use lexical-binding. + * autorevert.el (auto-revert-notify-handler): Explicitly ignore `deleted'. Don't drop errors silently. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index d82e2eabd84..d7d4482693d 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -67,13 +67,15 @@ be replaced by its expansion." (put 'abbrev-mode 'safe-local-variable 'booleanp) -(defvar edit-abbrevs-map +(defvar edit-abbrevs-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer) (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file) (define-key map "\C-c\C-c" 'edit-abbrevs-redefine) map) "Keymap used in `edit-abbrevs'.") +(define-obsolete-variable-alias 'edit-abbrevs-map + 'edit-abbrevs-mode-map "24.4") (defun kill-all-abbrevs () "Undefine all defined abbrevs." @@ -144,16 +146,6 @@ Otherwise display all abbrevs." (set-buffer-modified-p nil) (current-buffer)))) -(defun edit-abbrevs-mode () - "Major mode for editing the list of abbrev definitions. -\\{edit-abbrevs-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'edit-abbrevs-mode) - (setq mode-name "Edit-Abbrevs") - (use-local-map edit-abbrevs-map) - (run-mode-hooks 'edit-abbrevs-mode-hook)) - (defun edit-abbrevs () "Alter abbrev definitions by editing a list of them. Selects a buffer containing a list of abbrev definitions with @@ -1013,6 +1005,11 @@ SORTFUN is passed to `sort' to change the default ordering." (sort entries (lambda (x y) (funcall sortfun (nth 2 x) (nth 2 y))))))) +;; Keep it after define-abbrev-table, since define-derived-mode uses +;; define-abbrev-table. +(define-derived-mode edit-abbrevs-mode special-mode "Edit-Abbrevs" + "Major mode for editing the list of abbrev definitions.") + (provide 'abbrev) ;;; abbrev.el ends here diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 5f001ad977b..a4f7015c844 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -218,9 +218,14 @@ Archive and member name will be added." ;; ------------------------------ ;; Zip archive configuration +(defvar archive-7z-program (let ((7z (or (executable-find "7z") + (executable-find "7za")))) + (when 7z + (file-name-nondirectory 7z)))) + (defcustom archive-zip-extract (cond ((executable-find "unzip") '("unzip" "-qq" "-c")) - ((executable-find "7z") '("7z" "x" "-so")) + (archive-7z-program `(,archive-7z-program "x" "-so")) ((executable-find "pkunzip") '("pkunzip" "-e" "-o-")) (t '("unzip" "-qq" "-c"))) "Program and its options to run in order to extract a zip file member. @@ -239,7 +244,7 @@ be added." (defcustom archive-zip-expunge (cond ((executable-find "zip") '("zip" "-d" "-q")) - ((executable-find "7z") '("7z" "d")) + (archive-7z-program `(,archive-7z-program "d")) ((executable-find "pkzip") '("pkzip" "-d")) (t '("zip" "-d" "-q"))) "Program and its options to run in order to delete zip file members. @@ -252,7 +257,7 @@ Archive and member names will be added." (defcustom archive-zip-update (cond ((executable-find "zip") '("zip" "-q")) - ((executable-find "7z") '("7z" "u")) + (archive-7z-program `(,archive-7z-program "u")) ((executable-find "pkzip") '("pkzip" "-u" "-P")) (t '("zip" "-q"))) "Program and its options to run in order to update a zip file member. @@ -266,7 +271,7 @@ file. Archive and member name will be added." (defcustom archive-zip-update-case (cond ((executable-find "zip") '("zip" "-q" "-k")) - ((executable-find "7z") '("7z" "u")) + (archive-7z-program `(,archive-7z-program "u")) ((executable-find "pkzip") '("pkzip" "-u" "-P")) (t '("zip" "-q" "-k"))) "Program and its options to run in order to update a case fiddled zip member. @@ -321,7 +326,7 @@ Archive and member name will be added." ;; 7z archive configuration (defcustom archive-7z-extract - '("7z" "x" "-so") + `(,archive-7z-program "x" "-so") "Program and its options to run in order to extract a 7z file member. Extraction should happen to standard output. Archive and member name will be added." @@ -333,7 +338,7 @@ be added." :group 'archive-7z) (defcustom archive-7z-expunge - '("7z" "d") + `(,archive-7z-program "d") "Program and its options to run in order to delete 7z file members. Archive and member names will be added." :version "24.1" @@ -344,7 +349,7 @@ Archive and member names will be added." :group 'archive-7z) (defcustom archive-7z-update - '("7z" "u") + `(,archive-7z-program "u") "Program and its options to run in order to update a 7z file member. Options should ensure that specified directory will be put into the 7z file. Archive and member name will be added." @@ -1864,7 +1869,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (cond ((member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip")) (archive-*-extract archive name archive-zip-extract)) - ((equal (car archive-zip-extract) "7z") + ((equal (car archive-zip-extract) archive-7z-program) (let ((archive-7z-extract archive-zip-extract)) (archive-7z-extract archive name))) (t @@ -2088,7 +2093,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (file buffer-file-name) (files ())) (with-temp-buffer - (call-process "7z" nil t nil "l" "-slt" file) + (call-process archive-7z-program nil t nil "l" "-slt" file) (goto-char (point-min)) ;; Four dashes start the meta info section that should be skipped. ;; Archive members start with more than four dashes. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 3527a3fc756..c6ecbf1e718 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1,4 +1,4 @@ -;;; dired-x.el --- extra Dired functionality +;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 1997, 2001-2013 Free Software Foundation, ;; Inc. @@ -1185,7 +1185,7 @@ results in (setq count (1+ count) start (1+ start))) ;; ... and prepend a "../" for each slash found: - (dotimes (n count) + (dotimes (_ count) (setq name1 (concat "../" name1))))) (make-symbolic-link (directory-file-name name1) ; must not link to foo/ @@ -1397,22 +1397,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent." ;; Does anyone use this? - lrd 6/29/93. ;; Apparently people do use it. - lrd 12/22/97. -(with-no-warnings - ;; Warnings are suppressed to avoid "global/dynamic var `X' lacks a prefix". - ;; This is unbearably ugly, but not more than having global variables - ;; named size, time, name or s, however practical it can be while writing - ;; `dired-mark-sexp' predicates. - (defvar inode) - (defvar s) - (defvar mode) - (defvar nlink) - (defvar uid) - (defvar gid) - (defvar size) - (defvar time) - (defvar name) - (defvar sym)) - (defun dired-mark-sexp (predicate &optional unflag-p) "Mark files for which PREDICATE returns non-nil. With a prefix arg, unmark or unflag those files instead. @@ -1505,7 +1489,17 @@ to mark all zero length files." (line-end-position)) "")) t) - (eval predicate))) + (eval predicate + `((inode . ,inode) + (s . ,s) + (mode . ,mode) + (nlink . ,nlink) + (uid . ,uid) + (gid . ,gid) + (size . ,size) + (time . ,time) + (name . ,name) + (sym . ,sym))))) (format "'%s file" predicate)))) diff --git a/lisp/dired.el b/lisp/dired.el index b9f974234fb..f873aea9bf0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4352,7 +4352,7 @@ instead. ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "130484d4c94bb9929c210774f9e475f5") +;;;### (autoloads nil "dired-x" "dired-x.el" "1bf4009b81e55bf51947bc87b2c82994") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index b8e327625e7..750e0709591 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -157,33 +157,32 @@ Functions'." predicate flag))) -(defun crm--select-current-element () +(defun crm--current-element () "Parse the minibuffer to find the current element. -Place an overlay on the element, with a `field' property, and return it." - (let* ((bob (minibuffer-prompt-end)) - (start (save-excursion +Return the element's boundaries as (START . END)." + (let ((bob (minibuffer-prompt-end))) + (cons (save-excursion (if (re-search-backward crm-separator bob t) (match-end 0) - bob))) - (end (save-excursion + bob)) + (save-excursion (if (re-search-forward crm-separator nil t) (match-beginning 0) - (point-max)))) - (ol (make-overlay start end nil nil t))) - (overlay-put ol 'field (make-symbol "crm")) - ol)) - -(defmacro crm--completion-command (command) - "Make COMMAND a completion command for `completing-read-multiple'." - `(let ((ol (crm--select-current-element))) - (unwind-protect - ,command - (delete-overlay ol)))) + (point-max)))))) + +(defmacro crm--completion-command (beg end &rest body) + "Run BODY with BEG and END bound to the current element's boundaries." + (declare (indent 2) (debug (sexp sexp &rest body))) + `(let* ((crm--boundaries (crm--current-element)) + (,beg (car crm--boundaries)) + (,end (cdr crm--boundaries))) + ,@body)) (defun crm-completion-help () "Display a list of possible completions of the current minibuffer element." (interactive) - (crm--completion-command (minibuffer-completion-help)) + (crm--completion-command beg end + (minibuffer-completion-help beg end)) nil) (defun crm-complete () @@ -192,13 +191,18 @@ If no characters can be completed, display a list of possible completions. Return t if the current element is now a valid match; otherwise return nil." (interactive) - (crm--completion-command (minibuffer-complete))) + (crm--completion-command beg end + (completion-in-region beg end + minibuffer-completion-table + minibuffer-completion-predicate))) (defun crm-complete-word () "Complete the current element at most a single word. Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) - (crm--completion-command (minibuffer-complete-word))) + (crm--completion-command beg end + (completion-in-region--single-word + beg end minibuffer-completion-table minibuffer-completion-predicate))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. @@ -211,16 +215,14 @@ This function is modeled after `minibuffer-complete-and-exit'." (goto-char (minibuffer-prompt-end)) (while (and doexit - (let ((ol (crm--select-current-element))) - (goto-char (overlay-end ol)) - (unwind-protect - (catch 'exit - (minibuffer-complete-and-exit) - ;; This did not throw `exit', so there was a problem. - (setq doexit nil)) - (goto-char (overlay-end ol)) - (delete-overlay ol)) - (not (eobp))) + (crm--completion-command beg end + (let ((end (copy-marker end t))) + (goto-char end) + (setq doexit nil) + (completion-complete-and-exit beg end + (lambda () (setq doexit t))) + (goto-char end) + (not (eobp)))) (looking-at crm-separator)) ;; Skip to the next element. (goto-char (match-end 0))) diff --git a/lisp/epa.el b/lisp/epa.el index a99fb9230e1..1b06e6ca3bf 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -268,62 +268,40 @@ You should bind this variable with `let', but do not set it globally.") (epg-sub-key-id (car (epg-key-sub-key-list (widget-get widget :value)))))) -(eval-and-compile - (if (fboundp 'encode-coding-string) - (defalias 'epa--encode-coding-string 'encode-coding-string) - (defalias 'epa--encode-coding-string 'identity))) +(defalias 'epa--encode-coding-string + (if (fboundp 'encode-coding-string) #'encode-coding-string #'identity)) -(eval-and-compile - (if (fboundp 'decode-coding-string) - (defalias 'epa--decode-coding-string 'decode-coding-string) - (defalias 'epa--decode-coding-string 'identity))) +(defalias 'epa--decode-coding-string + (if (fboundp 'decode-coding-string) #'decode-coding-string #'identity)) -(defun epa-key-list-mode () +(define-derived-mode epa-key-list-mode special-mode "Keys" "Major mode for `epa-list-keys'." - (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'epa-key-list-mode - mode-name "Keys" - truncate-lines t + (setq truncate-lines t buffer-read-only t) - (use-local-map epa-key-list-mode-map) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(epa-font-lock-keywords t)) + (setq-local font-lock-defaults '(epa-font-lock-keywords t)) ;; In XEmacs, auto-initialization of font-lock is not effective ;; if buffer-file-name is not set. (font-lock-set-defaults) (make-local-variable 'epa-exit-buffer-function) - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'epa--key-list-revert-buffer) - (run-mode-hooks 'epa-key-list-mode-hook)) + (setq-local revert-buffer-function #'epa--key-list-revert-buffer)) -(defun epa-key-mode () +(define-derived-mode epa-key-mode special-mode "Key" "Major mode for a key description." - (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'epa-key-mode - mode-name "Key" - truncate-lines t + (setq truncate-lines t buffer-read-only t) - (use-local-map epa-key-mode-map) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(epa-font-lock-keywords t)) + (setq-local font-lock-defaults '(epa-font-lock-keywords t)) ;; In XEmacs, auto-initialization of font-lock is not effective ;; if buffer-file-name is not set. (font-lock-set-defaults) - (make-local-variable 'epa-exit-buffer-function) - (run-mode-hooks 'epa-key-mode-hook)) + (make-local-variable 'epa-exit-buffer-function)) -(defun epa-info-mode () +(define-derived-mode epa-info-mode special-mode "Info" "Major mode for `epa-info-buffer'." - (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'epa-info-mode - mode-name "Info" - truncate-lines t - buffer-read-only t) - (use-local-map epa-info-mode-map) - (run-mode-hooks 'epa-info-mode-hook)) + (setq truncate-lines t + buffer-read-only t)) (defun epa-mark-key (&optional arg) "Mark a key on the current line. @@ -951,10 +929,10 @@ See the reason described in the `epa-verify-region' documentation." (error "No cleartext tail")) (epa-verify-region cleartext-start cleartext-end)))))) -(eval-and-compile +(defalias 'epa--select-safe-coding-system (if (fboundp 'select-safe-coding-system) - (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) - (defun epa--select-safe-coding-system (_from _to) + #'select-safe-coding-system + (lambda (_from _to) buffer-file-coding-system))) ;;;###autoload @@ -1026,16 +1004,16 @@ If no one is selected, default secret key is used. " 'start-open t 'end-open t))))) -(eval-and-compile +(defalias 'epa--derived-mode-p (if (fboundp 'derived-mode-p) - (defalias 'epa--derived-mode-p 'derived-mode-p) - (defun epa--derived-mode-p (&rest modes) + #'derived-mode-p + (lambda (&rest modes) "Non-nil if the current major mode is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards." (let ((parent major-mode)) - (while (and (not (memq parent modes)) - (setq parent (get parent 'derived-mode-parent)))) - parent)))) + (while (and (not (memq parent modes)) + (setq parent (get parent 'derived-mode-parent)))) + parent)))) ;;;###autoload (defun epa-encrypt-region (start end recipients sign signers) @@ -1138,6 +1116,7 @@ If no one is selected, symmetric encryption will be performed. ") (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string (epg-context-result-for context 'import)))) + ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p? (if (eq major-mode 'epa-key-list-mode) (apply #'epa--list-keys epa-list-keys-arguments)))) diff --git a/lisp/epg.el b/lisp/epg.el index bcd91d8abba..c733a273988 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -2415,9 +2415,8 @@ If you are unsure, use synchronous version of this function (list "--" (epg-data-file plain))))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) - (if sign - (epg-wait-for-status context '("BEGIN_SIGNING")) - (epg-wait-for-status context '("BEGIN_ENCRYPTION")))) + (epg-wait-for-status context + (if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION")))) (when (epg-data-string plain) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 104e3363831..9aec829cd97 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -158,11 +158,13 @@ minibuffer completion.") (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) ;;;_ = icomplete-with-completion-tables -(defvar icomplete-with-completion-tables '(internal-complete-buffer) +(defcustom icomplete-with-completion-tables t "Specialized completion tables with which icomplete should operate. Icomplete does not operate with any specialized completion tables -except those on this list.") +except those on this list." + :type '(choice (const :tag "All" t) + (repeat function))) (defvar icomplete-minibuffer-map (let ((map (make-sparse-keymap))) @@ -177,24 +179,28 @@ except those on this list.") Second entry becomes the first and can be selected with `minibuffer-force-complete-and-exit'." (interactive) - (let* ((comps (completion-all-sorted-completions)) + (let* ((beg (minibuffer-prompt-end)) + (end (point-max)) + (comps (completion-all-sorted-completions beg end)) (last (last comps))) (when comps (setcdr last (cons (car comps) (cdr last))) - (completion--cache-all-sorted-completions (cdr comps))))) + (completion--cache-all-sorted-completions beg end (cdr comps))))) (defun icomplete-backward-completions () "Step backward completions by one entry. Last entry becomes the first and can be selected with `minibuffer-force-complete-and-exit'." (interactive) - (let* ((comps (completion-all-sorted-completions)) + (let* ((beg (minibuffer-prompt-end)) + (end (point-max)) + (comps (completion-all-sorted-completions beg end)) (last-but-one (last comps 2)) (last (cdr last-but-one))) (when (consp last) ; At least two elements in comps (setcdr last-but-one (cdr last)) (push (car last) comps) - (completion--cache-all-sorted-completions comps)))) + (completion--cache-all-sorted-completions beg end comps)))) ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload @@ -263,7 +269,8 @@ and `minibuffer-setup-hook'." "Insert icomplete completions display. Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." - (when (and icomplete-mode (icomplete-simple-completing-p)) + (when (and icomplete-mode + (icomplete-simple-completing-p)) ;Shouldn't be necessary. (save-excursion (goto-char (point-max)) ; Insert the match-status information: @@ -319,7 +326,8 @@ matches exist. \(Keybindings for uniquely matched commands are exhibited within the square braces.)" (let* ((md (completion--field-metadata (field-beginning))) - (comps (completion-all-sorted-completions)) + (comps (completion-all-sorted-completions + (minibuffer-prompt-end) (point-max))) (last (if (consp comps) (last comps))) (base-size (cdr last)) (open-bracket (if require-match "(" "[")) diff --git a/lisp/info.el b/lisp/info.el index 182ad8563aa..65cd7eddcfd 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1595,17 +1595,20 @@ escaped (\\\",\\\\)." "")) (image (if (file-exists-p image-file) (create-image image-file) - "[broken image]"))) + (or (cdr (assoc-string "text" parameter-alist)) + (and src (concat "[broken image:" src "]")) + "[broken image]")))) (if (not (get-text-property start 'display)) (add-text-properties - start (point) `(display ,image rear-nonsticky (display))))) + start (point) + `(display ,image rear-nonsticky (display) + help-echo ,(cdr (assoc-string "alt" parameter-alist)))))) ;; text-only display, show alternative text if provided, or ;; otherwise a clue that there's meant to be a picture (delete-region start (point)) (insert (or (cdr (assoc-string "text" parameter-alist)) (cdr (assoc-string "alt" parameter-alist)) - (and src - (concat "[image:" src "]")) + (and src (concat "[image:" src "]")) "[image]")))))) (set-buffer-modified-p nil))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e07d28a54d0..c505a74c23d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -38,7 +38,7 @@ ;;; Bugs: -;; - completion-all-sorted-completions list all the completions, whereas +;; - completion-all-sorted-completions lists all the completions, whereas ;; it should only lists the ones that `try-completion' would consider. ;; E.g. it should honor completion-ignored-extensions. ;; - choose-completion can't automatically figure out the boundaries @@ -145,7 +145,7 @@ Like CL's `some'." (let ((firsterror nil) res) (while (and (not res) xs) - (condition-case err + (condition-case-unless-debug err (setq res (funcall fun (pop xs))) (error (unless firsterror (setq firsterror err)) nil))) (or res @@ -623,7 +623,8 @@ If ARGS are provided, then pass MESSAGE through `format'." (message nil))) ;; Clear out any old echo-area message to make way for our new thing. (message nil) - (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) + (setq message (if (and (null args) + (string-match-p "\\` *\\[.+\\]\\'" message)) ;; Make sure we can put-text-property. (copy-sequence message) (concat " [" message "]"))) @@ -651,7 +652,7 @@ If ARGS are provided, then pass MESSAGE through `format'." "Return the user input in a minibuffer before point as a string. In Emacs-22, that was what completion commands operated on." (declare (obsolete nil "24.4")) - (buffer-substring (field-beginning) (point))) + (buffer-substring (minibuffer-prompt-end) (point))) (defun delete-minibuffer-contents () "Delete all user input in a minibuffer. @@ -670,8 +671,7 @@ If the value is t the *Completion* buffer is displayed whenever completion is requested but cannot be done. If the value is `lazy', the *Completions* buffer is only displayed after the second failed attempt to complete." - :type '(choice (const nil) (const t) (const lazy)) - :group 'minibuffer) + :type '(choice (const nil) (const t) (const lazy))) (defconst completion-styles-alist '((emacs21 @@ -750,7 +750,6 @@ The available styles are listed in `completion-styles-alist'. Note that `completion-category-overrides' may override these styles for specific categories, such as files, buffers, etc." :type completion--styles-type - :group 'minibuffer :version "23.1") (defcustom completion-category-overrides @@ -880,7 +879,7 @@ Moves point to the end of the new text." (defcustom completion-cycle-threshold nil "Number of completion candidates below which cycling is used. -Depending on this setting `minibuffer-complete' may use cycling, +Depending on this setting `completion-in-region' may use cycling, like `minibuffer-force-complete'. If nil, cycling is never used. If t, cycling is always used. @@ -894,8 +893,7 @@ completion candidates than this number." (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) (if over (cdr over) completion-cycle-threshold))) -(defvar completion-all-sorted-completions nil) -(make-variable-buffer-local 'completion-all-sorted-completions) +(defvar-local completion-all-sorted-completions nil) (defvar-local completion--all-sorted-completions-location nil) (defvar completion-cycling nil) @@ -906,8 +904,8 @@ completion candidates than this number." (if completion-show-inline-help (minibuffer-message msg))) -(defun completion--do-completion (&optional try-completion-function - expect-exact) +(defun completion--do-completion (beg end &optional + try-completion-function expect-exact) "Do the completion and return a summary of what happened. M = completion was performed, the text was Modified. C = there were available Completions. @@ -926,9 +924,7 @@ E = after completion we now have an Exact match. TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'. EXPECT-EXACT, if non-nil, means that there is no need to tell the user when the buffer's text is already an exact match." - (let* ((beg (field-beginning)) - (end (field-end)) - (string (buffer-substring beg end)) + (let* ((string (buffer-substring beg end)) (md (completion--field-metadata beg)) (comp (funcall (or try-completion-function 'completion-try-completion) @@ -963,7 +959,8 @@ when the buffer's text is already an exact match." (if unchanged (goto-char end) ;; Insert in minibuffer the chars we got. - (completion--replace beg end completion)) + (completion--replace beg end completion) + (setq end (+ beg (length completion)))) ;; Move point to its completion-mandated destination. (forward-char (- comp-pos (length completion))) @@ -972,7 +969,8 @@ when the buffer's text is already an exact match." ;; whether this is a unique completion or not, so try again using ;; the real case (this shouldn't recurse again, because the next ;; time try-completion will return either t or the exact string). - (completion--do-completion try-completion-function expect-exact) + (completion--do-completion beg end + try-completion-function expect-exact) ;; It did find a match. Do we match some possibility exactly now? (let* ((exact (test-completion completion @@ -995,7 +993,7 @@ when the buffer's text is already an exact match." minibuffer-completion-predicate "")) comp-pos))) - (completion-all-sorted-completions)))) + (completion-all-sorted-completions beg end)))) (completion--flush-all-sorted-completions) (cond ((and (consp (cdr comps)) ;; There's something to cycle. @@ -1006,8 +1004,8 @@ when the buffer's text is already an exact match." ;; Not more than completion-cycle-threshold remaining ;; completions: let's cycle. (setq completed t exact t) - (completion--cache-all-sorted-completions comps) - (minibuffer-force-complete)) + (completion--cache-all-sorted-completions beg end comps) + (minibuffer-force-complete beg end)) (completed ;; We could also decide to refresh the completions, ;; if they're displayed (and assuming there are @@ -1024,14 +1022,14 @@ when the buffer's text is already an exact match." (if (pcase completion-auto-help (`lazy (eq this-command last-command)) (_ completion-auto-help)) - (minibuffer-completion-help) + (minibuffer-completion-help beg end) (completion--message "Next char not unique"))) ;; If the last exact completion and this one were the same, it ;; means we've already given a "Complete, but not unique" message ;; and the user's hit TAB again, so now we give him help. (t (if (and (eq this-command last-command) completion-auto-help) - (minibuffer-completion-help)) + (minibuffer-completion-help beg end)) (completion--done completion 'exact (unless expect-exact "Complete, but not unique")))) @@ -1045,6 +1043,11 @@ If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." (interactive) + (completion-in-region (minibuffer-prompt-end) (point-max) + minibuffer-completion-table + minibuffer-completion-predicate)) + +(defun completion--in-region-1 (beg end) ;; If the previous command was not this, ;; mark the completion buffer obsolete. (setq this-command 'completion-at-point) @@ -1067,17 +1070,17 @@ scroll the window of possible completions." nil))) ;; If we're cycling, keep on cycling. ((and completion-cycling completion-all-sorted-completions) - (minibuffer-force-complete) + (minibuffer-force-complete beg end) t) - (t (pcase (completion--do-completion) + (t (pcase (completion--do-completion beg end) (#b000 nil) (_ t))))) -(defun completion--cache-all-sorted-completions (comps) +(defun completion--cache-all-sorted-completions (beg end comps) (add-hook 'after-change-functions 'completion--flush-all-sorted-completions nil t) (setq completion--all-sorted-completions-location - (cons (copy-marker (field-beginning)) (copy-marker (field-end)))) + (cons (copy-marker beg) (copy-marker end))) (setq completion-all-sorted-completions comps)) (defun completion--flush-all-sorted-completions (&optional start end _len) @@ -1097,10 +1100,10 @@ scroll the window of possible completions." (if (eq (car bounds) base) md-at-point (completion-metadata (substring string 0 base) table pred)))) -(defun completion-all-sorted-completions () +(defun completion-all-sorted-completions (start end) (or completion-all-sorted-completions - (let* ((start (field-beginning)) - (end (field-end)) + (let* ((start (or start (minibuffer-prompt-end))) + (end (or end (point-max))) (string (buffer-substring start end)) (md (completion--field-metadata start)) (all (completion-all-completions @@ -1138,18 +1141,20 @@ scroll the window of possible completions." ;; Cache the result. This is not just for speed, but also so that ;; repeated calls to minibuffer-force-complete can cycle through ;; all possibilities. - (completion--cache-all-sorted-completions (nconc all base-size)))))) + (completion--cache-all-sorted-completions + start end (nconc all base-size)))))) (defun minibuffer-force-complete-and-exit () "Complete the minibuffer with first of the matches and exit." (interactive) (minibuffer-force-complete) - (minibuffer--complete-and-exit + (completion--complete-and-exit + (minibuffer-prompt-end) (point-max) #'exit-minibuffer ;; If the previous completion completed to an element which fails ;; test-completion, then we shouldn't exit, but that should be rare. (lambda () (minibuffer-message "Incomplete")))) -(defun minibuffer-force-complete () +(defun minibuffer-force-complete (&optional start end) "Complete the minibuffer to an exact match. Repeated uses step through the possible completions." (interactive) @@ -1157,10 +1162,10 @@ Repeated uses step through the possible completions." ;; FIXME: Need to deal with the extra-size issue here as well. ;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. - (let* ((start (copy-marker (field-beginning))) - (end (field-end)) + (let* ((start (copy-marker (or start (minibuffer-prompt-end)))) + (end (or end (point-max))) ;; (md (completion--field-metadata start)) - (all (completion-all-sorted-completions)) + (all (completion-all-sorted-completions start end)) (base (+ start (or (cdr (last all)) 0)))) (cond ((not (consp all)) @@ -1173,10 +1178,11 @@ Repeated uses step through the possible completions." 'finished (when done "Sole completion")))) (t (completion--replace base end (car all)) + (setq end (+ base (length (car all)))) (completion--done (buffer-substring-no-properties start (point)) 'sole) ;; Set cycling after modifying the buffer since the flush hook resets it. (setq completion-cycling t) - (setq this-command 'completion-at-point) ;For minibuffer-complete. + (setq this-command 'completion-at-point) ;For completion-in-region. ;; If completing file names, (car all) may be a directory, so we'd now ;; have a new set of possible completions and might want to reset ;; completion-all-sorted-completions to nil, but we prefer not to, @@ -1184,7 +1190,7 @@ Repeated uses step through the possible completions." ;; through the previous possible completions. (let ((last (last all))) (setcdr last (cons (car all) (cdr last))) - (completion--cache-all-sorted-completions (cdr all))) + (completion--cache-all-sorted-completions start end (cdr all))) ;; Make sure repeated uses cycle, even though completion--done might ;; have added a space or something that moved us outside of the field. ;; (bug#12221). @@ -1223,27 +1229,32 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) - (minibuffer--complete-and-exit + (completion-complete-and-exit (minibuffer-prompt-end) (point-max) + #'exit-minibuffer)) + +(defun completion-complete-and-exit (beg end exit-function) + (completion--complete-and-exit + beg end exit-function (lambda () (pcase (condition-case nil - (completion--do-completion nil 'expect-exact) + (completion--do-completion beg end + nil 'expect-exact) (error 1)) - ((or #b001 #b011) (exit-minibuffer)) + ((or #b001 #b011) (funcall exit-function)) (#b111 (if (not minibuffer-completion-confirm) - (exit-minibuffer) + (funcall exit-function) (minibuffer-message "Confirm") nil)) (_ nil))))) -(defun minibuffer--complete-and-exit (completion-function) +(defun completion--complete-and-exit (beg end + exit-function completion-function) "Exit from `require-match' minibuffer. COMPLETION-FUNCTION is called if the current buffer's content does not appear to be a match." - (let ((beg (field-beginning)) - (end (field-end))) (cond ;; Allow user to specify null string - ((= beg end) (exit-minibuffer)) + ((= beg end) (funcall exit-function)) ((test-completion (buffer-substring beg end) minibuffer-completion-table minibuffer-completion-predicate) @@ -1269,7 +1280,7 @@ appear to be a match." ;; that file. (= (length string) (length compl))) (completion--replace beg end compl)))) - (exit-minibuffer)) + (funcall exit-function)) ((memq minibuffer-completion-confirm '(confirm confirm-after-completion)) ;; The user is permitted to exit with an input that's rejected @@ -1280,13 +1291,13 @@ appear to be a match." ;; catches most minibuffer typos). (and (eq minibuffer-completion-confirm 'confirm-after-completion) (not (memq last-command minibuffer-confirm-exit-commands)))) - (exit-minibuffer) + (funcall exit-function) (minibuffer-message "Confirm") nil)) (t ;; Call do-completion, but ignore errors. - (funcall completion-function))))) + (funcall completion-function)))) (defun completion--try-word-completion (string table predicate point md) (let ((comp (completion-try-completion string table predicate point md))) @@ -1381,9 +1392,18 @@ After one word is completed as much as possible, a space or hyphen is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) - (pcase (completion--do-completion 'completion--try-word-completion) + (completion-in-region--single-word + (minibuffer-prompt-end) (point-max) + minibuffer-completion-table minibuffer-completion-predicate)) + +(defun completion-in-region--single-word (beg end collection + &optional predicate) + (let ((minibuffer-completion-table collection) + (minibuffer-completion-predicate predicate)) + (pcase (completion--do-completion beg end + #'completion--try-word-completion) (#b000 nil) - (_ t))) + (_ t)))) (defface completions-annotations '((t :inherit italic)) "Face to use for annotations in the *Completions* buffer.") @@ -1395,7 +1415,6 @@ in columns in the *Completions* buffer. If the value is `horizontal', display completions sorted horizontally in alphabetical order, rather than down the screen." :type '(choice (const horizontal) (const vertical)) - :group 'minibuffer :version "23.2") (defun completion--insert-strings (strings) @@ -1504,15 +1523,13 @@ See also `display-completion-list'.") (defface completions-first-difference '((t (:inherit bold))) - "Face added on the first uncommon character in completions in *Completions* buffer." - :group 'completion) + "Face added on the first uncommon character in completions in *Completions* buffer.") (defface completions-common-part '((t nil)) "Face added on the common prefix substring in completions in *Completions* buffer. The idea of `completions-common-part' is that you can use it to make the common parts less visible than normal, so that the rest -of the differing parts is, by contrast, slightly highlighted." - :group 'completion) +of the differing parts is, by contrast, slightly highlighted.") (defun completion-hilit-commonality (completions prefix-len base-size) (when completions @@ -1555,12 +1572,8 @@ alternative, the second serves as annotation. The actual completion alternatives, as inserted, are given `mouse-face' properties of `highlight'. At the end, this runs the normal hook `completion-setup-hook'. -It can find the completion buffer in `standard-output'. - -The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string -specifying a common substring for adding the faces -`completions-first-difference' and `completions-common-part' to -the completions buffer." +It can find the completion buffer in `standard-output'." + (declare (advertised-calling-convention (completions) "24.4")) (if common-substring (setq completions (completion-hilit-commonality completions (length common-substring) @@ -1647,19 +1660,19 @@ variables.") (equal pre-msg (and exit-fun (current-message)))) (completion--message message)))) -(defun minibuffer-completion-help () +(defun minibuffer-completion-help (&optional start end) "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (let* ((start (field-beginning)) - (end (field-end)) - (string (field-string)) + (let* ((start (or start (minibuffer-prompt-end))) + (end (or end (point-max))) + (string (buffer-substring start end)) (md (completion--field-metadata start)) (completions (completion-all-completions string minibuffer-completion-table minibuffer-completion-predicate - (- (point) (field-beginning)) + (- (point) start) md))) (message nil) (if (or (null completions) @@ -1811,7 +1824,6 @@ exit." (if (memq system-type '(ms-dos windows-nt darwin cygwin)) t nil) "Non-nil means when reading a file name completion ignores case." - :group 'minibuffer :type 'boolean :version "22.1") @@ -1821,22 +1833,15 @@ exit." ;; completions" operation as well. completion-in-region-functions (start end collection predicate) (let ((minibuffer-completion-table collection) - (minibuffer-completion-predicate predicate) - (ol (make-overlay start end nil nil t))) - (overlay-put ol 'field 'completion) + (minibuffer-completion-predicate predicate)) ;; HACK: if the text we are completing is already in a field, we ;; want the completion field to take priority (e.g. Bug#6830). - (overlay-put ol 'priority 100) (when completion-in-region-mode-predicate (completion-in-region-mode 1) (setq completion-in-region--data (list (if (markerp start) start (copy-marker start)) (copy-marker end) collection))) - ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather - ;; than the other way around! - (unwind-protect - (call-interactively 'minibuffer-complete) - (delete-overlay ol))))) + (completion--in-region-1 start end)))) (defvar completion-in-region-mode-map (let ((map (make-sparse-keymap))) @@ -2001,19 +2006,14 @@ The completion method is determined by `completion-at-point-functions'." (lambda () ;; We're still in the same completion field. (let ((newstart (car-safe (funcall hookfun)))) - (and newstart (= newstart start))))) - (ol (make-overlay start end nil nil t))) + (and newstart (= newstart start)))))) ;; FIXME: We should somehow (ab)use completion-in-region-function or ;; introduce a corresponding hook (plus another for word-completion, ;; and another for force-completion, maybe?). - (overlay-put ol 'field 'completion) - (overlay-put ol 'priority 100) (completion-in-region-mode 1) (setq completion-in-region--data (list start (copy-marker end) collection)) - (unwind-protect - (call-interactively 'minibuffer-completion-help) - (delete-overlay ol)))) + (minibuffer-completion-help start end))) (`(,hookfun . ,_) ;; The hook function already performed completion :-( ;; Not much we can do at this point. @@ -2308,7 +2308,6 @@ the minibuffer empty. For some commands, exiting with an empty minibuffer has a special meaning, such as making the current buffer visit no file in the case of `set-visited-file-name'." - :group 'minibuffer :type 'boolean) ;; Not always defined, but only called if next-read-file-uses-dialog-p says so. @@ -2701,7 +2700,6 @@ expression (not containing character ranges like `a-z')." ;; Refresh other vars. (completion-pcm--prepare-delim-re value)) :initialize 'custom-initialize-reset - :group 'minibuffer :type 'string) (defcustom completion-pcm-complete-word-inserts-delimiters nil @@ -2734,7 +2732,8 @@ or a symbol, see `completion-pcm--merge-completions'." (completion-pcm--string->pattern suffix))) (let* ((pattern nil) (p 0) - (p0 p)) + (p0 p) + (pending nil)) (while (and (setq p (string-match completion-pcm--delim-wild-regex string p)) @@ -2751,18 +2750,49 @@ or a symbol, see `completion-pcm--merge-completions'." ;; This is determined by the presence of a submatch-1 which delimits ;; the prefix. (if (match-end 1) (setq p (match-end 1))) - (push (substring string p0 p) pattern) + (unless (= p0 p) + (if pending (push pending pattern)) + (push (substring string p0 p) pattern)) + (setq pending nil) (if (eq (aref string p) ?*) (progn (push 'star pattern) (setq p0 (1+ p))) (push 'any pattern) - (setq p0 p)) - (cl-incf p)) - + (if (match-end 1) + (setq p0 p) + (push (substring string p (match-end 0)) pattern) + ;; `any-delim' is used so that "a-b" also finds "array->beginning". + (setq pending 'any-delim) + (setq p0 (match-end 0)))) + (setq p p0)) + + (when (> (length string) p0) + (if pending (push pending pattern)) + (push (substring string p0) pattern)) ;; An empty string might be erroneously added at the beginning. ;; It should be avoided properly, but it's so easy to remove it here. - (delete "" (nreverse (cons (substring string p0) pattern)))))) + (delete "" (nreverse pattern))))) + +(defun completion-pcm--optimize-pattern (p) + ;; Remove empty strings in a separate phase since otherwise a "" + ;; might prevent some other optimization, as in '(any "" any). + (setq p (delete "" p)) + (let ((n '())) + (while p + (pcase p + (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest) + (setq p (cons (concat s1 s2) rest))) + (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_) + (setq p (cdr p))) + (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest))) + (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest))) + (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest))) + (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest))) + (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest))) + (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'. + (_ (push (pop p) n)))) + (nreverse n))) (defun completion-pcm--pattern->regex (pattern &optional group) (let ((re @@ -2771,8 +2801,13 @@ or a symbol, see `completion-pcm--merge-completions'." (lambda (x) (cond ((stringp x) (regexp-quote x)) - ((if (consp group) (memq x group) group) "\\(.*?\\)") - (t ".*?"))) + (t + (let ((re (if (eq x 'any-delim) + (concat completion-pcm--delim-wild-regex "*?") + ".*?"))) + (if (if (consp group) (memq x group) group) + (concat "\\(" re "\\)") + re))))) pattern "")))) ;; Avoid pathological backtracking. @@ -2846,11 +2881,11 @@ filter out additional entries (because TABLE might not obey PRED)." (setq string (substring string (car bounds) (+ point (cdr bounds)))) (let* ((relpoint (- point (car bounds))) (pattern (completion-pcm--string->pattern string relpoint)) - (all (condition-case err + (all (condition-case-unless-debug err (funcall filter (completion-pcm--all-completions prefix pattern table pred)) - (error (unless firsterror (setq firsterror err)) nil)))) + (error (setq firsterror err) nil)))) (when (and (null all) (> (car bounds) 0) (null (ignore-errors (try-completion prefix table pred)))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e70400af820..a1ead96eaea 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1424,7 +1424,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (string-match "^/?\\([^/]+\\)" localname) (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) - (tramp-gvfs-mount-spec-entry "share" (match-string 1 localname)))) + (tramp-gvfs-mount-spec-entry + "share" (match-string 1 localname)))) ((string-equal "obex" method) (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry @@ -1441,7 +1442,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when domain (list (tramp-gvfs-mount-spec-entry "domain" domain))) ,@(when port - (list (tramp-gvfs-mount-spec-entry "port" (number-to-string port)))))) + (list (tramp-gvfs-mount-spec-entry + "port" (number-to-string port)))))) (mount-pref (if (and (string-match "\\`dav" method) (string-match "^/?[^/]+" localname)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6c3ae376dc3..727536b2e10 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -690,7 +690,7 @@ Useful for \"rsync\" like methods.") ;; Tramp only knows how to deal with `file-name-handler-alist', not ;; the other places. -;; Currently, we have the choice between 'ftp, 'sep, and 'url. +;; Currently, we have the choice between 'ftp and 'sep. ;;;###autoload (defcustom tramp-syntax (if (featurep 'xemacs) 'sep 'ftp) @@ -699,20 +699,15 @@ Useful for \"rsync\" like methods.") It can have the following values: 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default) - 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs) - 'url -- URL-like syntax." + 'sep -- Syntax as defined for XEmacs." :group 'tramp - :type (if (featurep 'xemacs) - '(choice (const :tag "EFS" ftp) - (const :tag "XEmacs" sep) - (const :tag "URL" url)) - '(choice (const :tag "Ange-FTP" ftp) - (const :tag "URL" url)))) + :version "24.4" + :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp) + (const :tag "XEmacs" sep))) (defconst tramp-prefix-format (cond ((equal tramp-syntax 'ftp) "/") ((equal tramp-syntax 'sep) "/[") - ((equal tramp-syntax 'url) "/") (t (error "Wrong `tramp-syntax' defined"))) "String matching the very beginning of Tramp file names. Used in `tramp-make-tramp-file-name'.") @@ -729,7 +724,6 @@ Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-postfix-method-format (cond ((equal tramp-syntax 'ftp) ":") ((equal tramp-syntax 'sep) "/") - ((equal tramp-syntax 'url) "://") (t (error "Wrong `tramp-syntax' defined"))) "String matching delimiter between method and user or host names. Used in `tramp-make-tramp-file-name'.") @@ -776,7 +770,6 @@ Derived from `tramp-postfix-user-format'.") (defconst tramp-prefix-ipv6-format (cond ((equal tramp-syntax 'ftp) "[") ((equal tramp-syntax 'sep) "") - ((equal tramp-syntax 'url) "[") (t (error "Wrong `tramp-syntax' defined"))) "String matching left hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") @@ -796,7 +789,6 @@ Derived from `tramp-prefix-ipv6-format'.") (defconst tramp-postfix-ipv6-format (cond ((equal tramp-syntax 'ftp) "]") ((equal tramp-syntax 'sep) "") - ((equal tramp-syntax 'url) "]") (t (error "Wrong `tramp-syntax' defined"))) "String matching right hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") @@ -809,7 +801,6 @@ Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format (cond ((equal tramp-syntax 'ftp) "#") ((equal tramp-syntax 'sep) "#") - ((equal tramp-syntax 'url) ":") (t (error "Wrong `tramp-syntax' defined"))) "String matching delimiter between host names and port numbers.") @@ -838,7 +829,6 @@ Derived from `tramp-postfix-hop-format'.") (defconst tramp-postfix-host-format (cond ((equal tramp-syntax 'ftp) ":") ((equal tramp-syntax 'sep) "]") - ((equal tramp-syntax 'url) "") (t (error "Wrong `tramp-syntax' defined"))) "String matching delimiter between host names and localnames. Used in `tramp-make-tramp-file-name'.") @@ -909,15 +899,9 @@ XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload -(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://" - "Value for `tramp-file-name-regexp' for URL-like remoting. -See `tramp-file-name-structure' for more explanations.") - -;;;###autoload (defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) - ((equal tramp-syntax 'url) tramp-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "Regular expression matching file names handled by Tramp. This regexp should match Tramp file names but no other file names. @@ -952,16 +936,9 @@ XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload -(defconst tramp-completion-file-name-regexp-url - "\\`/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'" - "Value for `tramp-completion-file-name-regexp' for URL-like remoting. -See `tramp-file-name-structure' for more explanations.") - -;;;###autoload (defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) - ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "Regular expression matching file names handled by Tramp completion. This regexp should match partial Tramp file names only. @@ -2542,64 +2519,40 @@ They are collected by `tramp-completion-dissect-file-name1'." tramp-prefix-ipv6-regexp "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") nil 1 2 nil)) - ;; "/method:user" "/[method/user" "/method://user" + ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure7 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\(" tramp-user-regexp x-nil "\\)$") 1 2 nil nil)) - ;; "/method:host" "/[method/host" "/method://host" + ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure8 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\(" tramp-host-regexp x-nil "\\)$") 1 nil 2 nil)) - ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6" + ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure9 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp tramp-prefix-ipv6-regexp "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") 1 nil 2 nil)) - ;; "/method:user@host" "/[method/user@host" "/method://user@host" + ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure10 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\(" tramp-host-regexp x-nil "\\)$") 1 2 3 nil)) - ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6" + ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure11 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp tramp-prefix-ipv6-regexp "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") - 1 2 3 nil)) - ;; "/method: "/method:/" - (tramp-completion-file-name-structure12 - (list - (if (equal tramp-syntax 'url) - (concat tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" - "\\(" (substring tramp-postfix-method-regexp 0 1) - "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)" - "\\(" "\\)$") - ;; Should not match if not URL syntax. - (concat tramp-prefix-regexp "/$")) - 1 3 nil nil)) - ;; "/method: "/method:/" - (tramp-completion-file-name-structure13 - (list - (if (equal tramp-syntax 'url) - (concat tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" - "\\(" (substring tramp-postfix-method-regexp 0 1) - "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)" - "\\(" "\\)$") - ;; Should not match if not URL syntax. - (concat tramp-prefix-regexp "/$")) - 1 nil 3 nil))) + 1 2 3 nil))) (mapc (lambda (structure) (add-to-list 'result @@ -2616,8 +2569,6 @@ They are collected by `tramp-completion-dissect-file-name1'." tramp-completion-file-name-structure9 tramp-completion-file-name-structure10 tramp-completion-file-name-structure11 - tramp-completion-file-name-structure12 - tramp-completion-file-name-structure13 tramp-file-name-structure)) (delq nil result))) @@ -3289,35 +3240,19 @@ User is always nil." (defun tramp-handle-substitute-in-file-name (filename) "Like `substitute-in-file-name' for Tramp files. -\"//\" and \"/~\" substitute only in the local filename part. -If the URL Tramp syntax is chosen, \"//\" as method delimiter and \"/~\" at -beginning of local filename are not substituted." +\"//\" and \"/~\" substitute only in the local filename part." ;; First, we must replace environment variables. (setq filename (tramp-replace-environment-variables filename)) (with-parsed-tramp-file-name filename nil - (if (equal tramp-syntax 'url) - ;; We need to check localname only. The other parts cannot contain - ;; "//" or "/~". - (if (and (> (length localname) 1) - (or (string-match "//" localname) - (string-match "/~" localname 1))) - (tramp-run-real-handler 'substitute-in-file-name (list filename)) - (tramp-make-tramp-file-name - (when method (substitute-in-file-name method)) - (when user (substitute-in-file-name user)) - (when host (substitute-in-file-name host)) - (when localname - (tramp-run-real-handler - 'substitute-in-file-name (list localname))))) - ;; Ignore in LOCALNAME everything before "//" or "/~". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) - (setq filename - (concat (file-remote-p filename) - (replace-match "\\1" nil nil localname))) - ;; "/m:h:~" does not work for completion. We use "/m:h:~/". - (when (string-match "~$" filename) - (setq filename (concat filename "/")))) - (tramp-run-real-handler 'substitute-in-file-name (list filename))))) + ;; Ignore in LOCALNAME everything before "//" or "/~". + (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (setq filename + (concat (file-remote-p filename) + (replace-match "\\1" nil nil localname))) + ;; "/m:h:~" does not work for completion. We use "/m:h:~/". + (when (string-match "~$" filename) + (setq filename (concat filename "/")))) + (tramp-run-real-handler 'substitute-in-file-name (list filename)))) (defun tramp-handle-unhandled-file-name-directory (_filename) "Like `unhandled-file-name-directory' for Tramp files." diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index db2a6c68539..c8a9c461a9d 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6905,32 +6905,38 @@ comment at the start of cc-engine.el for more info." ;; Skip over type decl prefix operators. (Note similar code in ;; `c-font-lock-declarators'.) - (while (and (looking-at c-type-decl-prefix-key) - (if (and (c-major-mode-is 'c++-mode) - (match-beginning 3)) - ;; If the third submatch matches in C++ then - ;; we're looking at an identifier that's a - ;; prefix only if it specifies a member pointer. - (when (setq got-identifier (c-forward-name)) - (if (looking-at "\\(::\\)") - ;; We only check for a trailing "::" and - ;; let the "*" that should follow be - ;; matched in the next round. - (progn (setq got-identifier nil) t) - ;; It turned out to be the real identifier, - ;; so stop. - nil)) - t)) - - (if (eq (char-after) ?\() + (if (and c-recognize-typeless-decls + (equal c-type-decl-prefix-key "\\<\\>")) + (when (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) - (forward-char)) - (unless got-prefix-before-parens - (setq got-prefix-before-parens (= paren-depth 0))) - (setq got-prefix t) - (goto-char (match-end 1))) - (c-forward-syntactic-ws)) + (forward-char))) + (while (and (looking-at c-type-decl-prefix-key) + (if (and (c-major-mode-is 'c++-mode) + (match-beginning 3)) + ;; If the third submatch matches in C++ then + ;; we're looking at an identifier that's a + ;; prefix only if it specifies a member pointer. + (when (setq got-identifier (c-forward-name)) + (if (looking-at "\\(::\\)") + ;; We only check for a trailing "::" and + ;; let the "*" that should follow be + ;; matched in the next round. + (progn (setq got-identifier nil) t) + ;; It turned out to be the real identifier, + ;; so stop. + nil)) + t)) + + (if (eq (char-after) ?\() + (progn + (setq paren-depth (1+ paren-depth)) + (forward-char)) + (unless got-prefix-before-parens + (setq got-prefix-before-parens (= paren-depth 0))) + (setq got-prefix t) + (goto-char (match-end 1))) + (c-forward-syntactic-ws))) (setq got-parens (> paren-depth 0)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 0116e9ec3dd..80e6189822b 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2816,7 +2816,8 @@ is in effect when this is matched (see `c-identifier-syntax-table')." "\\>") "") "\\)") - (java idl) "\\([\[\(]\\)") + java "\\([\[\(\)]\\)" + idl "\\([\[\(]\\)") (c-lang-defvar c-type-decl-suffix-key (c-lang-const c-type-decl-suffix-key) 'dont-doc) @@ -2937,7 +2938,7 @@ calls before a brace block. This setting does not affect declarations that are preceded by a declaration starting keyword, so e.g. `c-typeless-decl-kwds' may still be used when it's set to nil." t nil - (c c++ objc) t) + (c c++ objc java) t) (c-lang-defvar c-recognize-typeless-decls (c-lang-const c-recognize-typeless-decls)) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index acc7738ae5c..0f868255589 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1862,11 +1862,11 @@ See `font-lock-syntax-table'.") "using") 'symbols)) 1 'font-lock-builtin-face) - ;; Perl-ish keywords - "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$" ;; here-doc beginnings `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) 'font-lock-string-face)) + ;; Perl-ish keywords + "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$" ;; variables `(,(concat ruby-font-lock-keyword-beg-re "\\_<\\(nil\\|self\\|true\\|false\\)\\>") diff --git a/lisp/replace.el b/lisp/replace.el index 5e44677b0f8..abb59a674e3 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -490,12 +490,13 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. -In Transient Mark mode, if the mark is active, operate on the contents -of the region. Otherwise, operate from point to the end of the buffer. - Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. -Fourth and fifth arg START and END specify the region to operate on. + +Operates on the region between START and END (if both are nil, from point +to the end of the buffer). Interactively, if Transient Mark mode is +enabled and the mark is active, operates on the contents of the region; +otherwise from point to the end of the buffer. Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search string to the minibuffer diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 171f373317a..795c04e31e1 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -468,7 +468,7 @@ alternatives, starting from zero." nil (("editor") ("editora") ("editorb") ("editorc") ("translator") ("annotator") ("commentator") - ("introduction") ("foreword") ("afterword") ("titleaddon") + ("introduction") ("foreword") ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") ("maintitleaddon") ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") ("series") ("number") ("note") ("publisher") ("location") ("isbn") |