diff options
| author | Alan Mackenzie <acm@muc.de> | 2016-12-11 16:23:17 +0000 |
|---|---|---|
| committer | Alan Mackenzie <acm@muc.de> | 2016-12-11 16:23:17 +0000 |
| commit | de077da39da7d143f904d6405b62919e5f3e72d6 (patch) | |
| tree | 103a323d6f57b96ce36180ecc2cdca3a7bc8fe9d /lisp | |
| parent | 3ec37548b595b3481fd19f82b121d82e6e8f43a5 (diff) | |
| parent | fc0fd24c105bde4c001ebebe4b8b7e1f96cd2871 (diff) | |
| download | emacs-de077da39da7d143f904d6405b62919e5f3e72d6.tar.gz | |
Merge branch 'master' into comment-cache
Diffstat (limited to 'lisp')
547 files changed, 29855 insertions, 17691 deletions
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 88f5487ca74..46fa01acc5e 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -5820,7 +5820,7 @@ * epa.el (epa-passphrase-callback-function): Say what we're querying the password for. - * ibuffer.el (ibuffer-visit-buffer): To mimick list-buffers + * ibuffer.el (ibuffer-visit-buffer): To mimic list-buffers behavior, don't bury the ibuffer buffer when visiting other buffers. 2010-10-08 Chong Yidong <cyd@stupidchicken.com> diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index ee03661ece0..1361e7a8153 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -1254,7 +1254,7 @@ 2015-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org> * net/shr.el (shr-insert): Remove soft hyphens. - (shr-insert): Also remove soft hypens from non-folded text. + (shr-insert): Also remove soft hyphens from non-folded text. 2015-02-28 Eli Zaretskii <eliz@gnu.org> @@ -3737,7 +3737,7 @@ * net/tramp.el (tramp-read-passwd): Ignore errors from `auth-source-*'. * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use "\n" - as end-of-line delimeter for passwords, when running on MS Windows. + as end-of-line delimiter for passwords, when running on MS Windows. 2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> @@ -6026,7 +6026,7 @@ 2014-11-01 Michael R. Mauger <michael@mauger.com> - * sql.el (sql-mode-oracle-font-lock-keywords): Correct regexp + * progmodes/sql.el (sql-mode-oracle-font-lock-keywords): Correct regexp syntax, add new keywords, and parse longer keywords first. (sql-redirect-one): Protect against empty command. (sql-mode, sql-interactive-mode): Set `custom-mode-group' property @@ -6034,7 +6034,7 @@ 2014-11-01 Michael R. Mauger <michael@mauger.com> - * sql.el (sql-interactive-mode, sql-stop): Correct fix for + * progmodes/sql.el (sql-interactive-mode, sql-stop): Correct fix for Bug#16814 with let-bind of comint-input-ring variables around read and save functions. @@ -6835,7 +6835,7 @@ console as well (bug#18629). * w32-common-fns.el: Remove. * loadup.el: Don't load w32-common-fns.el. - * w32-fns.elc: Don't require w32-common-fns. + * w32-fns.el: Don't require w32-common-fns. * icomplete.el: Move Iswitchb autoload here. Much simpler. * obsolete/iswitchb.el (iswitchb-mode): Use normal autoload cookie. @@ -8033,7 +8033,7 @@ 2014-08-24 Alan Mackenzie <acm@muc.de> Handle C++11's "auto" and "decltype" constructions. - * progmodes/cc-engine.el (c-forward-type): Enhance to recognise + * progmodes/cc-engine.el (c-forward-type): Enhance to recognize and return 'decltype. (c-forward-decl-or-cast-1): New let variables backup-kwd-sym, prev-kwd-sym, new-style-auto. Enhance to handle the new "auto" @@ -13542,7 +13542,7 @@ c-parse-state. Don't "append-lower-brace-pair" in certain circumstances. Also fix an obscure bug where "\\s!" shouldn't be - recognised as a comment. + recognized as a comment. * progmodes/cc-engine.el (c-state-pp-to-literal): Check for "\\s!" as well as normal comment starter. @@ -17480,7 +17480,7 @@ after a function declaration with only types (no identifiers) in the parentheses. Also, accept a function declaration with just a type inside the parentheses, if this type can be positively - recognised as such, or if a prefix keyword like "explicit" nails + recognized as such, or if a prefix keyword like "explicit" nails down the construct as a declaration. 2013-10-19 Eli Zaretskii <eliz@gnu.org> diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index e527567a124..b2c36233bb3 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -6523,7 +6523,7 @@ * ansi-color.el (ansi-color-process-output): Use markers instead of positions for start and end of region. (ansi-color-apply-on-region): Rewrote code to make it more robust. - Previously, occasional mistakes happend when fontifying many + Previously, occasional mistakes happened when fontifying many chunks of output (eg. ls --color=yes /dev). This happened whenever an overlay was created up to the end of the region, which coincided with the process-mark. New text would then be added diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 83714d0f5a7..12bb9c7a3ce 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -201,7 +201,7 @@ update-subdirs: $(srcdir)/../build-aux/update-subdirs $$file; \ done; -.PHONY: updates repo-update update-authors +.PHONY: updates repo-update update-authors update-gnus-news # Some modes of make-dist use this. updates: update-subdirs autoloads finder-data custom-deps @@ -214,12 +214,17 @@ updates: update-subdirs autoloads finder-data custom-deps # this directory's autoloads rule. repo-update: compile finder-data custom-deps -# Update the AUTHORS file. +# Update etc/AUTHORS and etc/GNUS-NEWS. update-authors: $(emacs) -L "$(top_srcdir)/admin" -l authors \ -f batch-update-authors "$(top_srcdir)/etc/AUTHORS" "$(top_srcdir)" +update-gnus-news: + $(emacs) -L "$(top_srcdir)/doc/misc" -l gnus-news -f batch-gnus-news \ + "$(top_srcdir)/doc/misc/gnus-news.texi" \ + "$(top_srcdir)/etc/GNUS-NEWS" + FORCE: .PHONY: FORCE diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 7814ea24b4a..b6d202c1807 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -837,18 +837,19 @@ Takes no argument and should return the abbrev symbol if expansion took place.") "Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. Before doing anything else, runs `pre-abbrev-expand-hook'. -Calls `abbrev-expand-function' with no argument to do the work, -and returns whatever it does. (This should be the abbrev symbol -if expansion occurred, else nil.)" +Calls the value of `abbrev-expand-function' with no argument to do +the work, and returns whatever it does. (That return value should +be the abbrev symbol if expansion occurred, else nil.)" (interactive) (run-hooks 'pre-abbrev-expand-hook) (funcall abbrev-expand-function)) (defun abbrev--default-expand () "Default function to use for `abbrev-expand-function'. -This respects the wrapper hook `abbrev-expand-functions'. +This also respects the obsolete wrapper hook `abbrev-expand-functions'. +\(See `with-wrapper-hook' for details about wrapper hooks.) Calls `abbrev-insert' to insert any expansion, and returns what it does." - (with-wrapper-hook abbrev-expand-functions () + (subr--with-wrapper-hook-no-warnings abbrev-expand-functions () (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point))) (when sym (let ((startpos (copy-marker (point) t)) diff --git a/lisp/align.el b/lisp/align.el index c3389dc9860..866aaadaf4d 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -577,7 +577,7 @@ The possible settings for `align-region-separate' are: (eq '- current-prefix-arg))))) (css-declaration - (regexp . "^\\s-*\\w+:\\(\\s-*\\).*;") + (regexp . "^\\s-*\\(?:\\w-?\\)+:\\(\\s-*\\).*;") (group . (1)) (modes . '(css-mode html-mode)))) "A list describing all of the available alignment rules. @@ -1054,7 +1054,9 @@ to be colored." ;;;###autoload (defun align-newline-and-indent () - "A replacement function for `newline-and-indent', aligning as it goes." + "A replacement function for `newline-and-indent', aligning as it goes. +The alignment is done by calling `align' on the region that was +indented." (interactive) (let ((separate (or (if (and (symbolp align-region-separate) (boundp align-region-separate)) diff --git a/lisp/allout.el b/lisp/allout.el index 49bdc06fbb0..f47213de32a 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -592,7 +592,7 @@ software. By default: See `allout-plain-bullets-string' for the standard, alternating bullets. -You must run `set-allout-regexp' in order for outline mode to +You must run `allout-set-regexp' in order for outline mode to adopt changes of this value. DO NOT include the close-square-bracket, `]', on either of the bullet @@ -947,13 +947,13 @@ case the value of `allout-default-layout' is used.") Any line whose beginning matches this regexp is considered a heading. This var is set according to the user configuration vars -by `set-allout-regexp'.") +by `allout-set-regexp'.") (make-variable-buffer-local 'allout-regexp) ;;;_ = allout-bullets-string (defvar allout-bullets-string "" "A string dictating the valid set of outline topic bullets. -This var should *not* be set by the user -- it is set by `set-allout-regexp', +This var should *not* be set by the user -- it is set by `allout-set-regexp', and is produced from the elements of `allout-plain-bullets-string' and `allout-distinctive-bullets-string'.") (make-variable-buffer-local 'allout-bullets-string) @@ -970,7 +970,7 @@ headers at depth 2 and greater. Use `allout-depth-one-regexp' for to seek topics at depth one. This var is set according to the user configuration vars by -`set-allout-regexp'. It is prepared with format strings for two +`allout-set-regexp'. It is prepared with format strings for two decimal numbers, which should each be one less than the depth of the topic prefix to be matched.") (make-variable-buffer-local 'allout-depth-specific-regexp) @@ -979,7 +979,7 @@ topic prefix to be matched.") "Regular expression to match a heading line prefix for depth one. This var is set according to the user configuration vars by -`set-allout-regexp'. It is prepared with format strings for two +`allout-set-regexp'. It is prepared with format strings for two decimal numbers, which should each be one less than the depth of the topic prefix to be matched.") (make-variable-buffer-local 'allout-depth-one-regexp) @@ -987,7 +987,7 @@ topic prefix to be matched.") (defvar allout-line-boundary-regexp () "`allout-regexp' prepended with a newline for the search target. -This is properly set by `set-allout-regexp'.") +This is properly set by `allout-set-regexp'.") (make-variable-buffer-local 'allout-line-boundary-regexp) ;;;_ = allout-bob-regexp (defvar allout-bob-regexp () @@ -999,7 +999,7 @@ This is properly set by `set-allout-regexp'.") (make-variable-buffer-local 'allout-header-subtraction) ;;;_ = allout-plain-bullets-string-len (defvar allout-plain-bullets-string-len (length allout-plain-bullets-string) - "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.") + "Length of `allout-plain-bullets-string', updated by `allout-set-regexp'.") (make-variable-buffer-local 'allout-plain-bullets-string-len) ;;;_ = allout-doublecheck-at-and-shallower @@ -1034,7 +1034,7 @@ suitably economical.") (interactive "sNew lead string: ") (setq allout-header-prefix header-lead) (setq allout-header-subtraction (1- (length allout-header-prefix))) - (set-allout-regexp)) + (allout-set-regexp)) ;;;_ X allout-lead-with-comment-string (header-lead) (defun allout-lead-with-comment-string (&optional header-lead) "Set the topic-header leading string to specified string. @@ -1114,8 +1114,8 @@ file is programming code." comment-start (not (eq 'force allout-reindent-bodies))) (setq allout-reindent-bodies nil))) -;;;_ > set-allout-regexp () -(defun set-allout-regexp () +;;;_ > allout-set-regexp () +(defun allout-set-regexp () "Generate proper topic-header regexp form for outline functions. Works with respect to `allout-plain-bullets-string' and @@ -1242,12 +1242,13 @@ Also refresh various data structures that hinge on the regexp." "[^" allout-primary-bullet "]")) "\\)" )))) +(define-obsolete-function-alias 'set-allout-regexp 'allout-set-regexp "26.1") ;;;_ : Menu bar (defvar allout-mode-exposure-menu) (defvar allout-mode-editing-menu) (defvar allout-mode-navigation-menu) (defvar allout-mode-misc-menu) -(defun produce-allout-mode-menubar-entries () +(defun allout-produce-mode-menubar-entries () (require 'easymenu) (easy-menu-define allout-mode-exposure-menu allout-mode-map-value @@ -2029,7 +2030,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (allout-infer-header-lead-and-primary-bullet) (allout-infer-body-reindent) - (set-allout-regexp) + (allout-set-regexp) (allout-add-resumptions '(allout-encryption-ciphertext-rejection-regexps allout-line-boundary-regexp extend) @@ -2038,7 +2039,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." extend)) (allout-compose-and-institute-keymap) - (produce-allout-mode-menubar-entries) + (allout-produce-mode-menubar-entries) (add-to-invisibility-spec '(allout . t)) @@ -2245,8 +2246,8 @@ the new value of `allout-recent-prefix-beginning'." allout-recent-prefix-beginning allout-header-subtraction))) allout-recent-prefix-beginning) -;;;_ > nullify-allout-prefix-data () -(defsubst nullify-allout-prefix-data () +;;;_ > allout-nullify-prefix-data () +(defsubst allout-nullify-prefix-data () "Mark allout prefix data as being uninformative." (setq allout-recent-prefix-end (point) allout-recent-prefix-beginning (point) @@ -2381,7 +2382,7 @@ Like `allout-current-depth', but respects hidden as well as visible topics." allout-recent-depth (progn ;; Oops, no prefix, nullify it: - (nullify-allout-prefix-data) + (allout-nullify-prefix-data) ;; ... and return 0: 0))))) ;;;_ > allout-current-depth () @@ -3478,11 +3479,11 @@ Offer one suitable for current depth DEPTH as default." (let* ((default-bullet (or (and (stringp current-bullet) current-bullet) (allout-bullet-for-depth depth))) - (sans-escapes (regexp-sans-escapes allout-bullets-string)) + (sans-escapes (allout-regexp-sans-escapes allout-bullets-string)) choice) (save-excursion (goto-char (allout-current-bullet-pos)) - (setq choice (solicit-char-in-string + (setq choice (allout-solicit-char-in-string (format-message "Select bullet: %s (`%s' default): " sans-escapes @@ -6341,7 +6342,7 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info." ;; we had to wait for this 'til now so prior topics are ;; encrypted, any relevant text shifts are in place: editing-point (- current-mark-position - (count-trailing-whitespace-region + (allout-count-trailing-whitespace-region bo-subtree current-mark-position)))) (allout-toggle-subtree-encryption) (if (not was-modified) @@ -6507,8 +6508,8 @@ not its value." (allout-end-of-current-subtree) (exchange-point-and-mark)) ;;;_ : UI: -;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) -(defun solicit-char-in-string (prompt string &optional do-defaulting) +;;;_ > allout-solicit-char-in-string (prompt string &optional do-defaulting) +(defun allout-solicit-char-in-string (prompt string &optional do-defaulting) "Solicit (with first arg PROMPT) choice of a character from string STRING. Optional arg DO-DEFAULTING indicates to accept empty input (CR)." @@ -6541,8 +6542,8 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)." got) ) ;;;_ : Strings: -;;;_ > regexp-sans-escapes (string) -(defun regexp-sans-escapes (regexp &optional successive-backslashes) +;;;_ > allout-regexp-sans-escapes (string) +(defun allout-regexp-sans-escapes (regexp &optional successive-backslashes) "Return a copy of REGEXP with all character escapes stripped out. Representations of actual backslashes -- `\\\\\\\\' -- are left as a @@ -6561,11 +6562,11 @@ Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." (if (or (not successive-backslashes) (= 2 successive-backslashes)) ;; Include first char: (concat (substring regexp 0 1) - (regexp-sans-escapes (substring regexp 1))) + (allout-regexp-sans-escapes (substring regexp 1))) ;; Exclude first char, but maintain count: - (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) -;;;_ > count-trailing-whitespace-region (beg end) -(defun count-trailing-whitespace-region (beg end) + (allout-regexp-sans-escapes (substring regexp 1) successive-backslashes)))) +;;;_ > allout-count-trailing-whitespace-region (beg end) +(defun allout-count-trailing-whitespace-region (beg end) "Return number of trailing whitespace chars between BEG and END. If BEG is bigger than END we return 0." @@ -6797,9 +6798,9 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." "Isearch (regexp) for topic with bullet BULLET." (interactive) (if (not bullet) - (setq bullet (solicit-char-in-string + (setq bullet (allout-solicit-char-in-string "ISearch for topic with bullet: " - (regexp-sans-escapes allout-bullets-string)))) + (allout-regexp-sans-escapes allout-bullets-string)))) (let ((isearch-regexp t) (isearch-string (concat "^" diff --git a/lisp/apropos.el b/lisp/apropos.el index eb145bdc571..7c9ec12c2e0 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -867,19 +867,23 @@ Returns list of symbols and documentation found." symbol))))) (defun apropos-documentation-internal (doc) - (if (consp doc) - (apropos-documentation-check-elc-file (car doc)) - (if (and doc - (string-match apropos-all-words-regexp doc) - (apropos-true-hit-doc doc)) - (when apropos-match-face - (setq doc (substitute-command-keys (copy-sequence doc))) - (if (or (string-match apropos-pattern-quoted doc) - (string-match apropos-all-words-regexp doc)) - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face doc)) - doc)))) + (cond + ((consp doc) + (apropos-documentation-check-elc-file (car doc))) + ((and doc + ;; Sanity check in case bad data sneaked into the + ;; documentation slot. + (stringp doc) + (string-match apropos-all-words-regexp doc) + (apropos-true-hit-doc doc)) + (when apropos-match-face + (setq doc (substitute-command-keys (copy-sequence doc))) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc)) + doc)))) (defun apropos-format-plist (pl sep &optional compare) (setq pl (symbol-plist pl)) @@ -1040,9 +1044,12 @@ Each element should have the format The return value is the list that was in `apropos-accumulator', sorted alphabetically by symbol name; but this function also sets `apropos-accumulator' to nil before returning. - -If SPACING is non-nil, it should be a string; separate items with that string. -If non-nil, TEXT is a string that will be printed as a heading." +If DO-KEYS is non-nil, output the key bindings. If NOSUBST is +nil, substitute \"ASCII quotes\" (i.e., grace accent and +apostrophe) with curly quotes), and if non-nil, leave them alone. +If SPACING is non-nil, it should be a string; separate items with +that string. If non-nil, TEXT is a string that will be printed +as a heading." (if (null apropos-accumulator) (message "No apropos matches for `%s'" apropos-pattern) (setq apropos-accumulator diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index b5373c607d4..c42ca813e96 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1646,7 +1646,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; converts "\" to "/". ;; - For 0 generic: generic_to_unix_filename() downcases if there's ;; no lower case already present, and converts "\" to "/". - ;; - For 'm' MacOS: macos_to_unix_filename() changes "/" to ":" and + ;; - For 'm' macOS: macos_to_unix_filename() changes "/" to ":" and ;; ":" to "/" (setq fiddle (cond ((= ?M osid) t) ((= 0 osid) (string= efnname (upcase efnname))))) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index cfd21a523cd..62d9a4521c0 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1,4 +1,4 @@ -;;; auth-source.el --- authentication sources for Gnus and Emacs +;;; auth-source.el --- authentication sources for Gnus and Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. @@ -41,7 +41,7 @@ (require 'password-cache) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'eieio) (autoload 'secrets-create-item "secrets") @@ -363,8 +363,8 @@ Only one of CHOICES will be returned. The PROMPT is augmented with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." (when choices (let* ((prompt-choices - (apply #'concat (loop for c in choices - collect (format "%c/" c)))) + (apply #'concat + (cl-loop for c in choices collect (format "%c/" c)))) (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] ")) (full-prompt (concat prompt prompt-choices)) k) @@ -417,13 +417,13 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." ;; Keychain collection matching any user, host, and protocol ((eq entry 'macos-keychain-generic) (auth-source-backend-parse '(:source (:macos-keychain-generic default)))) - ;; take macos-keychain-internet:XYZ and recurse to get it as MacOS + ;; take macos-keychain-internet:XYZ and recurse to get it as macOS ;; Keychain "XYZ" matching any user, host, and protocol ((and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)" entry)) (auth-source-backend-parse `(:source (:macos-keychain-internet ,(match-string 1 entry))))) - ;; take macos-keychain-generic:XYZ and recurse to get it as MacOS + ;; take macos-keychain-generic:XYZ and recurse to get it as macOS ;; Keychain "XYZ" matching any user, host, and protocol ((and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)" entry)) @@ -452,7 +452,7 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." :search-function #'auth-source-netrc-search :create-function #'auth-source-netrc-create))) - ;; the MacOS Keychain + ;; the macOS Keychain ((and (not (null (plist-get entry :source))) ; the source must not be nil (listp (plist-get entry :source)) ; and it must be a list @@ -538,10 +538,9 @@ parameters." ;; (mapcar 'auth-source-backend-parse auth-sources) -(defun* auth-source-search (&rest spec - &key max - require create delete - &allow-other-keys) +(cl-defun auth-source-search (&rest spec + &key max require create delete + &allow-other-keys) "Search or modify authentication backends according to SPEC. This function parses `auth-sources' for matches of the SPEC @@ -681,9 +680,9 @@ must call it to obtain the actual value." (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) (max (or max 1)) (ignored-keys '(:require :create :delete :max)) - (keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) (cached (auth-source-remembered-p spec)) ;; note that we may have cached results but found is still nil ;; (there were no results from the search) @@ -695,24 +694,24 @@ must call it to obtain the actual value." "auth-source-search: found %d CACHED results matching %S" (length found) spec) - (assert + (cl-assert (or (eq t create) (listp create)) t "Invalid auth-source :create parameter (must be t or a list): %s %s") - (assert + (cl-assert (listp require) t "Invalid auth-source :require parameter (must be a list): %s") (setq filtered-backends (copy-sequence backends)) (dolist (backend backends) - (dolist (key keys) + (cl-dolist (key keys) ;; ignore invalid slots (condition-case nil (unless (auth-source-search-collection (plist-get spec key) (slot-value backend key)) (setq filtered-backends (delq backend filtered-backends)) - (return)) + (cl-return)) (invalid-slot-name nil)))) (auth-source-do-trivia @@ -812,12 +811,11 @@ Returns the deleted entries." (defun auth-source-forget-all-cached () "Forget all cached auth-source data." (interactive) - (loop for sym being the symbols of password-data - ;; when the symbol name starts with auth-source-magic - when (string-match (concat "^" auth-source-magic) - (symbol-name sym)) - ;; remove that key - do (password-cache-remove (symbol-name sym))) + (cl-do-symbols (sym password-data) + ;; when the symbol name starts with auth-source-magic + (when (string-match (concat "^" auth-source-magic) (symbol-name sym)) + ;; remove that key + (password-cache-remove (symbol-name sym)))) (setq auth-source-netrc-cache nil)) (defun auth-source-format-cache-entry (spec) @@ -866,27 +864,26 @@ cached data that was found with a search for those two hosts, while \(:host t) would find all host entries." (let ((count 0) sname) - (loop for sym being the symbols of password-data - ;; when the symbol name matches with auth-source-magic - when (and (setq sname (symbol-name sym)) - (string-match (concat "^" auth-source-magic "\\(.+\\)") - sname) - ;; and the spec matches what was stored in the cache - (auth-source-specmatchp spec (read (match-string 1 sname)))) - ;; remove that key - do (progn - (password-cache-remove sname) - (incf count))) + (cl-do-symbols (sym password-data) + ;; when the symbol name matches with auth-source-magic + (when (and (setq sname (symbol-name sym)) + (string-match (concat "^" auth-source-magic "\\(.+\\)") + sname) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (read (match-string 1 sname)))) + ;; remove that key + (password-cache-remove sname) + (cl-incf count))) count)) (defun auth-source-specmatchp (spec stored) - (let ((keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (not (eq - (dolist (key keys) + (cl-dolist (key keys) (unless (auth-source-search-collection (plist-get stored key) (plist-get spec key)) - (return 'no))) + (cl-return 'no))) 'no)))) ;; (auth-source-pick-first-password :host "z.lifelogs.com") @@ -941,8 +938,8 @@ while \(:host t) would find all host entries." (cdr (assoc key alist))) ;; (auth-source-netrc-parse :file "~/.authinfo.gpg") -(defun* auth-source-netrc-parse (&key file max host user port require - &allow-other-keys) +(cl-defun auth-source-netrc-parse (&key file max host user port require + &allow-other-keys) "Parse FILE and return a list of all entries in the file. Note that the MAX parameter is used so we can exit the parse early." (if (listp file) @@ -983,8 +980,8 @@ Note that the MAX parameter is used so we can exit the parse early." ;; every element of require is in n(ormalized) (let ((n (nth 0 (auth-source-netrc-normalize (list alist) file)))) - (loop for req in require - always (plist-get n req))))))) + (cl-loop for req in require + always (plist-get n req))))))) result) (if (and (functionp cached-secrets) @@ -1002,7 +999,7 @@ Note that the MAX parameter is used so we can exit the parse early." (auth-source--aput auth-source-netrc-cache file (list :mtime (nth 5 (file-attributes file)) - :secret (lexical-let ((v (mapcar #'1+ (buffer-string)))) + :secret (let ((v (mapcar #'1+ (buffer-string)))) (lambda () (apply #'string (mapcar #'1- v))))))) (goto-char (point-min)) (let ((entries (auth-source-netrc-parse-entries check max)) @@ -1118,7 +1115,7 @@ Note that the MAX parameter is used so we can exit the parse early." (read-passwd (format "Passphrase for %s tokens: " file) t)) - (setcdr entry (lexical-let ((p (copy-sequence passphrase))) + (setcdr entry (let ((p (copy-sequence passphrase))) (lambda () p))) passphrase)))) @@ -1155,7 +1152,7 @@ FILE is the file from which we obtained this token." (point-min) (point-max)))))) -(defun auto-source--symbol-keyword (symbol) +(defun auth-source--symbol-keyword (symbol) (intern (format ":%s" symbol))) (defun auth-source-netrc-normalize (alist filename) @@ -1174,8 +1171,8 @@ FILE is the file from which we obtained this token." ;; send back the secret in a function (lexical binding) (when (equal k "secret") - (setq v (lexical-let ((lexv v) - (token-decoder nil)) + (setq v (let ((lexv v) + (token-decoder nil)) (when (string-match "^gpg:" lexv) ;; it's a GPG token: create a token decoder ;; which unsets itself once @@ -1191,7 +1188,7 @@ FILE is the file from which we obtained this token." (setq lexv (funcall token-decoder lexv))) lexv)))) (setq ret (plist-put ret - (auto-source--symbol-keyword k) + (auth-source--symbol-keyword k) v)))) ret)) alist)) @@ -1199,16 +1196,15 @@ FILE is the file from which we obtained this token." ;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) ;; (funcall secret) -(defun* auth-source-netrc-search (&rest - spec - &key backend require create - type max host user port - &allow-other-keys) +(cl-defun auth-source-netrc-search (&rest spec + &key backend require create + type max host user port + &allow-other-keys) "Given a property list SPEC, return search matches from the :backend. See `auth-source-search' for details on SPEC." ;; just in case, check that the type is correct (null or same as the backend) - (assert (or (null type) (eq type (oref backend type))) - t "Invalid netrc search: %s %s") + (cl-assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search: %s %s") (let ((results (auth-source-netrc-normalize (auth-source-netrc-parse @@ -1245,10 +1241,9 @@ See `auth-source-search' for details on SPEC." ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) ;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) -(defun* auth-source-netrc-create (&rest spec - &key backend - host port create - &allow-other-keys) +(cl-defun auth-source-netrc-create (&rest spec + &key backend host port create + &allow-other-keys) (let* ((base-required '(host user port secret)) ;; we know (because of an assertion in auth-source-search) that the ;; :create parameter is either t or a list (which includes nil) @@ -1268,7 +1263,7 @@ See `auth-source-search' for details on SPEC." ;; fill in the valist with whatever data we may have from the search ;; we complete the first value if it's a list and use the value otherwise (dolist (br base-required) - (let ((val (plist-get spec (auto-source--symbol-keyword br)))) + (let ((val (plist-get spec (auth-source--symbol-keyword br)))) (when val (let ((br-choice (cond ;; all-accepting choice (predicate is t) @@ -1280,9 +1275,9 @@ See `auth-source-search' for details on SPEC." ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) - (let ((k (auto-source--symbol-keyword er)) - (keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((k (auth-source--symbol-keyword er)) + (keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1292,7 +1287,7 @@ See `auth-source-search' for details on SPEC." ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data - (auto-source--symbol-keyword r)))) + (auth-source--symbol-keyword r)))) ;; this is the default to be offered (given-default (auth-source--aget auth-source-creation-defaults r)) @@ -1323,7 +1318,7 @@ See `auth-source-search' for details on SPEC." (plist-get artificial :port) "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) - (case r + (cl-case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") (host "%p host name for user %u: ") @@ -1382,9 +1377,9 @@ See `auth-source-search' for details on SPEC." (when data (setq artificial (plist-put artificial - (auto-source--symbol-keyword r) + (auth-source--symbol-keyword r) (if (eq r 'secret) - (lexical-let ((data data)) + (let ((data data)) (lambda () data)) data)))) @@ -1400,7 +1395,7 @@ See `auth-source-search' for details on SPEC." ;; prepend a space (if (zerop (length add)) "" " ") ;; remap auth-source tokens to netrc - (case r + (cl-case r (user "login") (host "machine") (secret "password") @@ -1414,8 +1409,8 @@ See `auth-source-search' for details on SPEC." (plist-put artificial :save-function - (lexical-let ((file file) - (add add)) + (let ((file file) + (add add)) (lambda () (auth-source-netrc-saver file add)))) (list artificial))) @@ -1454,7 +1449,7 @@ Respects `auth-source-save-behavior'. Uses k) (while (not done) (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??))) - (case k + (cl-case k (?y (setq done t)) (?? (save-excursion (with-output-to-temp-buffer bufname @@ -1526,17 +1521,12 @@ list, it matches the original pattern." (heads (if (stringp value) (list (list key value)) (mapcar (lambda (v) (list key v)) value)))) - (loop - for h in heads - nconc - (loop - for tl in tails - collect (append h tl)))))) - -(defun* auth-source-secrets-search (&rest - spec - &key backend create delete label max - &allow-other-keys) + (cl-loop for h in heads + nconc (cl-loop for tl in tails collect (append h tl)))))) + +(cl-defun auth-source-secrets-search (&rest spec + &key backend create delete label max + &allow-other-keys) "Search the Secrets API; spec is like `auth-source'. The :label key specifies the item's label. It is the only key @@ -1569,19 +1559,19 @@ authentication tokens: " ;; TODO - (assert (not create) nil - "The Secrets API auth-source backend doesn't support creation yet") + (cl-assert (not create) nil + "The Secrets API auth-source backend doesn't support creation yet") ;; TODO ;; (secrets-delete-item coll elt) - (assert (not delete) nil - "The Secrets API auth-source backend doesn't support deletion yet") + (cl-assert (not delete) nil + "The Secrets API auth-source backend doesn't support deletion yet") (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it (search-specs (auth-source-secrets-listify-pattern @@ -1597,12 +1587,13 @@ authentication tokens: '(:host :login :port :secret) search-keys))) (items - (loop for search-spec in search-specs - nconc - (loop for item in (apply #'secrets-search-items coll search-spec) - unless (and (stringp label) - (not (string-match label item))) - collect item))) + (cl-loop + for search-spec in search-specs + nconc + (cl-loop for item in (apply #'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item))) ;; TODO: respect max in `secrets-search-items', not after the fact (items (butlast items (- (length items) max))) ;; convert the item name to a full plist @@ -1611,7 +1602,7 @@ authentication tokens: ;; make an entry for the secret (password) element (list :secret - (lexical-let ((v (secrets-get-secret coll item))) + (let ((v (secrets-get-secret coll item))) (lambda () v))) ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist (apply #'append @@ -1653,12 +1644,10 @@ authentication tokens: ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) -(defun* auth-source-macos-keychain-search (&rest - spec - &key backend create delete - type max - &allow-other-keys) - "Search the MacOS Keychain; spec is like `auth-source'. +(cl-defun auth-source-macos-keychain-search (&rest spec + &key backend create delete type max + &allow-other-keys) + "Search the macOS Keychain; spec is like `auth-source'. All search keys must match exactly. If you need substring matching, do a wider search and narrow it down yourself. @@ -1680,13 +1669,13 @@ Similarly, :host maps to \"-c HOST\" (the \"creator\" keychain field), :user maps to \"-a USER\", and :port maps to \"-s PORT\". Here's an example that looks for the first item in the default -generic MacOS Keychain: +generic macOS Keychain: (let ((auth-sources \\='(macos-keychain-generic))) (auth-source-search :max 1) Here's another that looks for the first item in the internet -MacOS Keychain collection whose label is `gnus': +macOS Keychain collection whose label is `gnus': (let ((auth-sources \\='(macos-keychain-internet))) (auth-source-search :max 1 :label \"gnus\") @@ -1698,21 +1687,22 @@ entries for git.gnus.org: (auth-source-search :max 1 :host \"git.gnus.org\")) " ;; TODO - (assert (not create) nil - "The MacOS Keychain auth-source backend doesn't support creation yet") + (cl-assert (not create) nil + "The macOS Keychain auth-source backend doesn't support creation yet") ;; TODO ;; (macos-keychain-delete-item coll elt) - (assert (not delete) nil - "The MacOS Keychain auth-source backend doesn't support deletion yet") + (cl-assert (not delete) nil + "The macOS Keychain auth-source backend doesn't support deletion yet") (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K ;; Filter out ignored keys from the spec (ignored-keys '(:create :delete :max :backend :label :host :port)) ;; Build a search spec without the ignored keys - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + ;; FIXME make this loop a function? it's used in at least 3 places + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; If a search key value is nil or t (match anything), we skip it (search-spec (apply #'append (mapcar (lambda (k) @@ -1735,7 +1725,7 @@ entries for git.gnus.org: (items (catch 'match (dolist (host hosts) (dolist (port ports) - (let* ((port (format "%S" port)) + (let* ((port (if port (format "%S" port))) (items (apply #'auth-source-macos-keychain-search-items coll type @@ -1758,12 +1748,26 @@ entries for git.gnus.org: items))) items)) -(defun* auth-source-macos-keychain-search-items (coll _type _max - host port - &key label type - user - &allow-other-keys) +(defun auth-source--decode-octal-string (string) + "Convert octal string to utf-8 string. E.g: 'a\134b' to 'a\b'" + (let ((list (string-to-list string)) + (size (length string))) + (decode-coding-string + (apply #'unibyte-string + (cl-loop for i = 0 then (+ i (if (eq (nth i list) ?\\) 4 1)) + for var = (nth i list) + while (< i size) + if (eq var ?\\) + collect (string-to-number + (concat (cl-subseq list (+ i 1) (+ i 4))) 8) + else + collect var)) + 'utf-8))) + +(cl-defun auth-source-macos-keychain-search-items (coll _type _max host port + &key label type user + &allow-other-keys) (let* ((keychain-generic (eq type 'macos-keychain-generic)) (args `(,(if keychain-generic "find-generic-password" @@ -1792,36 +1796,39 @@ entries for git.gnus.org: (goto-char (point-min)) (while (not (eobp)) (cond - ((looking-at "^password: \"\\(.+\\)\"$") + ((looking-at "^password: \\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"") (setq ret (auth-source-macos-keychain-result-append ret keychain-generic "secret" - (lexical-let ((v (match-string 1))) + (let ((v (auth-source--decode-octal-string + (match-string 1)))) (lambda () v))))) ;; TODO: check if this is really the label ;; match 0x00000007 <blob>="AppleID" - ((looking-at "^[ ]+0x00000007 <blob>=\"\\(.+\\)\"") + ((looking-at + "^[ ]+0x00000007 <blob>=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"") (setq ret (auth-source-macos-keychain-result-append ret keychain-generic "label" - (match-string 1)))) + (auth-source--decode-octal-string (match-string 1))))) ;; match "crtr"<uint32>="aapl" ;; match "svce"<blob>="AppleID" - ((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"") + ((looking-at + "^[ ]+\"\\([a-z]+\\)\"[^=]+=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"") (setq ret (auth-source-macos-keychain-result-append ret keychain-generic - (match-string 1) - (match-string 2))))) + (auth-source--decode-octal-string (match-string 1)) + (auth-source--decode-octal-string (match-string 2)))))) (forward-line))) ;; return `ret' iff it has the :secret key (and (plist-get ret :secret) (list ret)))) (defun auth-source-macos-keychain-result-append (result generic k v) (push v result) - (push (auto-source--symbol-keyword + (push (auth-source--symbol-keyword (cond ((equal k "acct") "user") ;; for generic keychains, creator is host, service is port @@ -1839,18 +1846,16 @@ entries for git.gnus.org: ;;; Backend specific parsing: PLSTORE backend -(defun* auth-source-plstore-search (&rest - spec - &key backend create delete - max - &allow-other-keys) +(cl-defun auth-source-plstore-search (&rest spec + &key backend create delete max + &allow-other-keys) "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K (ignored-keys '(:create :delete :max :backend :label :require :type)) - (search-keys (loop for i below (length spec) by 2 - unless (memq (nth i spec) ignored-keys) - collect (nth i spec))) + (search-keys (cl-loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) ;; build a search spec without the ignored keys ;; if a search key is nil or t (match anything), we skip it (search-spec (apply #'append (mapcar @@ -1877,7 +1882,7 @@ entries for git.gnus.org: (if secret (setcar (cdr secret) - (lexical-let ((v (car (cdr secret)))) + (let ((v (car (cdr secret)))) (lambda () v)))) plist)) items)) @@ -1915,10 +1920,9 @@ entries for git.gnus.org: (plstore-save store))) items)) -(defun* auth-source-plstore-create (&rest spec - &key backend - host port create - &allow-other-keys) +(cl-defun auth-source-plstore-create (&rest spec + &key backend host port create + &allow-other-keys) (let* ((base-required '(host user port secret)) (base-secret '(secret)) ;; we know (because of an assertion in auth-source-search) that the @@ -1938,7 +1942,7 @@ entries for git.gnus.org: ;; fill in the valist with whatever data we may have from the search ;; we complete the first value if it's a list and use the value otherwise (dolist (br base-required) - (let ((val (plist-get spec (auto-source--symbol-keyword br)))) + (let ((val (plist-get spec (auth-source--symbol-keyword br)))) (when val (let ((br-choice (cond ;; all-accepting choice (predicate is t) @@ -1950,9 +1954,9 @@ entries for git.gnus.org: ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) - (let ((k (auto-source--symbol-keyword er)) - (keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((k (auth-source--symbol-keyword er)) + (keys (cl-loop for i below (length spec) by 2 + collect (nth i spec)))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1962,7 +1966,7 @@ entries for git.gnus.org: ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data - (auto-source--symbol-keyword r)))) + (auth-source--symbol-keyword r)))) ;; this is the default to be offered (given-default (auth-source--aget auth-source-creation-defaults r)) @@ -1993,7 +1997,7 @@ entries for git.gnus.org: (plist-get artificial :port) "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) - (case r + (cl-case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") (host "%p host name for user %u: ") @@ -2022,10 +2026,10 @@ entries for git.gnus.org: (if (member r base-secret) (setq secret-artificial (plist-put secret-artificial - (auto-source--symbol-keyword r) + (auth-source--symbol-keyword r) data)) (setq artificial (plist-put artificial - (auto-source--symbol-keyword r) + (auth-source--symbol-keyword r) data)))))) (plstore-put (oref backend data) (sha1 (format "%s@%s:%s" diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 14e39bddd2e..1129af8a2fa 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -51,6 +51,12 @@ ;; Emacs. You should never even notice that this package is active ;; (except that your buffers will be reverted, of course). ;; +;; If the file exists, Auto-Revert Mode updates the buffer based on +;; its (possibly empty) contents. If the file no longer exists, then +;; there is nothing to revert, so it does not modify the buffer. Once +;; a deleted file corresponding to a buffer in Auto-Revert Mode +;; reappears, Auto-Revert Mode continues to work. +;; ;; If Emacs is compiled with file notification support, notifications ;; are used instead of checking the time stamp of the files. You can ;; disable this by setting the user option `auto-revert-use-notify' to @@ -58,19 +64,19 @@ ;; excluded from file notifications can be specified by ;; `auto-revert-notify-exclude-dir-regexp'. ;; -;; After reverting a file buffer, Auto Revert Mode normally puts point +;; After reverting a file buffer, Auto-Revert Mode normally puts point ;; at the same position that a regular manual revert would. However, ;; there is one exception to this rule. If point is at the end of the ;; buffer before reverting, it stays at the end. Similarly if point ;; is displayed at the end of a file buffer in any window, it will stay ;; at the end of the buffer in that window, even if the window is not -;; selected. This way, you can use Auto Revert Mode to `tail' a file. +;; selected. This way, you can use Auto-Revert Mode to `tail' a file. ;; Just put point at the end of the buffer and it will stay there. ;; These rules apply to file buffers. For non-file buffers, the ;; behavior may be mode dependent. ;; -;; While you can use Auto Revert Mode to tail a file, this package -;; contains a third minor mode, Auto Revert Tail Mode, which does so +;; While you can use Auto-Revert Mode to tail a file, this package +;; contains a third minor mode, Auto-Revert Tail Mode, which does so ;; more efficiently, as long as you are sure that the file will only ;; change by growing at the end. It only appends the new output, ;; instead of reverting the entire buffer. It does so even if the @@ -112,8 +118,8 @@ (defgroup auto-revert nil "Revert individual buffers when files on disk change. -Auto-Revert mode enables auto-revert in individual buffers. -Global Auto-Revert mode does so in all buffers." +Auto-Revert Mode enables auto-revert in individual buffers. +Global Auto-Revert Mode does so in all buffers." :group 'files :group 'convenience) @@ -144,7 +150,7 @@ If a timer is already active, there are two ways to make sure that the new value will take effect immediately. You can set this variable through Custom or you can call the command `auto-revert-set-timer' after setting the variable. Otherwise, -the new value will take effect the first time Auto Revert Mode +the new value will take effect the first time Auto-Revert Mode calls `auto-revert-set-timer' for internal reasons or in your next editing session." :group 'auto-revert @@ -176,7 +182,7 @@ When non-nil, a message is generated whenever a file is reverted." "String to display in the mode line when Auto-Revert Mode is active. \(When the string is not empty, make sure that it has a leading space.)" - :tag "Auto Revert Mode Text" ; To separate it from `global-...' + :tag "Auto-Revert Mode Text" ; To separate it from `global-...' :group 'auto-revert :type 'string) @@ -190,7 +196,7 @@ When non-nil, a message is generated whenever a file is reverted." (defcustom auto-revert-mode-hook nil "Functions to run when Auto-Revert Mode is activated." - :tag "Auto Revert Mode Hook" ; To separate it from `global-...' + :tag "Auto-Revert Mode Hook" ; To separate it from `global-...' :group 'auto-revert :type 'hook) @@ -209,11 +215,11 @@ would only waste precious space." :type 'hook) (defcustom global-auto-revert-non-file-buffers nil - "When nil, Global Auto-Revert mode operates only on file-visiting buffers. + "When nil, Global Auto-Revert Mode operates only on file-visiting buffers. When non-nil, both file buffers and buffers with a custom `revert-buffer-function' and a `buffer-stale-function' are -reverted by Global Auto-Revert mode. These include the Buffer +reverted by Global Auto-Revert Mode. These include the Buffer List buffer displayed by `buffer-menu', and Dired buffers showing complete local directories. The Buffer List buffer reverts every `auto-revert-interval' seconds; Dired buffers when the file list of @@ -240,8 +246,8 @@ For more information, see Info node `(emacs)Autorevert'." :type 'hook) (defcustom auto-revert-check-vc-info nil - "If non-nil Auto Revert Mode reliably updates version control info. -Auto Revert Mode updates version control info whenever the buffer + "If non-nil Auto-Revert Mode reliably updates version control info. +Auto-Revert Mode updates version control info whenever the buffer needs reverting, regardless of the value of this variable. However, the version control state can change without changes to the work file. If the change is made from the current Emacs @@ -271,7 +277,7 @@ This variable becomes buffer local when set in any fashion.") :version "24.4") (defcustom auto-revert-use-notify t - "If non-nil Auto Revert Mode uses file notification functions. + "If non-nil Auto-Revert Mode uses file notification functions. You should set this variable through Custom." :group 'auto-revert :type 'boolean @@ -337,12 +343,12 @@ This has been reported by a file notification event.") ;;;###autoload (define-minor-mode auto-revert-mode - "Toggle reverting buffer when the file changes (Auto Revert mode). -With a prefix argument ARG, enable Auto Revert mode if ARG is + "Toggle reverting buffer when the file changes (Auto-Revert Mode). +With a prefix argument ARG, enable Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Auto Revert mode is a minor mode that affects only the current +Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on disk changes. @@ -351,8 +357,14 @@ Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer." :group 'auto-revert :lighter auto-revert-mode-text (if auto-revert-mode - (if (not (memq (current-buffer) auto-revert-buffer-list)) - (push (current-buffer) auto-revert-buffer-list)) + (when (not (memq (current-buffer) auto-revert-buffer-list)) + (push (current-buffer) auto-revert-buffer-list) + (add-hook + 'kill-buffer-hook + (lambda () + (setq auto-revert-buffer-list + (delq (current-buffer) auto-revert-buffer-list))) + nil t)) (when auto-revert-use-notify (auto-revert-notify-rm-watch)) (setq auto-revert-buffer-list (delq (current-buffer) auto-revert-buffer-list))) @@ -374,11 +386,11 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode auto-revert-tail-mode "Toggle reverting tail of buffer when the file grows. -With a prefix argument ARG, enable Auto-Revert Tail mode if ARG +With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -When Auto Revert Tail mode is enabled, the tail of the file is +When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This means that whenever the file grows on disk (presumably because some background process is appending to it from time to time), @@ -428,7 +440,7 @@ Perform a full revert? ") ;;;###autoload (defun turn-on-auto-revert-tail-mode () - "Turn on Auto-Revert Tail mode. + "Turn on Auto-Revert Tail Mode. This function is designed to be added to hooks, for example: (add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode)" @@ -437,12 +449,12 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode global-auto-revert-mode - "Toggle Global Auto Revert mode. -With a prefix argument ARG, enable Global Auto Revert mode if ARG + "Toggle Global Auto-Revert Mode. +With a prefix argument ARG, enable Global Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Global Auto Revert mode is a global minor mode that reverts any +Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use `auto-revert-mode' to revert a particular buffer. @@ -573,16 +585,19 @@ no more reverts are possible until the next call of (if (eq action 'stopped) ;; File notification has stopped. Continue with polling. - (cl-dolist (buffer buffers) + (cl-dolist (buffer + (if global-auto-revert-mode + (buffer-list) auto-revert-buffer-list)) (with-current-buffer buffer - (when (or - ;; A buffer associated with a file. - (and (stringp buffer-file-name) - (string-equal - (file-name-nondirectory file) - (file-name-nondirectory buffer-file-name))) - ;; A buffer w/o a file, like dired. - (null buffer-file-name)) + (when (and (equal descriptor auto-revert-notify-watch-descriptor) + (or + ;; A buffer associated with a file. + (and (stringp buffer-file-name) + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory buffer-file-name))) + ;; A buffer w/o a file, like dired. + (null buffer-file-name))) (auto-revert-notify-rm-watch) (setq-local auto-revert-use-notify nil)))) @@ -680,7 +695,10 @@ This is an internal function used by Auto-Revert Mode." ;; not to forget that. This gives undesirable results when ;; the file's mode changes, but that is less common. (let ((buffer-read-only buffer-read-only)) - (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))) + ;; Bug#23276: When the file has been deleted, keep the + ;; buffer unchanged. + (ignore-errors + (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))) (when buffer-file-name (when eob (goto-char (point-max))) (dolist (window eoblist) @@ -733,7 +751,7 @@ To avoid starvation, the buffers in `auto-revert-remaining-buffers' are checked first the next time this function is called. This function is also responsible for removing buffers no longer in -Auto-Revert mode from `auto-revert-buffer-list', and for canceling +Auto-Revert Mode from `auto-revert-buffer-list', and for canceling the timer when no buffers need to be checked." (setq auto-revert-buffers-counter diff --git a/lisp/battery.el b/lisp/battery.el index b5e312f6c3e..74f06e8c6fc 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -22,10 +22,10 @@ ;;; Commentary: -;; There is at present support for GNU/Linux, OS X and Windows. This +;; There is at present support for GNU/Linux, macOS and Windows. This ;; library supports both the `/proc/apm' file format of Linux version ;; 1.3.58 or newer and the `/proc/acpi/' directory structure of Linux -;; 2.4.20 and 2.6. Darwin (OS X) is supported by using the `pmset' +;; 2.4.20 and 2.6. Darwin (macOS) is supported by using the `pmset' ;; program. Windows is supported by the GetSystemPowerStatus API call. ;;; Code: @@ -38,8 +38,18 @@ :prefix "battery-" :group 'hardware) -;; Either BATn or yeeloong-bat, basically. -(defconst battery--linux-sysfs-regexp "[bB][aA][tT][0-9]?$") +(defcustom battery-linux-sysfs-regexp "[bB][aA][tT][0-9]?$" + "Regexp for folder names to be searched under + /sys/class/power_supply/ that contain battery information." + :version "26.1" + :type 'regexp + :group 'battery) + +(defcustom battery-upower-device "battery_BAT1" + "Upower battery device name." + :version "26.1" + :type 'string + :group 'battery) (defcustom battery-status-function (cond ((and (eq system-type 'gnu/linux) @@ -51,7 +61,7 @@ ((and (eq system-type 'gnu/linux) (file-directory-p "/sys/class/power_supply/") (directory-files "/sys/class/power_supply/" nil - battery--linux-sysfs-regexp)) + battery-linux-sysfs-regexp)) #'battery-linux-sysfs) ((and (eq system-type 'berkeley-unix) (file-executable-p "/usr/sbin/apm")) @@ -445,7 +455,7 @@ The following %-sequences are provided: (dolist (dir (ignore-errors (directory-files "/sys/class/power_supply/" t - battery--linux-sysfs-regexp))) + battery-linux-sysfs-regexp))) (erase-buffer) (ignore-errors (insert-file-contents (expand-file-name "uevent" dir))) @@ -532,6 +542,69 @@ The following %-sequences are provided: (t "N/A")))))) +;;; `upowerd' interface. +(defsubst battery-upower-prop (pname &optional device) + (dbus-get-property + :system + "org.freedesktop.UPower" + (concat "/org/freedesktop/UPower/devices/" (or device battery-upower-device)) + "org.freedesktop.UPower" + pname)) + +(defun battery-upower () + "Get battery status from dbus Upower interface. +This function works only in systems with `upowerd' daemon +running. + +The following %-sequences are provided: +%c Current capacity (mWh) +%p Battery load percentage +%r Current rate +%B Battery status (verbose) +%L AC line status (verbose) +%s Remaining time (to charge or discharge) in seconds +%m Remaining time (to charge or discharge) in minutes +%h Remaining time (to charge or discharge) in hours +%t Remaining time (to charge or discharge) in the form `h:min'" + (let ((percents (battery-upower-prop "Percentage")) + (time-to-empty (battery-upower-prop "TimeToEmpty")) + (time-to-full (battery-upower-prop "TimeToFull")) + (state (battery-upower-prop "State")) + (online (battery-upower-prop "Online" "line_power_ACAD")) + (energy (battery-upower-prop "Energy")) + (energy-rate (battery-upower-prop "EnergyRate")) + (battery-states '((0 . "unknown") (1 . "charging") + (2 . "discharging") (3 . "empty") + (4 . "fully-charged") (5 . "pending-charge") + (6 . "pending-discharge"))) + seconds minutes hours remaining-time) + (cond ((and online time-to-full) + (setq seconds time-to-full)) + ((and (not online) time-to-empty) + (setq seconds time-to-empty))) + (when seconds + (setq minutes (/ seconds 60) + hours (/ minutes 60) + remaining-time + (format "%d:%02d" (truncate hours) + (- (truncate minutes) (* 60 (truncate hours)))))) + (list (cons ?c (or (and energy + (number-to-string (round (* 1000 energy)))) + "N/A")) + (cons ?p (or (and percents (number-to-string (round percents))) + "N/A")) + (cons ?r (or (and energy-rate + (concat (number-to-string energy-rate) " W")) + "N/A")) + (cons ?B (or (and state (cdr (assoc state battery-states))) + "unknown")) + (cons ?L (or (and online "on-line") "off-line")) + (cons ?s (or (and seconds (number-to-string seconds)) "N/A")) + (cons ?m (or (and minutes (number-to-string minutes)) "N/A")) + (cons ?h (or (and hours (number-to-string hours)) "N/A")) + (cons ?t (or remaining-time "N/A"))))) + + ;;; `apm' interface for BSD. (defun battery-bsd-apm () "Get APM status information from BSD apm binary. @@ -600,7 +673,7 @@ The following %-sequences are provided: (cons ?t (or remaining-time "N/A"))))) -;;; `pmset' interface for Darwin (OS X). +;;; `pmset' interface for Darwin (macOS). (defun battery-pmset () "Get battery status information using `pmset'. @@ -621,7 +694,7 @@ The following %-sequences are provided: (goto-char (point-min)) (when (re-search-forward "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'" nil t) (setq power-source (match-string 1)) - (when (re-search-forward "^ -InternalBattery-0[ \t]+" nil t) + (when (re-search-forward "^ -InternalBattery-0\\([ \t]+(id=[0-9]+)\\)*[ \t]+" nil t) (when (looking-at "\\([0-9]\\{1,3\\}\\)%") (setq load-percentage (match-string 1)) (goto-char (match-end 0)) diff --git a/lisp/bindings.el b/lisp/bindings.el index b64cd71fe24..c13f4b156a1 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -338,6 +338,10 @@ mouse-3: Toggle minor modes" (defvar mode-line-column-line-number-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Toggle Line and Column Number Display"))) + (bindings--define-key menu-map [size-indication-mode] + '(menu-item "Display Size Indication" size-indication-mode + :help "Toggle displaying a size indication in the mode-line" + :button (:toggle . size-indication-mode))) (bindings--define-key menu-map [line-number-mode] '(menu-item "Display Line Numbers" line-number-mode :help "Toggle displaying line numbers in the mode-line" diff --git a/lisp/bookmark.el b/lisp/bookmark.el index c2f8cc3fbc1..f3c8b2a755f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -74,7 +74,7 @@ bookmark is to set this variable to 1 (or 0, which produces the same behavior.) To specify the file in which to save them, modify the variable -`bookmark-default-file', which is `~/.emacs.bmk' by default." +`bookmark-default-file'." :type '(choice (const nil) integer (other t)) :group 'bookmark) @@ -1481,9 +1481,9 @@ while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first -place. Your own personal bookmark file, `~/.emacs.bmk', is -maintained automatically by Emacs; you shouldn't need to load it -explicitly. +place. Your own personal bookmark file, specified by the variable +`bookmark-default-file', is maintained automatically by Emacs; you +shouldn't need to load it explicitly. If you load a file containing bookmarks with the same names as bookmarks already present in your Emacs, the new bookmarks will get diff --git a/lisp/bs.el b/lisp/bs.el index 835116912d4..d05a568197c 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -491,6 +491,8 @@ Used internally, only.") (define-key map "t" 'bs-visit-tags-table) (define-key map "m" 'bs-mark-current) (define-key map "u" 'bs-unmark-current) + (define-key map "U" 'bs-unmark-all) + (define-key map "\177" 'bs-unmark-previous) (define-key map ">" 'scroll-right) (define-key map "<" 'scroll-left) (define-key map "?" 'bs-help) @@ -635,6 +637,8 @@ For faster navigation each digit key is a digit argument. \\[bs-clear-modified] -- clear modified-flag on that buffer. \\[bs-mark-current] -- mark current line's buffer to be displayed. \\[bs-unmark-current] -- unmark current line's buffer to be displayed. +\\[bs-unmark-all] -- unmark all buffer lines. +\\[bs-unmark-previous] -- unmark previous line's buffer to be displayed. \\[bs-show-sorted] -- display buffer list sorted by next sort aspect. \\[bs-set-configuration-and-refresh] -- ask user for a configuration and \ apply selected configuration. @@ -867,7 +871,7 @@ the status of buffer on current line." (defun bs-mark-current (count) "Mark buffers. COUNT is the number of buffers to mark. -Move cursor vertically down COUNT lines." +Move point vertically down COUNT lines." (interactive "p") (bs--mark-unmark count (lambda (buf) @@ -876,12 +880,39 @@ Move cursor vertically down COUNT lines." (defun bs-unmark-current (count) "Unmark buffers. COUNT is the number of buffers to unmark. -Move cursor vertically down COUNT lines." +Move point vertically down COUNT lines." (interactive "p") (bs--mark-unmark count (lambda (buf) (setq bs--marked-buffers (delq buf bs--marked-buffers))))) +(defun bs-unmark-previous (count) + "Unmark previous COUNT buffers. +Move point vertically up COUNT lines. +When called interactively a numeric prefix argument sets COUNT." + (interactive "p") + (forward-line (- count)) + (save-excursion (bs-unmark-current count))) + +(defun bs-unmark-all () + "Unmark all buffers." + (interactive) + (let ((marked (string-to-char bs-string-marked)) + (current (string-to-char bs-string-current)) + (marked-cur (string-to-char bs-string-current-marked)) + (unmarked (string-to-char bs-string-show-normally)) + (inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (while (not (eobp)) + (if (eq (char-after) marked) + (subst-char-in-region (point) (1+ (point)) marked unmarked) + (when (eq (char-after) marked-cur) + (subst-char-in-region (point) (1+ (point)) marked-cur current))) + (forward-line 1)) + (setq bs--marked-buffers nil)))) + (defun bs--show-config-message (what) "Show message indicating the new showing status WHAT. WHAT is a value of nil, `never', or `always'." @@ -973,14 +1004,14 @@ Uses function `read-only-mode'." (apply fun args))) (defun bs-up (arg) - "Move cursor vertically up ARG lines in Buffer Selection Menu." + "Move point vertically up ARG lines in Buffer Selection Menu." (interactive "p") (if (and arg (numberp arg) (< arg 0)) (bs--nth-wrapper (- arg) 'bs--down) (bs--nth-wrapper arg 'bs--up))) (defun bs--up () - "Move cursor vertically up one line. + "Move point vertically up one line. If on top of buffer list go to last line." (if (> (count-lines 1 (point)) bs-header-lines-length) (forward-line -1) @@ -989,14 +1020,14 @@ If on top of buffer list go to last line." (recenter -1))) (defun bs-down (arg) - "Move cursor vertically down ARG lines in Buffer Selection Menu." + "Move point vertically down ARG lines in Buffer Selection Menu." (interactive "p") (if (and arg (numberp arg) (< arg 0)) (bs--nth-wrapper (- arg) 'bs--up) (bs--nth-wrapper arg 'bs--down))) (defun bs--down () - "Move cursor vertically down one line. + "Move point vertically down one line. If at end of buffer list go to first line." (if (eq (line-end-position) (point-max)) (progn diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 47426285c80..dcf5b0f3888 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -37,6 +37,12 @@ :group 'tools :group 'convenience) +(defvar Buffer-menu-marker-char ?> + "The mark character for marked buffers.") + +(defvar Buffer-menu-del-char ?D + "Character used to flag buffers for deletion.") + (defcustom Buffer-menu-use-header-line t "If non-nil, use the header line to display Buffer Menu column titles." :type 'boolean @@ -121,6 +127,8 @@ commands.") (define-key map "\177" 'Buffer-menu-backup-unmark) (define-key map "~" 'Buffer-menu-not-modified) (define-key map "u" 'Buffer-menu-unmark) + (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers) + (define-key map "U" 'Buffer-menu-unmark-all) (define-key map "m" 'Buffer-menu-mark) (define-key map "t" 'Buffer-menu-visit-tags-table) (define-key map "%" 'Buffer-menu-toggle-read-only) @@ -197,6 +205,12 @@ commands.") (bindings--define-key menu-map [umk] '(menu-item "Unmark" Buffer-menu-unmark :help "Cancel all requested operations on buffer on this line and move down")) + (bindings--define-key menu-map [umkab] + '(menu-item "Remove marks..." Buffer-menu-unmark-all-buffers + :help "Cancel a requested operation on all buffers")) + (bindings--define-key menu-map [umka] + '(menu-item "Unmark all" Buffer-menu-unmark-all + :help "Cancel all requested operations on buffers")) (bindings--define-key menu-map [mk] '(menu-item "Mark" Buffer-menu-mark :help "Mark buffer on this line for being displayed by v command")) @@ -239,6 +253,8 @@ In Buffer Menu mode, the following commands are defined: \\[Buffer-menu-execute] Delete or save marked buffers. \\[Buffer-menu-unmark] Remove all marks from current line. With prefix argument, also move up one line. +\\[Buffer-menu-unmark-all-buffers] Remove a particular mark from all lines. +\\[Buffer-menu-unmark-all] Remove all marks from all lines. \\[Buffer-menu-backup-unmark] Back up a line and remove marks. \\[Buffer-menu-toggle-read-only] Toggle read-only status of buffer on this line. \\[revert-buffer] Update the list of buffers. @@ -328,7 +344,7 @@ is nil or omitted, and signal an error otherwise." (defun Buffer-menu-no-header () (beginning-of-line) (if (or Buffer-menu-use-header-line - (not (eq (char-after) ?C))) + (not (tabulated-list-header-overlay-p (point)))) t (ding) (forward-line 1) @@ -346,7 +362,7 @@ is nil or omitted, and signal an error otherwise." "Mark the Buffer menu entry at point for later display. It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command." (interactive) - (tabulated-list-set-col 0 ">" t) + (tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t) (forward-line)) (defun Buffer-menu-unmark (&optional backup) @@ -356,6 +372,28 @@ Optional prefix arg means move up." (Buffer-menu--unmark) (forward-line (if backup -1 1))) +(defun Buffer-menu-unmark-all-buffers (mark) + "Cancel a requested operation on all buffers. +MARK is the character to flag the operation on the buffers. +When called interactively prompt for MARK; RET remove all marks." + (interactive "cRemove marks (RET means all):") + (save-excursion + (goto-char (point-min)) + (when (tabulated-list-header-overlay-p) + (forward-line)) + (while (not (eobp)) + (let ((xmarks (list (aref (tabulated-list-get-entry) 0) + (aref (tabulated-list-get-entry) 2)))) + (when (or (char-equal mark ?\r) + (member (char-to-string mark) xmarks)) + (Buffer-menu--unmark))) + (forward-line)))) + +(defun Buffer-menu-unmark-all () + "Cancel all requested operations on buffers." + (interactive) + (Buffer-menu-unmark-all-buffers ?\r)) + (defun Buffer-menu-backup-unmark () "Move up and cancel all requested operations on buffer on line above." (interactive) @@ -382,12 +420,12 @@ buffers to delete; a negative ARG means to delete backwards." (setq arg 1)) (while (> arg 0) (when (Buffer-menu-buffer) - (tabulated-list-set-col 0 "D" t)) + (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t)) (forward-line 1) (setq arg (1- arg))) (while (< arg 0) (when (Buffer-menu-buffer) - (tabulated-list-set-col 0 "D" t)) + (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t)) (forward-line -1) (setq arg (1+ arg)))) @@ -633,7 +671,8 @@ means list those buffers and no others." (file buffer-file-name)) (when (and (buffer-live-p buffer) (or buffer-list - (and (not (string= (substring name 0 1) " ")) + (and (or (not (string= (substring name 0 1) " ")) + file) (not (eq buffer buffer-menu-buffer)) (or file show-non-file)))) (push (list buffer diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 3cafd962127..cc0972e4775 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1633,6 +1633,7 @@ calc-kill calc-kill-region calc-yank)))) (not (equal var '(calc-mode-save-mode))) (calc-save-modes)))) (if calc-embedded-info (calc-embedded-modes-change var)) + (calc-set-mode-line) (symbol-value (car var))))) (defun calc-toggle-banner () diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index c94b89d6b10..153b90429ea 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -317,7 +317,9 @@ (list 'calcFunc-hms a)) ((math-negp a) (math-neg (math-to-hms (math-neg a) ang))) - ((eq (or ang calc-angle-mode) 'rad) + ((eq (or ang + (and (not math-simplifying-units) calc-angle-mode)) + 'rad) (math-to-hms (math-div a (math-pi-over-180)) 'deg)) ((memq (car-safe a) '(cplx polar)) a) (t @@ -354,12 +356,16 @@ (if (eq (car-safe a) 'sdev) (math-make-sdev (math-from-hms (nth 1 a) ang) (math-from-hms (nth 2 a) ang)) - (if (eq (or ang calc-angle-mode) 'rad) + (if (eq (or ang + (and (not math-simplifying-units) calc-angle-mode)) + 'rad) (list 'calcFunc-rad a) (list 'calcFunc-deg a))))) ((math-negp a) (math-neg (math-from-hms (math-neg a) ang))) - ((eq (or ang calc-angle-mode) 'rad) + ((eq (or ang + (and (not math-simplifying-units) calc-angle-mode)) + 'rad) (math-mul (math-from-hms a 'deg) (math-pi-over-180))) (t (math-add (math-div (math-add (math-div (nth 3 a) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 3dedbbc434a..6357c97a0b2 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -908,9 +908,9 @@ (defun calc-graph-show-tty (output) "Default calc-gnuplot-plot-command for \"tty\" output mode. This is useful for tek40xx and other graphics-terminal types." - (call-process-region 1 1 shell-file-name - nil calc-gnuplot-buffer nil - "-c" (format "cat %s >/dev/tty; rm %s" output output))) + (call-process shell-file-name nil calc-gnuplot-buffer nil + shell-command-switch + (format "cat %s >/dev/tty; rm %s" output output))) (defvar calc-dumb-map nil "The keymap for the \"dumb\" terminal plot.") diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 699ef6f49ae..567635eb65b 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -763,12 +763,14 @@ If this can't be done, return NIL." (defun math-to-radians (a) ; [N N] (cond ((eq (car-safe a) 'hms) (math-from-hms a 'rad)) - ((memq calc-angle-mode '(deg hms)) + ((and (not math-simplifying-units) + (memq calc-angle-mode '(deg hms))) (math-mul a (math-pi-over-180))) (t a))) (defun math-from-radians (a) ; [N N] - (cond ((eq calc-angle-mode 'deg) + (cond ((and (not math-simplifying-units) + (eq calc-angle-mode 'deg)) (if (math-constp a) (math-div a (math-pi-over-180)) (list 'calcFunc-deg a))) @@ -779,14 +781,16 @@ If this can't be done, return NIL." (defun math-to-radians-2 (a &optional force-symbolic) ; [N N] (cond ((eq (car-safe a) 'hms) (math-from-hms a 'rad)) - ((memq calc-angle-mode '(deg hms)) + ((and (not math-simplifying-units) + (memq calc-angle-mode '(deg hms))) (if (or calc-symbolic-mode force-symbolic) (math-div (math-mul a '(var pi var-pi)) 180) (math-mul a (math-pi-over-180)))) (t a))) (defun math-from-radians-2 (a &optional force-symbolic) ; [N N] - (cond ((memq calc-angle-mode '(deg hms)) + (cond ((and (not math-simplifying-units) + (memq calc-angle-mode '(deg hms))) (if (or calc-symbolic-mode force-symbolic) (math-div (math-mul 180 a) '(var pi var-pi)) (math-div a (math-pi-over-180)))) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index ccdae484fa6..5cea46b2de4 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -330,6 +330,8 @@ The marking symbol is specified by the variable `calendar-holiday-marker'." This is the place to add key bindings to `calendar-mode-map'." :type 'hook :group 'calendar-hooks) +(make-obsolete-variable 'calendar-load-hook + "use `with-eval-after-load' instead." "26.1") (defcustom calendar-initial-window-hook nil "List of functions to be called when the calendar window is created. @@ -905,7 +907,7 @@ styles." '(propertize (format "%s %d" (calendar-month-name month) year) 'font-lock-face 'calendar-month-header) "Default format for calendar month headings with the American date style. -Normally you should not customize this, but `calender-month-header'." +Normally you should not customize this, but `calendar-month-header'." :group 'calendar :risky t :type 'sexp @@ -915,7 +917,7 @@ Normally you should not customize this, but `calender-month-header'." '(propertize (format "%s %d" (calendar-month-name month) year) 'font-lock-face 'calendar-month-header) "Default format for calendar month headings with the European date style. -Normally you should not customize this, but `calender-month-header'." +Normally you should not customize this, but `calendar-month-header'." :group 'calendar :risky t :type 'sexp @@ -925,7 +927,7 @@ Normally you should not customize this, but `calender-month-header'." '(propertize (format "%d %s" year (calendar-month-name month)) 'font-lock-face 'calendar-month-header) "Default format for calendar month headings with the ISO date style. -Normally you should not customize this, but `calender-month-header'." +Normally you should not customize this, but `calendar-month-header'." :group 'calendar :risky t :type 'sexp @@ -1257,7 +1259,6 @@ diary entries can also be marked on the calendar (see Runs the following hooks: -`calendar-load-hook' - after loading calendar.el `calendar-today-visible-hook', `calendar-today-invisible-hook' - after generating a calendar, if today's date is visible or not, respectively `calendar-initial-window-hook' - after first creating a calendar diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 386c554c068..2f557f547af 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -1,4 +1,4 @@ -;;; icalendar.el --- iCalendar implementation +;;; icalendar.el --- iCalendar implementation -*- lexical-binding: t -*- ;; Copyright (C) 2002-2016 Free Software Foundation, Inc. @@ -361,7 +361,8 @@ Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to INVALUE gives the current iCalendar element we are reading. INPARAMS gives the current parameters..... This function calls itself recursively for each nested calendar element -it finds." +it finds. The current buffer should be an unfolded buffer as returned +from `icalendar--get-unfolded-buffer'." (let (element children line name params param param-name param-value value (continue t)) @@ -391,8 +392,9 @@ it finds." (unless (looking-at ":") (error "Oops")) (forward-char 1) - (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t) - (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0))) + (let ((start (point))) + (end-of-line) + (setq value (buffer-substring start (point)))) (setq line (list name params value)) (cond ((eq name 'BEGIN) (setq children @@ -2387,22 +2389,43 @@ END-T is the event's end time in diary format." ;; monthly ((string-equal frequency "MONTHLY") (icalendar--dmsg "monthly") - (setq result - (format - "%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s" - (let ((day (nth 3 dtstart-dec))) - (cond ((eq calendar-date-style 'iso) - (format "t t %d" day)) - ((eq calendar-date-style 'european) - (format "%d t t" day)) - ((eq calendar-date-style 'american) - (format "t %d t" day)))) - dtstart-conv - (if until - until-conv - (if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited - (or start-t "") - (if end-t "-" "") (or end-t "")))) + (let* ((byday (cadr (assoc 'BYDAY rrule-props))) + (count-weekday + (and byday + (save-match-data + (when (string-match "\\(-?[0-9]+\\)\\([A-Z][A-Z]\\)" + byday) + (cons (substring byday + (match-beginning 1) + (match-end 1)) + (substring byday + (match-beginning 2) + (match-end 2))))))) + (rule-part + (if count-weekday + (let ((count (car count-weekday)) + (weekdaynum (icalendar--get-weekday-number + (cdr count-weekday)))) + ;; FIXME: this is valid only for interval==1 + (format "(diary-float t %s %s)" weekdaynum count)) + (format "(diary-date %s)" + (let ((day (nth 3 dtstart-dec))) + (cond ((eq calendar-date-style 'iso) + (format "t t %d" day)) + ((eq calendar-date-style 'european) + (format "%d t t" day)) + ((eq calendar-date-style 'american) + (format "t %d t" day)))))))) + (setq result + (format + "%%%%(and %s (diary-block %s %s)) %s%s%s" + rule-part + dtstart-conv + (if until + until-conv + (if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited + (or start-t "") + (if end-t "-" "") (or end-t ""))))) ;; daily ((and (string-equal frequency "DAILY")) (if until diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 6ba26a4a00d..b62f9fa7941 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -48,7 +48,9 @@ ((eq char ?:) ?d))) (defun parse-time-tokenize (string) - "Tokenize STRING into substrings." + "Tokenize STRING into substrings. +Each substring is a run of \"valid\" characters, i.e., lowercase +letters, digits, plus or minus signs or colons." (let ((start nil) (end (length string)) (all-digits nil) @@ -59,7 +61,8 @@ (while (and (< index end) ;Skip invalid characters. (not (setq c (parse-time-string-chars (aref string index))))) (cl-incf index)) - (setq start index all-digits (eq c ?0)) + (setq start index + all-digits (eq c ?0)) (while (and (< (cl-incf index) end) ;Scan valid characters. (setq c (parse-time-string-chars (aref string index)))) (setq all-digits (and all-digits (eq c ?0)))) @@ -143,8 +146,12 @@ ;;;###autoload (defun parse-time-string (string) "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -The values are identical to those of `decode-time', but any values that are -unknown are returned as nil." +STRING should be on something resembling an RFC2822 string, a la +\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is +somewhat liberal in what format it accepts, and will attempt to +return a \"likely\" value even for somewhat malformed strings. +The values returned are identical to those of `decode-time', but +any values that are unknown are returned as nil." (let ((time (list nil nil nil nil nil nil nil nil nil)) (temp (parse-time-tokenize (downcase string)))) (while temp diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index bf8bedd599e..6fec8055319 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -173,7 +173,7 @@ delta. At present, delta = 0.01 degrees, so the value of the variable ;;; End of user options. (defvar solar-sidereal-time-greenwich-midnight nil - "Sidereal time at Greenwich at midnight (universal time).") + "Sidereal time at Greenwich at midnight (Universal Time).") (defvar solar-northern-spring-or-summer-season nil "Non-nil if northern spring or summer and nil otherwise. @@ -413,8 +413,8 @@ Result is in days. For the years 1800-1987, the maximum error is (defun solar-ephemeris-time (time) "Ephemeris Time at moment TIME. TIME is a pair with the first component being the number of Julian centuries -elapsed at 0 Universal Time, and the second component being the universal -time. For instance, the pair corresponding to November 28, 1995 at 16 UT is +elapsed at 0 Universal Time, and the second component counting Universal Time +hours. For instance, the pair corresponding to November 28, 1995 at 16 UT is \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. @@ -430,7 +430,7 @@ Result is in Julian centuries of ephemeris time." "Right ascension (in hours) and declination (in degrees) of the sun at TIME. TIME is a pair with the first component being the number of Julian centuries elapsed at 0 Universal Time, and the second -component being the universal time. For instance, the pair +component counting Universal Time hours. For instance, the pair corresponding to November 28, 1995 at 16 UT is (-0.040945 16), -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed @@ -444,7 +444,7 @@ to `solar-ecliptic-coordinates'." "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE. TIME is a pair with the first component being the number of Julian centuries elapsed at 0 Universal Time, and the second -component being the universal time. For instance, the pair +component counting Universal Time hours. For instance, the pair corresponding to November 28, 1995 at 16 UT is (-0.040945 16), -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG @@ -476,8 +476,8 @@ Sunrise if DIRECTION =-1 or sunset if =1 at LATITUDE, LONGITUDE, with midday being TIME. TIME is a pair with the first component being the number of Julian centuries -elapsed at 0 Universal Time, and the second component being the universal -time. For instance, the pair corresponding to November 28, 1995 at 16 UT is +elapsed at 0 Universal Time, and the second component counting Universal Time +hours. For instance, the pair corresponding to November 28, 1995 at 16 UT is \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. @@ -522,8 +522,8 @@ Uses binary search." Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location. TIME is a pair with the first component being the number of Julian centuries -elapsed at 0 Universal Time, and the second component being the universal -time. For instance, the pair corresponding to November 28, 1995 at 16 UT is +elapsed at 0 Universal Time, and the second component counting Universal Time +hours. For instance, the pair corresponding to November 28, 1995 at 16 UT is \(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index da3e2a267db..a1d946eac74 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -126,16 +126,17 @@ type 2 is (HIGH LOW MICRO), and type 3 is (HIGH LOW MICRO PICO). For backward compatibility, if only four arguments are given, it is assumed that PICO was omitted and should be treated as zero." + (when (null type) + (setq type pico) + (setq pico 0)) (cond ((eq type 0) (cons high low)) ((eq type 1) (list high low)) ((eq type 2) (list high low micro)) - ((eq type 3) (list high low micro pico)) - ((null type) (encode-time-value high low micro 0 pico)))) + ((eq type 3) (list high low micro pico)))) -(when (and (fboundp 'time-add) (subrp (symbol-function 'time-add))) - (make-obsolete 'encode-time-value nil "25.1") - (make-obsolete 'with-decoded-time-value nil "25.1")) +(make-obsolete 'encode-time-value nil "25.1") +(make-obsolete 'with-decoded-time-value nil "25.1") (autoload 'parse-time-string "parse-time") (autoload 'timezone-make-date-arpa-standard "timezone") @@ -163,27 +164,8 @@ If DATE lacks timezone information, GMT is assumed." (apply 'signal err) (error "Invalid date: %s" date))))))))) -;; Bit of a mess. Emacs has float-time since at least 21.1. -;; This file is synced to Gnus, and XEmacs packages may have been written -;; using time-to-seconds from the Gnus library. -;;;###autoload(if (or (featurep 'emacs) -;;;###autoload (and (fboundp 'float-time) -;;;###autoload (subrp (symbol-function 'float-time)))) -;;;###autoload (defalias 'time-to-seconds 'float-time) -;;;###autoload (autoload 'time-to-seconds "time-date")) - -(eval-when-compile - (or (featurep 'emacs) - (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) - (defun time-to-seconds (&optional time) - "Convert optional value TIME to a floating point number. -TIME defaults to the current time." - (with-decoded-time-value ((high low micro pico _type - (or time (current-time)))) - (+ (* high 65536.0) - low - (/ (+ (* micro 1e6) pico) 1e12)))))) +;;;###autoload +(defalias 'time-to-seconds 'float-time) ;;;###autoload (defun seconds-to-time (seconds) @@ -209,68 +191,7 @@ TIME should be either a time value or a date-time string." (time-subtract nil time)) ;;;###autoload -(defalias 'subtract-time 'time-subtract) - -;; These autoloads do nothing in Emacs 25, where the functions are builtin. -;;;###autoload(autoload 'time-add "time-date") -;;;###autoload(autoload 'time-subtract "time-date") -;;;###autoload(autoload 'time-less-p "time-date") - -(eval-and-compile - (when (not (and (fboundp 'time-add) (subrp (symbol-function 'time-add)))) - - (defun time-add (t1 t2) - "Add two time values T1 and T2. One should represent a time difference." - (with-decoded-time-value ((high low micro pico type t1) - (high2 low2 micro2 pico2 type2 t2)) - (setq high (+ high high2) - low (+ low low2) - micro (+ micro micro2) - pico (+ pico pico2) - type (max type type2)) - (when (>= pico 1000000) - (setq micro (1+ micro) - pico (- pico 1000000))) - (when (>= micro 1000000) - (setq low (1+ low) - micro (- micro 1000000))) - (when (>= low 65536) - (setq high (1+ high) - low (- low 65536))) - (encode-time-value high low micro pico type))) - - (defun time-subtract (t1 t2) - "Subtract two time values, T1 minus T2. -Return the difference in the format of a time value." - (with-decoded-time-value ((high low micro pico type t1) - (high2 low2 micro2 pico2 type2 t2)) - (setq high (- high high2) - low (- low low2) - micro (- micro micro2) - pico (- pico pico2) - type (max type type2)) - (when (< pico 0) - (setq micro (1- micro) - pico (+ pico 1000000))) - (when (< micro 0) - (setq low (1- low) - micro (+ micro 1000000))) - (when (< low 0) - (setq high (1- high) - low (+ low 65536))) - (encode-time-value high low micro pico type))) - - (defun time-less-p (t1 t2) - "Return non-nil if time value T1 is earlier than time value T2." - (with-decoded-time-value ((high1 low1 micro1 pico1 _type1 t1) - (high2 low2 micro2 pico2 _type2 t2)) - (or (< high1 high2) - (and (= high1 high2) - (or (< low1 low2) - (and (= low1 low2) - (or (< micro1 micro2) - (and (= micro1 micro2) - (< pico1 pico2))))))))))) +(define-obsolete-function-alias 'subtract-time 'time-subtract "26.1") ;;;###autoload (defun date-to-day (date) @@ -324,12 +245,7 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (defun time-to-number-of-days (time) "Return the number of days represented by TIME. Returns a floating point number." - (/ (funcall (eval-when-compile - (if (or (featurep 'emacs) - (and (fboundp 'float-time) - (subrp (symbol-function 'float-time)))) - 'float-time - 'time-to-seconds)) time) (* 60 60 24))) + (/ (float-time time) (* 60 60 24))) ;;;###autoload (defun safe-date-to-time (date) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 2bdfd98344a..3d9e2462224 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -532,18 +532,17 @@ non-nil, the amount returned will be relative to past time worked." (message "%s" string) string))) -(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time - 'time-to-seconds)) - -(defalias 'timeclock-seconds-to-time 'seconds-to-time) +(define-obsolete-function-alias 'timeclock-time-to-seconds 'float-time "26.1") +(define-obsolete-function-alias 'timeclock-seconds-to-time 'seconds-to-time + "26.1") ;; Should today-only be removed in favor of timeclock-relative? - gm (defsubst timeclock-when-to-leave (&optional today-only) "Return a time value representing the end of today's workday. If TODAY-ONLY is non-nil, the value returned will be relative only to the time worked today, and not to past time." - (timeclock-seconds-to-time - (- (timeclock-time-to-seconds) + (seconds-to-time + (- (float-time) (let ((discrep (timeclock-find-discrep))) (if discrep (if today-only @@ -686,9 +685,8 @@ being logged for. Normally only \"in\" events specify a project." "\n") (if (equal (downcase code) "o") (setq timeclock-last-period - (- (timeclock-time-to-seconds now) - (timeclock-time-to-seconds - (cadr timeclock-last-event))) + (- (float-time now) + (float-time (cadr timeclock-last-event))) timeclock-discrepancy (+ timeclock-discrepancy timeclock-last-period))) @@ -723,14 +721,14 @@ recorded to disk. If MOMENT is non-nil, use that as the current time. This is only provided for coherency when used by `timeclock-discrepancy'." (if (equal (car timeclock-last-event) "i") - (- (timeclock-time-to-seconds moment) - (timeclock-time-to-seconds (cadr timeclock-last-event))) + (- (float-time moment) + (float-time (cadr timeclock-last-event))) timeclock-last-period)) (defsubst timeclock-entry-length (entry) "Return the length of ENTRY in seconds." - (- (timeclock-time-to-seconds (cadr entry)) - (timeclock-time-to-seconds (car entry)))) + (- (float-time (cadr entry)) + (float-time (car entry)))) (defsubst timeclock-entry-begin (entry) "Return the start time of ENTRY." @@ -765,8 +763,8 @@ This is only provided for coherency when used by (defsubst timeclock-entry-list-span (entry-list) "Return the total time in seconds spanned by ENTRY-LIST." - (- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list)) - (timeclock-time-to-seconds (timeclock-entry-list-begin entry-list)))) + (- (float-time (timeclock-entry-list-end entry-list)) + (float-time (timeclock-entry-list-begin entry-list)))) (defsubst timeclock-entry-list-break (entry-list) "Return the total break time (span - length) in ENTRY-LIST." @@ -1137,7 +1135,7 @@ discrepancy, today's discrepancy, and the time worked today." last-date-limited nil) (if beg (error "Error in format of timelog file!") - (setq beg (timeclock-time-to-seconds (cadr event)))))) + (setq beg (float-time (cadr event)))))) ((equal (downcase (car event)) "o") (if (and (nth 2 event) (> (length (nth 2 event)) 0)) @@ -1145,7 +1143,7 @@ discrepancy, today's discrepancy, and the time worked today." (if (not beg) (error "Error in format of timelog file!") (setq timeclock-last-period - (- (timeclock-time-to-seconds (cadr event)) beg) + (- (float-time (cadr event)) beg) accum (+ timeclock-last-period accum) beg nil)) (if (equal last-date todays-date) @@ -1225,8 +1223,8 @@ HTML-P is non-nil, HTML markup is added." (insert project "</b><br>\n") (insert project "*\n")) (let ((proj-data (cdr (assoc project (timeclock-project-alist log)))) - (two-weeks-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) + (two-weeks-ago (seconds-to-time + (- (float-time today) (* 2 7 24 60 60)))) two-week-len today-len) (while proj-data @@ -1278,17 +1276,17 @@ HTML-P is non-nil, HTML markup is added." <th>-1 year</th> </tr>") (let* ((day-list (timeclock-day-list)) - (thirty-days-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) + (thirty-days-ago (seconds-to-time + (- (float-time today) (* 30 24 60 60)))) - (three-months-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) + (three-months-ago (seconds-to-time + (- (float-time today) (* 90 24 60 60)))) - (six-months-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) + (six-months-ago (seconds-to-time + (- (float-time today) (* 180 24 60 60)))) - (one-year-ago (timeclock-seconds-to-time - (- (timeclock-time-to-seconds today) + (one-year-ago (seconds-to-time + (- (float-time today) (* 365 24 60 60)))) (time-in (vector (list t) (list t) (list t) (list t) (list t))) (time-out (vector (list t) (list t) (list t) (list t) (list t))) @@ -1303,12 +1301,11 @@ HTML-P is non-nil, HTML markup is added." (unless (time-less-p (timeclock-day-begin day) (aref lengths i)) - (let ((base (timeclock-time-to-seconds + (let ((base (float-time (timeclock-day-base (timeclock-day-begin day))))) (nconc (aref time-in i) - (list (- (timeclock-time-to-seconds - (timeclock-day-begin day)) + (list (- (float-time (timeclock-day-begin day)) base))) (let ((span (timeclock-day-span day)) (len (timeclock-day-length day)) @@ -1320,8 +1317,7 @@ HTML-P is non-nil, HTML markup is added." (when (and (> span 0) (> (/ (float len) (float span)) 0.70)) (nconc (aref time-out i) - (list (- (timeclock-time-to-seconds - (timeclock-day-end day)) + (list (- (float-time (timeclock-day-end day)) base))) (nconc (aref breaks i) (list (- span len)))) (if req diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 94cd08eaa4e..aee101f7218 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -612,11 +612,12 @@ Otherwise, `todo-show' always visits `todo-default-todo-file'." (defun todo-show (&optional solicit-file interactive) "Visit a todo file and display one of its categories. -When invoked in Todo mode, prompt for which todo file to visit. -When invoked outside of Todo mode with non-nil prefix argument -SOLICIT-FILE prompt for which todo file to visit; otherwise visit -`todo-default-todo-file'. Subsequent invocations from outside -of Todo mode revisit this file or, with option +When invoked in Todo mode, Todo Archive mode or Todo Filtered +Items mode, or when invoked anywhere else with a prefix argument, +prompt for which todo file to visit. When invoked outside of a +Todo mode buffer without a prefix argument, visit +`todo-default-todo-file'. Subsequent invocations from outside of +Todo mode revisit this file or, with option `todo-show-current-file' non-nil (the default), whichever todo file was last visited. @@ -643,10 +644,7 @@ In Todo mode just the category's unfinished todo items are shown by default. The done items are hidden, but typing `\\[todo-toggle-view-done-items]' displays them below the todo items. With non-nil user option `todo-show-with-done' both todo -and done items are always shown on visiting a category. - -Invoking this command in Todo Archive mode visits the -corresponding todo file, displaying the corresponding category." +and done items are always shown on visiting a category." (interactive "P\np") (when todo-default-todo-file (todo-check-file (todo-absolute-file-name todo-default-todo-file))) @@ -904,17 +902,19 @@ Categories mode." (todo-show) (let* ((archive (eq where 'archive)) (cat (unless archive where)) + (goto-archive (and cat + todo-skip-archived-categories + (zerop (todo-get-count 'todo cat)) + (zerop (todo-get-count 'done cat)) + (not (zerop (todo-get-count 'archived cat))))) (file0 (when cat ; We're in Todo Categories mode. - ;; With non-nil `todo-skip-archived-categories' - ;; jump to archive file of a category with only - ;; archived items. - (if (and todo-skip-archived-categories - (zerop (todo-get-count 'todo cat)) - (zerop (todo-get-count 'done cat)) - (not (zerop (todo-get-count 'archived cat)))) + (if goto-archive + ;; If the category has only archived items and + ;; `todo-skip-archived-categories' is non-nil, jump to + ;; the archive category. (concat (file-name-sans-extension todo-current-todo-file) ".toda") - ;; Otherwise, jump to current todo file. + ;; Otherwise, jump to the category in the todo file. todo-current-todo-file))) (len (length todo-categories)) (cat+file (unless cat @@ -925,18 +925,15 @@ Categories mode." (category (or cat (car cat+file)))) (unless cat (setq file0 (cdr cat+file))) (with-current-buffer (find-file-noselect file0 'nowarn) - (setq todo-current-todo-file file0) - ;; If called from Todo Categories mode, clean up before jumping. - (if (string= (buffer-name) todo-categories-buffer) - (kill-buffer)) - (set-window-buffer (selected-window) - (set-buffer (find-buffer-visiting file0))) - (unless todo-global-current-todo-file - (setq todo-global-current-todo-file todo-current-todo-file)) - (todo-category-number category) - (todo-category-select) - (goto-char (point-min)) - (when add-item (todo-insert-item--basic)))))) + (when goto-archive (todo-archive-mode)) + (set-window-buffer (selected-window) + (set-buffer (find-buffer-visiting file0))) + (unless todo-global-current-todo-file + (setq todo-global-current-todo-file todo-current-todo-file)) + (todo-category-number category) + (todo-category-select) + (goto-char (point-min)) + (when add-item (todo-insert-item--basic)))))) (defun todo-next-item (&optional count) "Move point down to the beginning of the next item. @@ -1414,7 +1411,12 @@ the archive of the file moved to, creating it if it does not exist." (setq todo-files (funcall todo-files-function)) (todo-reevaluate-filelist-defcustoms)) (dolist (buf buffers) + ;; Make sure archive file is in Todo Archive mode so that + ;; todo-categories has correct value. (with-current-buffer (find-file-noselect buf) + (when (equal (file-name-extension (buffer-file-name)) "toda") + (unless (derived-mode-p 'todo-archive-mode) + (todo-archive-mode))) (widen) (goto-char (point-max)) (let* ((beg (re-search-backward @@ -1466,10 +1468,18 @@ the archive of the file moved to, creating it if it does not exist." (re-search-backward (concat "^" (regexp-quote todo-category-beg) "\\(" (regexp-quote cat) "\\)$") nil t) - (replace-match new nil nil nil 1))) - (setq todo-categories - (append todo-categories (list (cons (or new cat) counts)))) - (todo-update-categories-sexp) + (replace-match new nil nil nil 1)) + (setq todo-categories + (append todo-categories (list (cons (or new cat) counts)))) + (goto-char (point-min)) + (if (looking-at "((\"") + ;; Delete existing sexp. + (delete-region (line-beginning-position) (line-end-position)) + ;; Otherwise, file is new, so make space for categories sexp. + (insert "\n") + (goto-char (point-min))) + ;; Insert (new or updated) sexp. + (prin1 todo-categories (current-buffer))) ;; If archive was just created, save it to avoid "File ;; <xyz> no longer exists!" message on invoking ;; `todo-view-archived-items'. @@ -1500,9 +1510,7 @@ the archive of the file moved to, creating it if it does not exist." (setq todo-category-number 1)) (todo-category-select))))) (set-window-buffer (selected-window) - (set-buffer (find-file-noselect nfile))) - (todo-category-number (or new cat)) - (todo-category-select)))) + (set-buffer (find-file-noselect nfile)))))) (defun todo-merge-category (&optional file) "Merge current category into another existing category. @@ -5742,8 +5750,11 @@ With non-nil argument FILE prompt for a file and complete only against categories in that file; otherwise complete against all categories from `todo-category-completions-files'." ;; Allow SPC to insert spaces, for adding new category names. - (let ((map minibuffer-local-completion-map)) - (define-key map " " nil) + (let ((minibuffer-local-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-completion-map) + (define-key map " " nil) + map))) (let* ((add (eq match-type 'add)) (archive (eq match-type 'archive)) (file0 (when (and file (> (length todo-files) 1)) diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index 9a54d341f56..373149c16e3 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -52,7 +52,7 @@ SCOPE is the scope of the search, such as 'project or 'subdirs." ;; -0 = Find C symbol ;; -1 = Find global definition ;; -3 = Find references - ;; -6 = Find egrep pattern + ;; -6 = Find grep -E pattern ;; -7 = Find file (let ((idx (cond ((eq type 'file) "-7") diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index 010bfde54dc..d7ea35a43f7 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -64,12 +64,12 @@ (defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s") - "*Default command used to compile a target." + "Default command used to compile a target." :group 'project-linux :type 'string) (defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s") - "*Default command used to compile a project." + "Default command used to compile a project." :group 'project-linux :type 'string) diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index 38d23883951..8564719c810 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -124,12 +124,12 @@ based on `ede-locate-setup-options'." t) (cl-defmethod ede-locate-flush-hash ((loc ede-locate-base)) - "For LOC, flush hashtable and start from scratch." + "For LOC, flush hash table and start from scratch." (oset loc hash (make-hash-table :test 'equal))) (cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base) filestring) - "For LOC, is the file FILESTRING in our hashtable?" + "For LOC, is the file FILESTRING in our hash table?" (gethash filestring (oref loc hash))) (cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 715f3cf46d5..72c0bc60107 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -53,17 +53,17 @@ ) (defcustom project-am-compile-project-command nil - "*Default command used to compile a project." + "Default command used to compile a project." :group 'project-am :type '(choice (const nil) string)) (defcustom project-am-compile-target-command (concat ede-make-command " -k %s") - "*Default command used to compile a project." + "Default command used to compile a project." :group 'project-am :type 'string) (defcustom project-am-debug-target-function 'gdb - "*Default Emacs command used to debug a target." + "Default Emacs command used to debug a target." :group 'project-am :type 'function) ; make this be a list some day diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el index 380c8dbc586..74b6e056a2a 100644 --- a/lisp/cedet/ede/simple.el +++ b/lisp/cedet/ede/simple.el @@ -55,12 +55,12 @@ t) (defcustom ede-simple-save-directory "~/.ede" - "*Directory where simple EDE project overlays are saved." + "Directory where simple EDE project overlays are saved." :group 'ede :type 'directory) (defcustom ede-simple-save-file-name "ProjSimple.ede" - "*File name used for simple project wrappers." + "File name used for simple project wrappers." :group 'ede :type 'string) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index c7e6615e0df..4f424313ab7 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -638,7 +638,7 @@ SYMBOL is a function that can be overridden." (defun describe-mode-local-overload (symbol) "For `help-fns-describe-function-functions'; add overloads for SYMBOL." - (when (get symbol 'mode-local-overload) + (when (function-overload-p symbol) (let ((default (or (intern-soft (format "%s-default" (symbol-name symbol))) symbol)) (override (with-current-buffer describe-function-orig-buffer @@ -684,7 +684,7 @@ SYMBOL is a function that can be overridden." (defun xref-mode-local-overload (symbol) "For `elisp-xref-find-def-functions'; add overloads for SYMBOL." ;; Current buffer is the buffer where xref-find-definitions was invoked. - (when (get symbol 'mode-local-overload) + (when (function-overload-p symbol) (let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol))) (default (intern-soft (format "%s-default" (symbol-name symbol)))) (default-file (when default (find-lisp-object-file-name default (symbol-function default)))) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 821f05a5732..904410f6cf3 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -296,7 +296,7 @@ Return the defined symbol as a special spp lex token." ;;; Conditional Skipping ;; (defcustom semantic-c-obey-conditional-section-parsing-flag t - "*Non-nil means to interpret preprocessor #if sections. + "Non-nil means to interpret preprocessor #if sections. This implies that some blocks of code will not be parsed based on the values of the conditions in the #if blocks." :group 'c diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 7824942d96f..93796bd96d3 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -149,8 +149,10 @@ compound strings." (nth 1 form)) (t nil))) -(defvar semantic-elisp-store-documentation-in-tag nil - "*When non-nil, store documentation strings in the created tags.") +(defcustom semantic-elisp-store-documentation-in-tag nil + "When non-nil, store documentation strings in the created tags." + :type 'boolean + :group 'semantic) (defun semantic-elisp-do-doc (str) "Return STR as a documentation string IF they are enabled." @@ -700,7 +702,7 @@ of `let' or `let*', grab those variable names." ;; Snart args... (up-list -1) (forward-char 1) - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward "* \t\n") (let ((arglst (read (buffer-substring-no-properties (point) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index ec292395f12..b56b268ca0d 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -225,7 +225,7 @@ It should also include other symbols GCC was compiled with.") (setq semantic-lex-c-preprocessor-symbol-map nil)) (dolist (D defines) (add-to-list 'semantic-lex-c-preprocessor-symbol-map D)) - ;; Needed for parsing OS X libc + ;; Needed for parsing macOS libc (when (eq system-type 'darwin) (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . ""))) (when (featurep 'semantic/bovine/c) diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index de762326c3e..14b5f3f016c 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -568,7 +568,7 @@ if INLINE, then completion is happening inline in a buffer." (:underline "yellow")) (((class color) (background light)) (:underline "brown"))) - "*Face used to show the region being completed inline. + "Face used to show the region being completed inline. The face is used in `semantic-complete-inline-tag-engine'." :group 'semantic-faces) @@ -1370,7 +1370,7 @@ This object type doesn't do focus, so will never have a focus object." ;; Traditional displayor (defcustom semantic-completion-displayor-format-tag-function #'semantic-format-tag-name - "*A Tag format function to use when showing completions." + "A Tag format function to use when showing completions." :group 'semantic :type semantic-format-tag-custom-list) @@ -1871,7 +1871,7 @@ Use this to enable custom editing.") (defcustom semantic-complete-inline-analyzer-displayor-class 'semantic-displayor-traditional - "*Class for displayor to use with inline completion." + "Class for displayor to use with inline completion." :group 'semantic :type semantic-complete-inline-custom-type ) @@ -2075,7 +2075,7 @@ completion works." (defcustom semantic-complete-inline-analyzer-idle-displayor-class 'semantic-displayor-ghost - "*Class for displayor to use with inline completion at idle time." + "Class for displayor to use with inline completion at idle time." :group 'semantic :type semantic-complete-inline-custom-type ) diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 83a268073b3..413996a5e8f 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -44,19 +44,19 @@ ) "A table for returning search results from Emacs.") -(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force) +(cl-defmethod semanticdb-refresh-table ((_obj semanticdb-table-emacs-lisp) &optional _force) "Do not refresh Emacs Lisp table. It does not need refreshing." nil) -(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp)) +(cl-defmethod semanticdb-needs-refresh-p ((_obj semanticdb-table-emacs-lisp)) "Return nil, we never need a refresh." nil) (cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings) "Pretty printer extension for `semanticdb-table-emacs-lisp'. Adds the number of tags in this file to the object print name." - (apply 'call-next-method obj (cons " (proxy)" strings))) + (apply #'cl-call-next-method obj (cons " (proxy)" strings))) (defclass semanticdb-project-database-emacs-lisp (semanticdb-project-database eieio-singleton) @@ -71,15 +71,15 @@ Adds the number of tags in this file to the object print name." "Pretty printer extension for `semanticdb-table-emacs-lisp'. Adds the number of tags in this file to the object print name." (let ((count 0)) - (mapatoms (lambda (sym) (setq count (1+ count)))) - (apply 'call-next-method obj (cons - (format " (%d known syms)" count) - strings)))) + (mapatoms (lambda (_sym) (setq count (1+ count)))) + (apply #'cl-call-next-method obj (cons + (format " (%d known syms)" count) + strings)))) ;; Create the database, and add it to searchable databases for Emacs Lisp mode. (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases (list - (semanticdb-project-database-emacs-lisp "Emacs")) + (make-instance 'semanticdb-project-database-emacs-lisp)) "Search Emacs core for symbols.") (defvar-mode-local emacs-lisp-mode semanticdb-find-default-throttle @@ -96,32 +96,32 @@ Create one of our special tables that can act as an intermediary." ;; We need to return something since there is always the "master table" ;; The table can then answer file name type questions. (when (not (slot-boundp obj 'tables)) - (let ((newtable (semanticdb-table-emacs-lisp "Emacs System Table"))) + (let ((newtable (make-instance 'semanticdb-table-emacs-lisp))) (oset obj tables (list newtable)) (oset newtable parent-db obj) (oset newtable tags nil) )) (cl-call-next-method)) -(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename) +(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) _filename) "From OBJ, return FILENAME's associated table object. For Emacs Lisp, creates a specialized table." (car (semanticdb-get-database-tables obj)) ) -(cl-defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp )) +(cl-defmethod semanticdb-get-tags ((_table semanticdb-table-emacs-lisp )) "Return the list of tags belonging to TABLE." ;; specialty table ? Probably derive tags at request time. nil) -(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer) +(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-emacs-lisp) &optional buffer) "Return non-nil if TABLE's mode is equivalent to BUFFER. Equivalent modes are specified by the `semantic-equivalent-major-modes' local variable." (with-current-buffer buffer (eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode))) -(cl-defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp)) +(cl-defmethod semanticdb-full-filename ((_obj semanticdb-table-emacs-lisp)) "Fetch the full filename that OBJ refers to. For Emacs Lisp system DB, there isn't one." nil) @@ -151,7 +151,7 @@ If Emacs cannot resolve this symbol to a particular file, then return nil." 'defvar) )) (sym (intern (semantic-tag-name tag))) - (file (condition-case err + (file (condition-case nil (symbol-file sym type) ;; Older [X]Emacs don't have a 2nd argument. (error (symbol-file sym)))) @@ -169,7 +169,6 @@ If Emacs cannot resolve this symbol to a particular file, then return nil." (setq file (concat file ".gz")))) (let* ((tab (semanticdb-file-table-object file)) - (alltags (when tab (semanticdb-get-tags tab))) (newtags (when tab (semanticdb-find-tags-by-name-method tab (semantic-tag-name tag)))) (match nil)) @@ -248,7 +247,7 @@ TOKTYPE is a hint to the type of tag desired." "Variable used to collect `mapatoms' output.") (cl-defmethod semanticdb-find-tags-by-name-method - ((table semanticdb-table-emacs-lisp) name &optional tags) + ((_table semanticdb-table-emacs-lisp) name &optional tags) "Find all tags named NAME in TABLE. Uses `intern-soft' to match NAME to Emacs symbols. Return a list of tags." @@ -269,26 +268,26 @@ Return a list of tags." )))) (cl-defmethod semanticdb-find-tags-by-name-regexp-method - ((table semanticdb-table-emacs-lisp) regex &optional tags) + ((_table semanticdb-table-emacs-lisp) regex &optional tags) "Find all tags with name matching REGEX in TABLE. Optional argument TAGS is a list of tags to search. Uses `apropos-internal' to find matches. Return a list of tags." (if tags (cl-call-next-method) - (delq nil (mapcar 'semanticdb-elisp-sym->tag + (delq nil (mapcar #'semanticdb-elisp-sym->tag (apropos-internal regex))))) (cl-defmethod semanticdb-find-tags-for-completion-method - ((table semanticdb-table-emacs-lisp) prefix &optional tags) + ((_table semanticdb-table-emacs-lisp) prefix &optional tags) "In TABLE, find all occurrences of tags matching PREFIX. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." (if tags (cl-call-next-method) - (delq nil (mapcar 'semanticdb-elisp-sym->tag + (delq nil (mapcar #'semanticdb-elisp-sym->tag (all-completions prefix obarray))))) (cl-defmethod semanticdb-find-tags-by-class-method - ((table semanticdb-table-emacs-lisp) class &optional tags) + ((_table semanticdb-table-emacs-lisp) _class &optional tags) "In TABLE, find all occurrences of tags of CLASS. Optional argument TAGS is a list of tags to search. Returns a table of all matching tags." @@ -323,7 +322,7 @@ Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp." ;;; Advanced Searches ;; (cl-defmethod semanticdb-find-tags-external-children-of-type-method - ((table semanticdb-table-emacs-lisp) type &optional tags) + ((_table semanticdb-table-emacs-lisp) type &optional tags) "Find all nonterminals which are child elements of TYPE Optional argument TAGS is a list of tags to search. Return a list of tags." @@ -333,10 +332,10 @@ Return a list of tags." (let* ((class (intern-soft type)) (taglst (when class (delq nil - (mapcar 'semanticdb-elisp-sym->tag + (mapcar #'semanticdb-elisp-sym->tag ;; Fancy eieio function that knows all about ;; built in methods belonging to CLASS. - (eieio-all-generic-functions class))))) + (cl-generic-all-functions class))))) ) taglst)))) diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index d6635a9dcef..cd951804db7 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -902,7 +902,7 @@ instead." This makes it appear more like the results of a `semantic-find-' call. This is like `semanticdb-strip-find-results', except the input list RESULTS will be changed." - (apply #'nconc (mapcar #'cdr results))) + (mapcan #'cdr results)) (defun semanticdb-find-results-p (resultp) "Non-nil if RESULTP is in the form of a semanticdb search result. diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 366af60034c..76382a30dd1 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -56,7 +56,7 @@ (stream :initform nil :documentation "The searchable tag stream for this cache. -NOTE: Can I get rid of this? Use a hashtable instead?") +NOTE: Can I get rid of this? Use a hash table instead?") (dependants :initform nil :documentation "Any other object that is dependent on typecache results. diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index a72e78402ea..1b3f07aa0f6 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -814,7 +814,7 @@ local variable." ;; associated databases. (defcustom semanticdb-project-roots nil - "*List of directories, where each directory is the root of some project. + "List of directories, where each directory is the root of some project. All subdirectories of a root project are considered a part of one project. Values in this string can be overridden by project management programs via the `semanticdb-project-root-functions' variable." diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index e12fff1a2a8..3ea2a48a9fa 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -49,7 +49,7 @@ ;; (defface semantic-decoration-on-includes nil - "*Overlay Face used on includes that are not in some other state. + "Overlay Face used on includes that are not in some other state. Used by the decoration style: `semantic-decoration-on-includes'." :group 'semantic-faces) @@ -119,7 +119,7 @@ Used by the decoration style: `semantic-decoration-on-includes'." (:background "#900000")) (((class color) (background light)) (:background "#fff0f0"))) - "*Face used to show includes that cannot be found. + "Face used to show includes that cannot be found. Used by the decoration style: `semantic-decoration-on-unknown-includes'." :group 'semantic-faces) @@ -182,7 +182,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'." (:background "#009000")) (((class color) (background light)) (:background "#f0fdf0"))) - "*Face used to show includes that have no file, but do have a DB table. + "Face used to show includes that have no file, but do have a DB table. Used by the decoration style: `semantic-decoration-on-fileless-includes'." :group 'semantic-faces) @@ -245,7 +245,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'." (:background "#555500")) (((class color) (background light)) (:background "#ffff55"))) - "*Face used to show includes that have not yet been parsed. + "Face used to show includes that have not yet been parsed. Used by the decoration style: `semantic-decoration-on-unparsed-includes'." :group 'semantic-faces) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index fca9c3c4650..d4385e165c8 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -455,7 +455,7 @@ Does not provide overlines for prototypes.") (:overline "cyan")) (((class color) (background light)) (:overline "blue"))) - "*Face used to show long tags in. + "Face used to show long tags in. Used by decoration style: `semantic-tag-boundary'." :group 'semantic-faces) @@ -504,7 +504,7 @@ Used by decoration style: `semantic-tag-boundary'." (:background "#200000")) (((class color) (background light)) (:background "#8fffff"))) - "*Face used to show privately scoped tags in. + "Face used to show privately scoped tags in. Used by the decoration style: `semantic-decoration-on-private-members'." :group 'semantic-faces) @@ -526,7 +526,7 @@ Use a primary decoration." (:background "#000020")) (((class color) (background light)) (:background "#fffff8"))) - "*Face used to show protected scoped tags in. + "Face used to show protected scoped tags in. Used by the decoration style: `semantic-decoration-on-protected-members'." :group 'semantic-faces) diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index 1fe703fd09a..b83cce56428 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -559,14 +559,14 @@ Optional argument COLOR means highlight the prototype with font-lock colors." ;;; UML display styles ;; (defcustom semantic-uml-colon-string " : " - "*String used as a color separator between parts of a UML string. + "String used as a color separator between parts of a UML string. In UML, a variable may appear as `varname : type'. Change this variable to change the output separator." :group 'semantic :type 'string) (defcustom semantic-uml-no-protection-string "" - "*String used to describe when no protection is specified. + "String used to describe when no protection is specified. Used by `semantic-format-tag-uml-protection-to-string'." :group 'semantic :type 'string) @@ -603,7 +603,7 @@ UML attribute strings are things like {abstract} or {leaf}." (private . "-") ) "Association list of the form (SYMBOL . \"STRING\") for protection symbols. -This associates a symbol, such as 'public with the st ring \"+\".") +For example, it might associate the symbol `public' with the string \"+\".") (define-overloadable-function semantic-format-tag-uml-protection-to-string (protection-symbol color) "Convert PROTECTION-SYMBOL to a string for UML. diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 214fbb50f98..a4dabe66083 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -146,7 +146,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'." (defcustom semantic-ia-completion-menu-format-tag-function 'semantic-format-tag-uml-concise-prototype - "*Function used to convert a tag to a string during completion." + "Function used to convert a tag to a string during completion." :group 'semantic :type semantic-format-tag-custom-list) diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 549a30ac0bc..5f902622ac6 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -141,7 +141,7 @@ Use the command `semantic-idle-scheduler-mode' to change this variable.") (make-variable-buffer-local 'semantic-idle-scheduler-mode) (defcustom semantic-idle-scheduler-max-buffer-size 0 - "*Maximum size in bytes of buffers where idle-scheduler is enabled. + "Maximum size in bytes of buffers where idle-scheduler is enabled. If this value is less than or equal to 0, idle-scheduler is enabled in all buffers regardless of their size." :group 'semantic @@ -303,13 +303,13 @@ call additional functions registered with the timer calls." ;; Unlike the shorter timer, the WORK timer will kick of tasks that ;; may take a long time to complete. (defcustom semantic-idle-work-parse-neighboring-files-flag nil - "*Non-nil means to parse files in the same dir as the current buffer. + "Non-nil means to parse files in the same dir as the current buffer. Disable to prevent lots of excessive parsing in idle time." :group 'semantic :type 'boolean) (defcustom semantic-idle-work-update-headers-flag nil - "*Non-nil means to parse through header files in idle time. + "Non-nil means to parse through header files in idle time. Disable to prevent idle time parsing of many files. If completion is called that work will be done then instead." :group 'semantic diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 4983d6c9f44..cfff253a793 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -57,7 +57,7 @@ ;;;###autoload (defcustom semantic-imenu-summary-function 'semantic-format-tag-abbreviate - "*Function to use when creating items in Imenu. + "Function to use when creating items in Imenu. Some useful functions are found in `semantic-format-tag-functions'." :group 'semantic-imenu :type semantic-format-tag-custom-list) @@ -65,20 +65,20 @@ Some useful functions are found in `semantic-format-tag-functions'." ;;;###autoload (defcustom semantic-imenu-bucketize-file t - "*Non-nil if tags in a file are to be grouped into buckets." + "Non-nil if tags in a file are to be grouped into buckets." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-bucketize-file) (defcustom semantic-imenu-adopt-external-members t - "*Non-nil if types in a file should adopt externally defined members. + "Non-nil if types in a file should adopt externally defined members. C++ and CLOS can define methods that are not in the body of a class definition." :group 'semantic-imenu :type 'boolean) (defcustom semantic-imenu-buckets-to-submenu t - "*Non-nil if buckets of tags are to be turned into submenus. + "Non-nil if buckets of tags are to be turned into submenus. This option is ignored if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) @@ -86,7 +86,7 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil." ;;;###autoload (defcustom semantic-imenu-expand-type-members t - "*Non-nil if types should have submenus with members in them." + "Non-nil if types should have submenus with members in them." :group 'semantic-imenu :type 'boolean) (make-variable-buffer-local 'semantic-imenu-expand-type-members) @@ -94,7 +94,7 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil." 'semantic-imenu-expand-type-members "23.2") (defcustom semantic-imenu-bucketize-type-members t - "*Non-nil if members of a type should be grouped into buckets. + "Non-nil if members of a type should be grouped into buckets. A nil value means to keep them in the same order. Overridden to nil if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu @@ -104,7 +104,7 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil." 'semantic-imenu-bucketize-type-members "23.2") (defcustom semantic-imenu-sort-bucket-function nil - "*Function to use when sorting tags in the buckets of functions. + "Function to use when sorting tags in the buckets of functions. See `semantic-bucketize' and the FILTER argument for more details on this function." :group 'semantic-imenu :type '(radio (const :tag "No Sorting" nil) @@ -120,7 +120,7 @@ See `semantic-bucketize' and the FILTER argument for more details on this functi (make-variable-buffer-local 'semantic-imenu-sort-bucket-function) (defcustom semantic-imenu-index-directory nil - "*Non nil to index the entire directory for tags. + "Non nil to index the entire directory for tags. Doesn't actually parse the entire directory, but displays tags for all files currently listed in the current Semantic database. This variable has no meaning if semanticdb is not active." @@ -128,7 +128,7 @@ This variable has no meaning if semanticdb is not active." :type 'boolean) (defcustom semantic-imenu-auto-rebuild-directory-indexes nil - "*If non-nil automatically rebuild directory index imenus. + "If non-nil automatically rebuild directory index imenus. That is when a directory index imenu is updated, automatically rebuild other buffer local ones based on the same semanticdb." :group 'semantic-imenu @@ -498,7 +498,7 @@ Clears all imenu menus that may be depending on the database." "Function to convert semantic tags into `which-function' text.") (defcustom semantic-which-function-use-color nil - "*Use color when displaying the current function with `which-function'." + "Use color when displaying the current function with `which-function'." :group 'semantic-imenu :type 'boolean) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index b48f5aedd68..b960e7a4d99 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1239,7 +1239,7 @@ of type `spp-macro-undef' is to be created." ;; written yet. ;; (defcustom semantic-lex-spp-use-headers-flag nil - "*Non-nil means to pre-parse headers as we go. + "Non-nil means to pre-parse headers as we go. For languages that use the Semantic pre-processor, this can improve the accuracy of parsed files where include files can change the state of what's parsed in the current file. @@ -1306,8 +1306,10 @@ where a valid symbol is 'system, or nil." ;; ;; These routines are for saving macro lists into an EIEIO persistent ;; file. -(defvar semantic-lex-spp-macro-max-length-to-save 200 - "*Maximum length of an SPP macro before we opt to not save it.") +(defcustom semantic-lex-spp-macro-max-length-to-save 200 + "Maximum length of an SPP macro before we opt to not save it." + :type 'integer + :group 'semantic) ;;;###autoload (defun semantic-lex-spp-table-write-slot-value (value) diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index c827fabb343..f8372e68781 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -739,8 +739,10 @@ a LOCAL option.") ;; Stack of nested blocks. (defvar semantic-lex-block-stack nil) -;;(defvar semantic-lex-timeout 5 -;; "*Number of sections of lexing before giving up.") +;;(defcustom semantic-lex-timeout 5 +;; "Number of sections of lexing before giving up." +;; :type 'integer +;; :group 'semantic) (defsubst semantic-lex-debug-break (token) "Break during lexical analysis at TOKEN." diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index 4146b4e5b2c..1e15773952d 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -263,7 +263,7 @@ If ARG is positive or nil, enable, if it is negative, disable." 'semantic-mru-bookmark-mode (if global-semantic-mru-bookmark-mode 1 -1))) (defcustom semantic-mru-bookmark-mode-hook nil - "*Hook run at the end of function `semantic-mru-bookmark-mode'." + "Hook run at the end of function `semantic-mru-bookmark-mode'." :group 'semantic :type 'hook) diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index 7eac255fe37..a06955067d9 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -38,7 +38,7 @@ (declare-function semanticdb-file-stream "semantic/db") (defcustom semantic-sb-autoexpand-length 1 - "*Length of a semantic bucket to autoexpand in place. + "Length of a semantic bucket to autoexpand in place. This will replace the named bucket that would have usually occurred here." :group 'speedbar :type 'integer) @@ -49,12 +49,12 @@ Make this buffer local for modes that have different types of tags that should be ignored.") (defcustom semantic-sb-button-format-tag-function 'semantic-format-tag-abbreviate - "*Function called to create the text for a but from a token." + "Function called to create the text for a but from a token." :group 'speedbar :type semantic-format-tag-custom-list) (defcustom semantic-sb-info-format-tag-function 'semantic-format-tag-summarize - "*Function called to create the text for info display from a token." + "Function called to create the text for info display from a token." :group 'speedbar :type semantic-format-tag-custom-list) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index 088740b2624..854b72fcfdd 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -65,6 +65,8 @@ ;; Your tool should then create an instance of `semantic-symref-result'. (require 'semantic) +(eval-when-compile (require 'semantic/find)) ;For semantic-find-tags-* +(eval-when-compile (require 'ede/proj)) ;For `metasubproject' warning. (defvar ede-minor-mode) (declare-function data-debug-new-buffer "data-debug") @@ -74,10 +76,12 @@ (declare-function ede-up-directory "ede/files") ;;; Code: -(defvar semantic-symref-tool 'detect - "*The active symbol reference tool name. +(defcustom semantic-symref-tool 'detect + "The active symbol reference tool name. The tool symbol can be 'detect, or a symbol that is the name of -a tool that can be used for symbol referencing.") +a tool that can be used for symbol referencing." + :type 'symbol + :group 'semantic) (make-variable-buffer-local 'semantic-symref-tool) ;;; TOOL SETUP @@ -109,7 +113,7 @@ Start with an EDE project, or use the default directory." default-directory))) (if (and rootproj (condition-case nil ;; Hack for subprojects. - (oref rootproj :metasubproject) + (oref rootproj metasubproject) (error nil))) (ede-up-directory rootdirbase) rootdirbase))) @@ -266,12 +270,12 @@ Returns an object of class `semantic-symref-result'." ;;;###autoload (defun semantic-symref-find-text (text &optional scope) "Find a list of occurrences of TEXT in the current project. -TEXT is a regexp formatted for use with egrep. +TEXT is a regexp formatted for use with grep -E. Optional SCOPE specifies which file set to search. Defaults to `project'. Refers to `semantic-symref-tool', to determine the reference tool to use for the current buffer. Returns an object of class `semantic-symref-result'." - (interactive "sEgrep style Regexp: ") + (interactive "sGrep -E style Regexp: ") (let* ((inst (semantic-symref-instantiate :searchfor text :searchtype 'regexp @@ -284,6 +288,80 @@ Returns an object of class `semantic-symref-result'." (semantic-symref-data-debug-last-result)))) ) +;;; SYMREF TOOLS +;; +;; The base symref tool provides something to hang new tools off of +;; for finding symbol references. +(defclass semantic-symref-tool-baseclass () + ((searchfor :initarg :searchfor + :type string + :documentation "The thing to search for.") + (searchtype :initarg :searchtype + :type symbol + :documentation "The type of search to do. +Values could be 'symbol, 'regexp, 'tagname, or 'completion.") + (searchscope :initarg :searchscope + :type symbol + :documentation + "The scope to search for. +Can be 'project, 'target, or 'file.") + (resulttype :initarg :resulttype + :type symbol + :documentation + "The kind of search results desired. +Can be 'line, 'file, or 'tag. +The type of result can be converted from 'line to 'file, or 'line to 'tag, +but not from 'file to 'line or 'tag.") + ) + "Baseclass for all symbol references tools. +A symbol reference tool supplies functionality to identify the locations of +where different symbols are used. + +Subclasses should be named `semantic-symref-tool-NAME', where +NAME is the name of the tool used in the configuration variable +`semantic-symref-tool'" + :abstract t) + +(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass)) + "Calculate the results of a search based on TOOL. +The symref TOOL should already contain the search criteria." + (let ((answer (semantic-symref-perform-search tool)) + ) + (when answer + (let ((answersym (if (eq (oref tool resulttype) 'file) + :hit-files + (if (stringp (car answer)) + :hit-text + :hit-lines)))) + (semantic-symref-result (oref tool searchfor) + answersym + answer + :created-by tool)) + ) + )) + +(cl-defmethod semantic-symref-perform-search ((_tool semantic-symref-tool-baseclass)) + "Base search for symref tools should throw an error." + (error "Symref tool objects must implement `semantic-symref-perform-search'")) + +(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass) + outputbuffer) + "Parse the entire OUTPUTBUFFER of a symref tool. +Calls the method `semantic-symref-parse-tool-output-one-line' over and +over until it returns nil." + (with-current-buffer outputbuffer + (goto-char (point-min)) + (let ((result nil) + (hit nil)) + (while (setq hit (semantic-symref-parse-tool-output-one-line tool)) + (setq result (cons hit result))) + (nreverse result))) + ) + +(cl-defmethod semantic-symref-parse-tool-output-one-line ((_tool semantic-symref-tool-baseclass)) + "Base tool output parser is not implemented." + (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'")) + ;;; RESULTS ;; ;; The results class and methods provide features for accessing hits. @@ -316,9 +394,9 @@ Use the `semantic-symref-hit-tags' method to get this list.") (cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result)) "Get the list of files from the symref result RESULT." - (if (slot-boundp result :hit-files) + (if (slot-boundp result 'hit-files) (oref result hit-files) - (let* ((lines (oref result :hit-lines)) + (let* ((lines (oref result hit-lines)) (files (mapcar (lambda (a) (cdr a)) lines)) (ans nil)) (setq ans (list (car files)) @@ -359,12 +437,12 @@ Optional OPEN-BUFFERS indicates that the buffers that the hits are in should remain open after scanning. Note: This can be quite slow if most of the hits are not in buffers already." - (if (and (slot-boundp result :hit-tags) (oref result hit-tags)) + (if (and (slot-boundp result 'hit-tags) (oref result hit-tags)) (oref result hit-tags) ;; Calculate the tags. - (let ((lines (oref result :hit-lines)) - (txt (oref (oref result :created-by) :searchfor)) - (searchtype (oref (oref result :created-by) :searchtype)) + (let ((lines (oref result hit-lines)) + (txt (oref (oref result created-by) searchfor)) + (searchtype (oref (oref result created-by) searchtype)) (ans nil) (out nil)) (save-excursion @@ -390,7 +468,7 @@ already." (semantic--tag-put-property (car out) :hit lines))) )) ;; Out is reversed... twice - (oset result :hit-tags (nreverse out))))) + (oset result hit-tags (nreverse out))))) (defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype) "Convert the symref HIT into a TAG by looking up the tag via a database. @@ -403,20 +481,18 @@ If there is no database, of if the searchtype is wrong, return nil." ;; tagname, tagregexp, tagcompletions (if (not (memq searchtype '(tagname tagregexp tagcompletions))) nil - (let* ((line (car hit)) - (file (cdr hit)) + (let* ((file (cdr hit)) ;; FAIL here vv - don't load is not obeyed if no table found. (db (semanticdb-file-table-object file t)) - (found nil) + (found + (cond ((eq searchtype 'tagname) + (semantic-find-tags-by-name searchtxt db)) + ((eq searchtype 'tagregexp) + (semantic-find-tags-by-name-regexp searchtxt db)) + ((eq searchtype 'tagcompletions) + (semantic-find-tags-for-completion searchtxt db)))) (hit nil) ) - (cond ((eq searchtype 'tagname) - (setq found (semantic-find-tags-by-name searchtxt db))) - ((eq searchtype 'tagregexp) - (setq found (semantic-find-tags-by-name-regexp searchtxt db))) - ((eq searchtype 'tagcompletions) - (setq found (semantic-find-tags-for-completion searchtxt db))) - ) ;; Loop over FOUND to see if we can line up a match with a line number. (when (= (length found) 1) (setq hit (car found))) @@ -501,80 +577,6 @@ buffers that were opened." (semantic--tag-put-property tag :hit (list line))) tag)) -;;; SYMREF TOOLS -;; -;; The base symref tool provides something to hang new tools off of -;; for finding symbol references. -(defclass semantic-symref-tool-baseclass () - ((searchfor :initarg :searchfor - :type string - :documentation "The thing to search for.") - (searchtype :initarg :searchtype - :type symbol - :documentation "The type of search to do. -Values could be 'symbol, 'regexp, 'tagname, or 'completion.") - (searchscope :initarg :searchscope - :type symbol - :documentation - "The scope to search for. -Can be 'project, 'target, or 'file.") - (resulttype :initarg :resulttype - :type symbol - :documentation - "The kind of search results desired. -Can be 'line, 'file, or 'tag. -The type of result can be converted from 'line to 'file, or 'line to 'tag, -but not from 'file to 'line or 'tag.") - ) - "Baseclass for all symbol references tools. -A symbol reference tool supplies functionality to identify the locations of -where different symbols are used. - -Subclasses should be named `semantic-symref-tool-NAME', where -NAME is the name of the tool used in the configuration variable -`semantic-symref-tool'" - :abstract t) - -(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass)) - "Calculate the results of a search based on TOOL. -The symref TOOL should already contain the search criteria." - (let ((answer (semantic-symref-perform-search tool)) - ) - (when answer - (let ((answersym (if (eq (oref tool :resulttype) 'file) - :hit-files - (if (stringp (car answer)) - :hit-text - :hit-lines)))) - (semantic-symref-result (oref tool searchfor) - answersym - answer - :created-by tool)) - ) - )) - -(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass)) - "Base search for symref tools should throw an error." - (error "Symref tool objects must implement `semantic-symref-perform-search'")) - -(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass) - outputbuffer) - "Parse the entire OUTPUTBUFFER of a symref tool. -Calls the method `semantic-symref-parse-tool-output-one-line' over and -over until it returns nil." - (with-current-buffer outputbuffer - (goto-char (point-min)) - (let ((result nil) - (hit nil)) - (while (setq hit (semantic-symref-parse-tool-output-one-line tool)) - (setq result (cons hit result))) - (nreverse result))) - ) - -(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass)) - "Base tool output parser is not implemented." - (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'")) - (provide 'semantic/symref) ;; Local variables: diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 4890b5b5755..3abd8b3f51c 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -60,6 +60,9 @@ See the function `cedet-cscope-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-cscope--line-re + "^\\([^ ]+\\) [^ ]+ \\([0-9]+\\) ") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -78,8 +81,13 @@ Moves cursor to end of the match." ;; We have to return something at this point. subtxt))) ) - (t - (when (re-search-forward "^\\([^ ]+\\) [^ ]+ \\([0-9]+\\) " nil t) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-cscope--line-re nil t) + (list (string-to-number (match-string 2)) + (expand-file-name (match-string 1)) + (buffer-substring-no-properties (point) (line-end-position))))) + (t ; :resulttype is 'line + (when (re-search-forward semantic-symref-cscope--line-re nil t) (cons (string-to-number (match-string 2)) (expand-file-name (match-string 1))) )))) diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el index e4c114e9c89..a33427e93a6 100644 --- a/lisp/cedet/semantic/symref/global.el +++ b/lisp/cedet/semantic/symref/global.el @@ -49,6 +49,9 @@ See the function `cedet-gnu-global-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-global--line-re + "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) ") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -57,8 +60,13 @@ Moves cursor to end of the match." ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-global--line-re nil t) + (list (string-to-number (match-string 2)) + (match-string 3) + (buffer-substring-no-properties (point) (line-end-position))))) (t - (when (re-search-forward "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) " nil t) + (when (re-search-forward semantic-symref-global--line-re nil t) (cons (string-to-number (match-string 2)) (match-string 3)) )))) diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 5d1fea8c829..b232e0fb619 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -50,6 +50,7 @@ and those hits returned.") "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") (perl-mode "*.pl" "*.PL") (cperl-mode "*.pl" "*.PL") + (lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs") ) "List of major modes and file extension pattern. See find -name man page for format.") @@ -80,7 +81,7 @@ Optional argument MODE specifies the `major-mode' to test." (if (null (cdr args)) args `("(" ,@args - ,@(apply #'nconc (mapcar (lambda (s) `("-o" "-name" ,s)) pat)) + ,@(mapcan (lambda (s) `("-o" "-name" ,s)) pat) ")")))))) (defvar grepflags) @@ -188,6 +189,9 @@ This shell should support pipe redirect syntax." ;; Return the answer ans)) +(defconst semantic-symref-grep--line-re + "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -195,8 +199,13 @@ Moves cursor to end of the match." ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-grep--line-re nil t) + (list (string-to-number (match-string 2)) + (match-string 1) + (buffer-substring-no-properties (point) (line-end-position))))) (t - (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t) + (when (re-search-forward semantic-symref-grep--line-re nil t) (cons (string-to-number (match-string 2)) (match-string 1)) )))) diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index 4127d7ae4ea..db3e9a0dddb 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -49,6 +49,9 @@ See the function `cedet-idutils-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-idutils--line-re + "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -59,8 +62,13 @@ Moves cursor to end of the match." ((eq (oref tool :searchtype) 'tagcompletions) (when (re-search-forward "^\\([^ ]+\\) " nil t) (match-string 1))) - (t - (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-idutils--line-re nil t) + (list (string-to-number (match-string 2)) + (expand-file-name (match-string 1) default-directory) + (buffer-substring-no-properties (point) (line-end-position))))) + (t ; resulttype is line + (when (re-search-forward semantic-symref-idutils--line-re nil t) (cons (string-to-number (match-string 2)) (expand-file-name (match-string 1) default-directory)) )))) diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 8b4f6f4e14b..cbb7705f9d1 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -258,7 +258,7 @@ can handle the @menu environment.") (when (not parenthetical) ;; We are in parentheses. Are they the types of parens ;; belonging to a texinfo construct? - (forward-word -1) + (forward-word-strictly -1) (when (looking-at "@\\w+{") (setq done (point)))))) ;; If we are not in a parenthetical node, then find a block instead. @@ -287,7 +287,7 @@ can handle the @menu environment.") ;; If we can't go up, we can't do this either. t ;; We moved, so now we need to skip into whatever this thing is. - (forward-word 1) ;; skip the command + (forward-word-strictly 1) ;; skip the command (if (looking-at "\\s-*{") ;; In a short command. Go in. (down-list 1) diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 6b80c96173c..4f7f0518dbf 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -712,7 +712,7 @@ minor mode is enabled." ;; Disable minor mode if semantic stuff not available (setq semantic-stickyfunc-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (unless (boundp 'default-header-line-format) + (unless (boundp 'header-line-format) ;; Disable if there are no header lines to use. (setq semantic-stickyfunc-mode nil) (error "Sticky Function mode requires Emacs")) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 86058cf6986..3e46f351e12 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -187,8 +187,10 @@ If optional LEFT is non-nil insert spaces on left." (defvar wisent-new-log-flag nil "Non-nil means to start a new report.") -(defvar wisent-verbose-flag nil - "*Non-nil means to report verbose information on generated parser.") +(defcustom wisent-verbose-flag nil + "Non-nil means to report verbose information on generated parser." + :group 'wisent + :type 'boolean) (defun wisent-toggle-verbose-flag () "Toggle whether to report verbose information on generated parser." @@ -2261,12 +2263,14 @@ tables so that there is no longer a conflict." (setq i (1+ i)))) rrc-count)) -(defvar wisent-expected-conflicts nil - "*If non-nil suppress the warning about shift/reduce conflicts. +(defcustom wisent-expected-conflicts nil + "If non-nil suppress the warning about shift/reduce conflicts. It is a decimal integer N that says there should be no warning if there are N shift/reduce conflicts and no reduce/reduce conflicts. A warning is given if there are either more or fewer conflicts, or if -there are any reduce/reduce conflicts.") +there are any reduce/reduce conflicts." + :group 'wisent + :type '(choice (const nil) integer)) (defun wisent-total-conflicts () "Report the total number of conflicts." diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 9eab8604215..2b225732517 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -127,8 +127,9 @@ POSITIONS are available." (apply #'max (mapcar #'cdr pl)))))) ;;; Reporting -(defvar wisent-parse-verbose-flag nil - "*Non-nil means to issue more messages while parsing.") +(defcustom wisent-parse-verbose-flag nil + "Non-nil means to issue more messages while parsing." + :type 'boolean) (defun wisent-parse-toggle-verbose-flag () "Toggle whether to issue more messages while parsing." diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 1b7715c39d3..e4b54b83645 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -55,7 +55,7 @@ Once an insertion set is done, these fields will be activated.") (:underline "green")) (((class color) (background light)) (:underline "green4"))) - "*Face used to specify editable fields from a template." + "Face used to specify editable fields from a template." :group 'semantic-faces) (defcustom srecode-fields-exit-confirmation nil diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 19999a6fd99..66c4b7d23ab 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -194,9 +194,10 @@ Buffer based features related to change hooks is handled one level up." ;; area. Return value is not important. )) -(declare-function data-debug-new-buffer "data-debug") -(declare-function data-debug-insert-stuff-list "data-debug") -(declare-function data-debug-insert-thing dictionary "data-debug") +(declare-function data-debug-new-buffer "data-debug" (name)) +(declare-function data-debug-insert-stuff-list "data-debug" (stufflist prefix)) +(declare-function data-debug-insert-thing "data-debug" + (thing prefix prebuttontext &optional parent)) (defun srecode-insert-show-error-report (dictionary format &rest args) "Display an error report based on DICTIONARY, FORMAT and ARGS. diff --git a/lisp/character-fold.el b/lisp/char-fold.el index 2d3a8c67fa5..68bea29ea45 100644 --- a/lisp/character-fold.el +++ b/lisp/char-fold.el @@ -1,4 +1,4 @@ -;;; character-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*- +;;; char-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. @@ -22,12 +22,12 @@ ;;; Code: -(eval-and-compile (put 'character-fold-table 'char-table-extra-slots 1)) +(eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1)) -(defconst character-fold-table +(defconst char-fold-table (eval-when-compile - (let ((equiv (make-char-table 'character-fold-table)) - (equiv-multi (make-char-table 'character-fold-table)) + (let ((equiv (make-char-table 'char-fold-table)) + (equiv-multi (make-char-table 'char-fold-table)) (table (unicode-property-table-internal 'decomposition))) (set-char-table-extra-slot equiv 0 equiv-multi) @@ -115,7 +115,7 @@ equiv) equiv)) "Used for folding characters of the same group during search. -This is a char-table with the `character-fold-table' subtype. +This is a char-table with the `char-fold-table' subtype. Let us refer to the character in question by char-x. Each entry is either nil (meaning char-x only matches literally) @@ -136,18 +136,18 @@ For instance, the default alist for ?f includes: Exceptionally for the space character (32), ALIST is ignored.") -(defun character-fold--make-space-string (n) +(defun char-fold--make-space-string (n) "Return a string that matches N spaces." (format "\\(?:%s\\|%s\\)" (make-string n ?\s) (apply #'concat - (make-list n (or (aref character-fold-table ?\s) " "))))) + (make-list n (or (aref char-fold-table ?\s) " "))))) ;;;###autoload -(defun character-fold-to-regexp (string &optional _lax from) - "Return a regexp matching anything that character-folds into STRING. +(defun char-fold-to-regexp (string &optional _lax from) + "Return a regexp matching anything that char-folds into STRING. Any character in STRING that has an entry in -`character-fold-table' is replaced with that entry (which is a +`char-fold-table' is replaced with that entry (which is a regexp) and other characters are `regexp-quote'd. If the resulting regexp would be too long for Emacs to handle, @@ -156,7 +156,7 @@ just return the result of calling `regexp-quote' on STRING. FROM is for internal use. It specifies an index in the STRING from which to start." (let* ((spaces 0) - (multi-char-table (char-table-extra-slot character-fold-table 0)) + (multi-char-table (char-table-extra-slot char-fold-table 0)) (i (or from 0)) (end (length string)) (out nil)) @@ -172,9 +172,9 @@ from which to start." (pcase (aref string i) (`?\s (setq spaces (1+ spaces))) (c (when (> spaces 0) - (push (character-fold--make-space-string spaces) out) + (push (char-fold--make-space-string spaces) out) (setq spaces 0)) - (let ((regexp (or (aref character-fold-table c) + (let ((regexp (or (aref char-fold-table c) (regexp-quote (string c)))) ;; Long string. The regexp would probably be too long. (alist (unless (> end 50) @@ -206,13 +206,13 @@ from which to start." (let ((length (car entry)) (suffix-regexp (cdr entry))) (concat suffix-regexp - (character-fold-to-regexp subs nil length)))) + (char-fold-to-regexp subs nil length)))) `((0 . ,regexp) . ,matched-entries) "\\|") "\\)")))) out)))) (setq i (1+ i))) (when (> spaces 0) - (push (character-fold--make-space-string spaces) out)) + (push (char-fold--make-space-string spaces) out)) (let ((regexp (apply #'concat (nreverse out)))) ;; Limited by `MAX_BUF_SIZE' in `regex.c'. (if (> (length regexp) 5000) @@ -221,22 +221,22 @@ from which to start." ;;; Commands provided for completeness. -(defun character-fold-search-forward (string &optional bound noerror count) - "Search forward for a character-folded version of STRING. -STRING is converted to a regexp with `character-fold-to-regexp', +(defun char-fold-search-forward (string &optional bound noerror count) + "Search forward for a char-folded version of STRING. +STRING is converted to a regexp with `char-fold-to-regexp', which is searched for with `re-search-forward'. BOUND NOERROR COUNT are passed to `re-search-forward'." (interactive "sSearch: ") - (re-search-forward (character-fold-to-regexp string) bound noerror count)) + (re-search-forward (char-fold-to-regexp string) bound noerror count)) -(defun character-fold-search-backward (string &optional bound noerror count) - "Search backward for a character-folded version of STRING. -STRING is converted to a regexp with `character-fold-to-regexp', +(defun char-fold-search-backward (string &optional bound noerror count) + "Search backward for a char-folded version of STRING. +STRING is converted to a regexp with `char-fold-to-regexp', which is searched for with `re-search-backward'. BOUND NOERROR COUNT are passed to `re-search-backward'." (interactive "sSearch: ") - (re-search-backward (character-fold-to-regexp string) bound noerror count)) + (re-search-backward (char-fold-to-regexp string) bound noerror count)) -(provide 'character-fold) +(provide 'char-fold) -;;; character-fold.el ends here +;;; char-fold.el ends here diff --git a/lisp/chistory.el b/lisp/chistory.el index 6f8a74b2a67..be5393720ac 100644 --- a/lisp/chistory.el +++ b/lisp/chistory.el @@ -95,7 +95,7 @@ from the command history." ;;;###autoload (defun list-command-history () - "List history of commands typed to minibuffer. + "List history of commands that used the minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. diff --git a/lisp/comint.el b/lisp/comint.el index dcd4a5ae4cf..b9c65b0d512 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -283,6 +283,17 @@ This variable is buffer-local in all Comint buffers." (const others)) :group 'comint) +(defcustom comint-move-point-for-matching-input 'after-input + "Controls where to place point after matching input. +\\<comint-mode-map>This influences the commands \\[comint-previous-matching-input-from-input] and \\[comint-next-matching-input-from-input]. +If `after-input', point will be positioned after the input typed +by the user, but before the rest of the history entry that has +been inserted. If `end-of-line', point will be positioned at the +end of the current logical (not visual) line after insertion." + :type '(radio (const :tag "Stay after input" after-input) + (const :tag "Move to end of line" end-of-line)) + :group 'comint) + (defvaralias 'comint-scroll-to-bottom-on-output 'comint-move-point-for-output) (defcustom comint-scroll-show-maximum-output t @@ -345,14 +356,16 @@ This variable is buffer-local." (regexp-opt '("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the" "Old" "old" "New" "new" "'s" "login" - "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad") t) + "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" + "[sudo]" "Repeat" "Bad" "Retype") + t) " +\\)" "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" - "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\ -\\(?: for [^:：៖]+\\)?[:：៖]\\s *\\'") + "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" + "\\(?: for .+\\)?[:：៖]\\s *\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." - :version "24.4" + :version "26.1" :type 'regexp :group 'comint) @@ -1220,7 +1233,8 @@ If N is negative, search forwards for the -Nth following match." (comint-previous-matching-input (concat "^" (regexp-quote comint-matching-input-from-input-string)) n) - (goto-char opoint))) + (when (eq comint-move-point-for-matching-input 'after-input) + (goto-char opoint)))) (defun comint-next-matching-input-from-input (n) "Search forwards through input history for match for current input. diff --git a/lisp/completion.el b/lisp/completion.el index 06594217107..093740d2cc3 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -542,13 +542,13 @@ But only if it is longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char saved-point))) ;; Remove chars to ignore at the end. (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) (goto-char cmpl-symbol-end) - (forward-word -1) + (forward-word-strictly -1) (setq cmpl-symbol-end (point)) (goto-char saved-point))) ;; Return completion if the length is reasonable. @@ -584,7 +584,7 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end))) ;; Return value if long enough. @@ -597,12 +597,12 @@ Returns nil if there isn't one longer than `completion-min-length'." (let ((saved-point (point))) (setq cmpl-symbol-start (scan-sexps saved-point -1)) ;; take off chars. from end - (forward-word -1) + (forward-word-strictly -1) (setq cmpl-symbol-end (point)) ;; remove chars to ignore at the start (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)))) ;; Restore state. (goto-char saved-point) @@ -653,7 +653,7 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; Remove chars to ignore at the start. (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) (goto-char cmpl-symbol-start) - (forward-word 1) + (forward-word-strictly 1) (setq cmpl-symbol-start (point)) (goto-char cmpl-symbol-end))) ;; Return completion if the length is reasonable. @@ -821,7 +821,7 @@ This is sensitive to `case-fold-search'." ;; symbol char to ignore at end. Are we at end ? (progn (setq saved-point-2 (point)) - (forward-word -1) + (forward-word-strictly -1) (prog1 (= (char-syntax (preceding-char)) ? ) (goto-char saved-point-2))))) @@ -1850,7 +1850,7 @@ Prefix args :: (cond ((looking-at "\\(define\\|ifdef\\)\\>") ;; skip forward over definition symbol ;; and add it to database - (and (forward-word 2) + (and (forward-word-strictly 2) (setq string (symbol-before-point)) ;;(push string foo) (add-completion-to-tail-if-new string))))) @@ -1868,7 +1868,7 @@ Prefix args :: ;; move to next separator char. (goto-char (setq next-point (scan-sexps (point) 1)))) - (forward-word -1) + (forward-word-strictly -1) ;; add to database (if (setq string (symbol-under-point)) ;; (push string foo) @@ -1876,7 +1876,7 @@ Prefix args :: ;; Local TMC hack (useful for parsing paris.h) (if (and (looking-at "_AP") ;; "ansi prototype" (progn - (forward-word -1) + (forward-word-strictly -1) (setq string (symbol-under-point)))) (add-completion-to-tail-if-new string))) diff --git a/lisp/composite.el b/lisp/composite.el index 94b14dfc94a..53013c17c08 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -843,6 +843,8 @@ For more information on Auto Composition mode, see (defalias 'toggle-auto-composition 'auto-composition-mode) +(provide 'composite) + ;;; composite.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index addff82c624..f15161a600b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -175,10 +175,16 @@ :group 'emacs) (defgroup wp nil - "Support for editing text files." - :tag "Text" + "Support for editing text files. +Use group `text' for this instead. This group is deprecated." :group 'emacs) +(defgroup text nil + "Support for editing text files." + :group 'emacs + ;; Inherit from deprecated `wp' for compatibility, for now. + :group 'wp) + (defgroup data nil "Support for editing binary data files." :group 'emacs) @@ -197,14 +203,6 @@ :link '(custom-manual "(emacs)Emulation") :group 'editing) -(defgroup mouse nil - "Mouse support." - :group 'editing) - -(defgroup outlines nil - "Support for hierarchical outlining." - :group 'wp) - (defgroup external nil "Interfacing to external utilities." :group 'emacs) @@ -317,7 +315,7 @@ (defgroup tex nil "Code related to the TeX formatter." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :group 'wp) + :group 'text) (defgroup faces nil "Support for multiple fonts." @@ -406,10 +404,6 @@ "Input from the keyboard." :group 'environment) -(defgroup mouse nil - "Input from the mouse." - :group 'environment) - (defgroup menu nil "Input from the menus." :group 'environment) @@ -1072,9 +1066,10 @@ are shown; the contents of those subgroups are initially hidden." ;;;###autoload (defun customize-mode (mode) - "Customize options related to the current major mode. -If a prefix \\[universal-argument] was given (or if the current major mode has no known group), -then prompt for the MODE to customize." + "Customize options related to a major or minor mode. +By default the current major mode is used. With a prefix +argument or if the current major mode has no known group, prompt +for the MODE to customize." (interactive (list (let ((completion-regexp-list '("-mode\\'")) @@ -1083,8 +1078,8 @@ then prompt for the MODE to customize." major-mode (intern (completing-read (if group - (format "Major mode (default %s): " major-mode) - "Major mode: ") + (format "Mode (default %s): " major-mode) + "Mode: ") obarray 'custom-group-of-mode t nil nil (if group (symbol-name major-mode)))))))) @@ -1499,11 +1494,12 @@ Return non-nil if user chooses to customize, for use in (defcustom custom-buffer-style 'links "Control the presentation style for customization buffers. The value should be a symbol, one of: - -brackets: groups nest within each other with big horizontal brackets. -links: groups have links to subgroups." +`brackets': groups nest within each other with big horizontal brackets. +`links': groups have links to subgroups. +`tree': display groups as trees." :type '(radio (const brackets) - (const links)) + (const links) + (const tree)) :group 'custom-buffer) (defcustom custom-buffer-done-kill nil @@ -1543,27 +1539,29 @@ not for everybody." buf)))) ;;;###autoload -(defun custom-buffer-create (options &optional name description) +(defun custom-buffer-create (options &optional name _description) "Create a buffer containing OPTIONS. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option. DESCRIPTION is unused." - (pop-to-buffer-same-window (custom-get-fresh-buffer (or name "*Customization*"))) - (custom-buffer-create-internal options description)) + (pop-to-buffer-same-window + (custom-get-fresh-buffer (or name "*Customization*"))) + (custom-buffer-create-internal options)) ;;;###autoload -(defun custom-buffer-create-other-window (options &optional name description) +(defun custom-buffer-create-other-window (options &optional name _description) "Create a buffer containing OPTIONS, and display it in another window. The result includes selecting that window. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing -that option." +that option. +DESCRIPTION is unused." (unless name (setq name "*Customization*")) (switch-to-buffer-other-window (custom-get-fresh-buffer name)) - (custom-buffer-create-internal options description)) + (custom-buffer-create-internal options)) (defcustom custom-reset-button-menu t "If non-nil, only show a single reset button in customize buffers. @@ -1621,7 +1619,9 @@ Otherwise use brackets." ;; Insert verbose help at the top of the custom buffer. (when custom-buffer-verbose-help (unless init-file - (widget-insert "Custom settings cannot be saved; maybe you started Emacs with `-q'.\n")) + (widget-insert + (format-message + "Custom settings cannot be saved; maybe you started Emacs with `-q'.\n"))) (widget-insert "For help using this buffer, see ") (widget-create 'custom-manual :tag "Easy Customization" @@ -4362,7 +4362,7 @@ option itself, into the file you specify, overwriting any `custom-set-variables' and `custom-set-faces' forms already present in that file. It will not delete any customizations from the old custom file. You should do that manually if that is what you -want. You also have to put something like `(load \"CUSTOM-FILE\") +want. You also have to put something like (load \"CUSTOM-FILE\") in your init file, where CUSTOM-FILE is the actual name of the file. Otherwise, Emacs will not load the file when it starts up, and hence will not set `custom-file' to that file either." diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 1c10bf76320..08dfbdf0b32 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -54,7 +54,8 @@ ;; :risky - risky-local-variable property ;; :safe - safe-local-variable property ;; :tag - custom-tag property -(let (standard native-p prop propval +(let (standard + native-p prop propval ;; This function turns a value ;; into an expression which produces that value. (quoter (lambda (sexp) @@ -67,27 +68,27 @@ (stringp sexp) (numberp sexp)) sexp - (list 'quote sexp))))) + (list 'quote sexp)))) + (cursor-type-types + '(choice + (const :tag "Frame default" t) + (const :tag "Filled box" box) + (const :tag "Hollow cursor" hollow) + (const :tag "Vertical bar" bar) + (cons :tag "Vertical bar with specified width" + (const bar) integer) + (const :tag "Horizontal bar" hbar) + (cons :tag "Horizontal bar with specified width" + (const hbar) integer) + (const :tag "None "nil)))) (pcase-dolist (`(,symbol ,group ,type ,version . ,rest) - '(;; alloc.c + `(;; alloc.c (gc-cons-threshold alloc integer) (gc-cons-percentage alloc float) (garbage-collection-messages alloc boolean) ;; buffer.c - (cursor-type - display - (choice - (const :tag "Frame default" t) - (const :tag "Filled box" box) - (const :tag "Hollow cursor" hollow) - (const :tag "Vertical bar" bar) - (cons :tag "Vertical bar with specified width" - (const bar) integer) - (const :tag "Horizontal bar" hbar) - (cons :tag "Horizontal bar with specified width" - (const hbar) integer) - (const :tag "None "nil))) + (cursor-type display ,cursor-type-types) (mode-line-format mode-line sexp) ;Hard to do right. (major-mode internal function) (case-fold-search matching boolean) @@ -147,7 +148,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (line-spacing display (choice (const :tag "none" nil) number) "22.1") (cursor-in-non-selected-windows - cursor boolean nil + cursor ,cursor-type-types nil :tag "Cursor In Non-selected Windows" :set (lambda (symbol value) (set-default symbol value) @@ -172,7 +173,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (directory :format "%v"))) nil :standard - (mapcar 'directory-file-name + (mapcar (lambda (f) + (if f (directory-file-name f) + ".")) (append (parse-colon-path (getenv "PATH")) (list exec-directory)))) (exec-suffixes execute (repeat string)) @@ -245,6 +248,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (debug-ignored-errors debug (repeat (choice symbol regexp))) (debug-on-quit debug boolean) (debug-on-signal debug boolean) + (debugger-stack-frame-as-list debugger boolean "26.1") ;; fileio.c (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 3160e23d9e0..5a20b8ef671 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -61,7 +61,8 @@ Do not call this mode function yourself. It is meant for internal use." (defvar custom-theme-insert-face-marker nil) (defvar custom-theme--listed-faces '(default cursor fixed-pitch - variable-pitch escape-glyph minibuffer-prompt highlight region + variable-pitch escape-glyph homoglyph + minibuffer-prompt highlight region shadow secondary-selection trailing-whitespace font-lock-builtin-face font-lock-comment-delimiter-face font-lock-comment-face font-lock-constant-face diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index d9f36b15290..438eda3776d 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -433,7 +433,10 @@ Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable -`dabbrev-friend-buffer-function'. +`dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' +says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in +all the other buffers, subject to constraints specified +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. diff --git a/lisp/delim-col.el b/lisp/delim-col.el index cfa7c76622a..dc637d5a57d 100644 --- a/lisp/delim-col.el +++ b/lisp/delim-col.el @@ -125,7 +125,7 @@ "Prettify columns." :link '(emacs-library-link :tag "Source Lisp File" "delim-col.el") :prefix "delimit-columns-" - :group 'wp) + :group 'text) (defcustom delimit-columns-str-before "" "Specify a string to be inserted before all columns." diff --git a/lisp/delsel.el b/lisp/delsel.el index 6a819ebbf67..da4223f49fe 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -171,16 +171,17 @@ With ARG, repeat that many times. `C-u' means until end of buffer." active region. `kill' `kill-region' is used on the selection, rather than - `delete-region'. (Text selected with the mouse will typically - be yankable anyhow.) - t - The normal case: delete the active region prior to executing - the command which will insert replacement text. + `delete-region'. (Text selected with the mouse will + typically be yankable anyhow.) FUNCTION - For commands which need to dynamically determine this behavior. - FUNCTION should take no argument and return one of the above - values, or nil. In the latter case, FUNCTION should itself - do with the active region whatever is appropriate." + For commands which need to dynamically determine this + behavior. FUNCTION should take no argument and return a + value acceptable as TYPE, or nil. In the latter case, + FUNCTION should itself do with the active region whatever is + appropriate. + Other non-nil values + The normal case: delete the active region prior to executing + the command which will insert replacement text." (condition-case data (cond ((eq type 'kill) ;Deprecated, backward compatibility. (delete-active-region t) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index a352ed0849c..6c7983a1771 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -277,12 +277,12 @@ This function is semi-obsolete. Use `get-char-code-property'." 'general-category (intern val)) val))) (list "Combining class" - (let ((val (nth 1 fields))) + (let ((val (nth 2 fields))) (or (char-code-property-description 'canonical-combining-class (intern val)) val))) (list "Bidi category" - (let ((val (nth 1 fields))) + (let ((val (nth 3 fields))) (or (char-code-property-description 'bidi-class (intern val)) val))) @@ -619,7 +619,7 @@ relevant to POS." (let ((name (or (get-char-code-property char 'name) (get-char-code-property char 'old-name)))) - (if name + (if (and name (assoc-string name (ucs-names))) (format "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\"" char name) @@ -806,9 +806,16 @@ relevant to POS." 'describe-char-unidata-list)) 'follow-link t) (insert "\n") - (dolist (elt (if (eq describe-char-unidata-list t) - (nreverse (mapcar 'car char-code-property-alist)) - describe-char-unidata-list)) + (dolist (elt + (cond ((eq describe-char-unidata-list t) + (nreverse (mapcar 'car char-code-property-alist))) + ((< char 32) + ;; Temporary fix (2016-05-22): The + ;; decomposition item for \n corrupts the + ;; display on a Linux virtual terminal. + ;; (Bug #23594). + (remq 'decomposition describe-char-unidata-list)) + (t describe-char-unidata-list))) (let ((val (get-char-code-property char elt)) description) (when val diff --git a/lisp/desktop.el b/lisp/desktop.el index 822db050e1f..9fb8393e76c 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -367,6 +367,7 @@ these won't be deleted." column-number-mode size-indication-mode buffer-file-coding-system + buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries @@ -408,7 +409,7 @@ See related options `desktop-restore-reuses-frames', :group 'desktop :version "24.4") -(defcustom desktop-restore-in-current-display nil +(defcustom desktop-restore-in-current-display t "Controls how restoring of frames treats displays. If t, restores frames into the current display. If nil, restores frames into their original displays (if possible). @@ -1163,7 +1164,7 @@ This function also sets `desktop-dirname' to nil." "Restore the state of a set of frames. This function depends on the value of `desktop-saved-frameset' being set (usually, by reading it from the desktop)." - (when (desktop-restoring-frameset-p) + (when (and (display-graphic-p) (desktop-restoring-frameset-p)) (frameset-restore desktop-saved-frameset :reuse-frames (eq desktop-restore-reuses-frames t) :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep)) @@ -1233,8 +1234,8 @@ Using it may cause conflicts. Use it anyway? " owner))))) (memq 'desktop-auto-save-set-timer window-configuration-change-hook)) (desktop-auto-save-disable) ;; Evaluate desktop buffer and remember when it was modified. - (load (desktop-full-file-name) t t t) (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) + (load (desktop-full-file-name) t t t) ;; If it wasn't already, mark it as in-use, to bother other ;; desktop instances. (unless (eq (emacs-pid) owner) @@ -1402,7 +1403,7 @@ after that many seconds of idle time." (or coding-system-for-read (cdr (assq 'buffer-file-coding-system desktop-buffer-locals)))) - (buf (find-file-noselect buffer-filename))) + (buf (find-file-noselect buffer-filename :nowarn))) (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))) @@ -1536,6 +1537,19 @@ and try to load that." ;; An entry of the form `symbol'. (make-local-variable this) (makunbound this))) + ;; adjust `buffer-display-time' for the downtime. e.g., + ;; * if `buffer-display-time' was 8:00 + ;; * and emacs stopped at `desktop-file-modtime' == 11:00 + ;; * and we are loading the desktop file at (current-time) 12:30, + ;; -> then we restore `buffer-display-time' as 9:30, + ;; for the sake of `clean-buffer-list': preserving the invariant + ;; "how much time the user spent in Emacs without looking at this buffer". + (setq buffer-display-time + (if buffer-display-time + (time-add buffer-display-time + (time-subtract (current-time) + desktop-file-modtime)) + (current-time))) (unless (< desktop-file-version 208) ; Don't misinterpret any old custom args (dolist (record compacted-vars) (let* @@ -1634,15 +1648,8 @@ If there are no buffers left to create, kill the timer." (setq command-line-args (delete key command-line-args)) (desktop-save-mode 0))) (when desktop-save-mode - ;; People don't expect emacs -nw, or --daemon, - ;; to create graphical frames (bug#17693). - ;; TODO perhaps there should be a separate value - ;; for desktop-restore-frames to control this startup behavior? - (let ((desktop-restore-frames (and desktop-restore-frames - initial-window-system - (not (daemonp))))) - (desktop-read) - (setq inhibit-startup-screen t))))) + (desktop-read) + (setq inhibit-startup-screen t)))) (provide 'desktop) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 3e387d9e0df..f94e0537aa6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -39,7 +39,6 @@ ;; We need macros in dired.el to compile properly, ;; and we call subroutines in it too. (require 'dired) -(require 'cl-lib) ; for cl-mapcan (defvar dired-create-files-failures nil "Variable where `dired-create-files' records failing file names. @@ -55,19 +54,23 @@ into this list; they also should call `dired-log' to log the errors.") ;;;###autoload (defun dired-diff (file &optional switches) - "Compare file at point with file FILE using `diff'. -If called interactively, prompt for FILE. If the file at point -has a backup file, use that as the default. If the file at point -is a backup file, use its original. If the mark is active -in Transient Mark mode, use the file at the mark as the default. -\(That's the mark set by \\[set-mark-command], not by Dired's -\\[dired-mark] command.) - -FILE is the first file given to `diff'. The file at point -is the second file given to `diff'. + "Compare file at point with FILE using `diff'. +If called interactively, prompt for FILE. +If the mark is active in Transient Mark mode, use the file at the mark +as the default for FILE. (That's the mark set by \\[set-mark-command], +not by Dired's \\[dired-mark] command.) +If the file at point has a backup file, use that as the default FILE. +If the file at point is a backup file, use its original, if that exists +and can be found. Note that customizations of `backup-directory-alist' +and `make-backup-file-name-function' change where this function searches +for the backup file, and affect its ability to find the original of a +backup file. + +FILE is the first argument given to the `diff' function. The file at +point is the second argument given to `diff'. With prefix arg, prompt for second argument SWITCHES, which is -the string of command switches for the third argument of `diff'." +the string of command switches used as the third argument of `diff'." (interactive (let* ((current (dired-get-filename t)) ;; Get the latest existing backup file or its original. @@ -78,8 +81,20 @@ the string of command switches for the third argument of `diff'." (file-at-mark (if (and transient-mark-mode mark-active) (save-excursion (goto-char (mark t)) (dired-get-filename t t)))) + (separate-dir (and oldf + (not (equal (file-name-directory oldf) + (dired-current-directory))))) (default-file (or file-at-mark - (and oldf (file-name-nondirectory oldf)))) + ;; If the file with which to compare + ;; doesn't exist, or we cannot intuit it, + ;; we forget that name and don't show it + ;; as the default, as an indication to the + ;; user that she should type the file + ;; name. + (and (if (and oldf (file-readable-p oldf)) oldf) + (if separate-dir + oldf + (file-name-nondirectory oldf))))) ;; Use it as default if it's not the same as the current file, ;; and the target dir is current or there is a default file. (default (if (and (not (equal default-file current)) @@ -88,7 +103,9 @@ the string of command switches for the third argument of `diff'." default-file)) default-file)) (target-dir (if default - (dired-current-directory) + (if separate-dir + (file-name-directory default) + (dired-current-directory)) (dired-dwim-target-directory))) (defaults (dired-dwim-target-defaults (list current) target-dir))) (list @@ -280,6 +297,14 @@ List has a form of (file-name full-file-name (attribute-list))." ((eq op-symbol 'chgrp) (system-groups))))) (operation (concat program " " new-attribute)) + ;; When file-name-coding-system is set to something different + ;; from locale-coding-system, leaving the encoding + ;; determination to call-process will do the wrong thing, + ;; because the arguments in this case are file names, not + ;; just some arbitrary text. (This must be bound last, to + ;; avoid adverse effects on any of the preceding forms.) + (coding-system-for-write (or file-name-coding-system + default-file-name-coding-system)) failures) (setq failures (dired-bunch-files 10000 @@ -730,26 +755,52 @@ can be produced by `dired-get-marked-files', for example." (command (if sequentially (substring command 0 (match-beginning 0)) command)) + (parallel-in-background + (and in-background (not sequentially) (not (eq system-type 'ms-dos)))) + (w32-shell (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics))) + ;; The way to run a command in background in Windows shells + ;; is to use the START command. The /B switch means not to + ;; create a new window for the command. + (cmd-prefix (if w32-shell "start /b " "")) + ;; Windows shells don't support chaining with ";", they use + ;; "&" instead. + (cmd-sep (if (and (not w32-shell) (not parallel-in-background)) + ";" + "&")) (stuff-it (if (or (string-match-p dired-star-subst-regexp command) (string-match-p dired-quark-subst-regexp command)) (lambda (x) - (let ((retval command)) + (let ((retval (concat cmd-prefix command))) (while (string-match "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) (setq retval (replace-match x t t retval 2))) retval)) - (lambda (x) (concat command dired-mark-separator x))))) + (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) (concat - (if on-each - (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) - (if (and in-background (not sequentially)) "&" ";")) - (let ((files (mapconcat 'shell-quote-argument - file-list dired-mark-separator))) - (if (> (length file-list) 1) - (setq files (concat dired-mark-prefix files dired-mark-postfix))) - (funcall stuff-it files))) - (if in-background "&" "")))) + (cond (on-each + (format "%s%s" + (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) + cmd-sep) + ;; POSIX shells running a list of commands in the background + ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &]) + ;; return once cmd_N ends, i.e., the shell does not + ;; wait for cmd_i to finish before executing cmd_i+1. + ;; That means, running (shell-command LIST) may not show + ;; the output of all the commands (Bug#23206). + ;; Add 'wait' to force those POSIX shells to wait until + ;; all commands finish. + (or (and parallel-in-background (not w32-shell) + "&wait") + ""))) + (t + (let ((files (mapconcat 'shell-quote-argument + file-list dired-mark-separator))) + (when (cdr file-list) + (setq files (concat dired-mark-prefix files dired-mark-postfix))) + (funcall stuff-it files)))) + (or (and in-background "&") "")))) ;; This is an extra function so that it can be redefined by ange-ftp. ;;;###autoload @@ -891,8 +942,8 @@ command with a prefix argument (the value does not matter)." ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021. ;; Same thing on AIX 7.1. ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv") + ("\\.tgz\\'" "" "gzip -dc %i | tar -xv") ("\\.gz\\'" "" "gunzip") - ("\\.tgz\\'" ".tar" "gunzip") ("\\.Z\\'" "" "uncompress") ;; For .z, try gunzip. It might be an old gzip file, ;; or it might be from compact? pack? (which?) but gunzip handles both. @@ -902,6 +953,7 @@ command with a prefix argument (the value does not matter)." ("\\.bz2\\'" "" "bunzip2") ("\\.xz\\'" "" "unxz") ("\\.zip\\'" "" "unzip -o -d %o %i") + ("\\.7z\\'" "" "7z x -aoa -o%o %i") ;; This item controls naming for compression. ("\\.tar\\'" ".tgz" nil) ;; This item controls the compression of directories @@ -938,12 +990,12 @@ output file. %i path(s) are relative, while %o is absolute.") ;;;###autoload (defun dired-do-compress-to () "Compress selected files and directories to an archive. -You are prompted for the archive name. -The archiving command is chosen based on the archive name extension and -`dired-compress-files-alist'." +Prompt for the archive file name. +Choose the archiving command based on the archive file-name extension +and `dired-compress-files-alist'." (interactive) (let* ((in-files (dired-get-marked-files)) - (out-file (read-file-name "Compress to: ")) + (out-file (expand-file-name (read-file-name "Compress to: "))) (rule (cl-find-if (lambda (x) (string-match (car x) out-file)) @@ -960,11 +1012,13 @@ The archiving command is chosen based on the archive name extension and (t (when (zerop (dired-shell-command - (replace-regexp-in-string - "%o" out-file - (replace-regexp-in-string - "%i" (mapconcat #'file-name-nondirectory in-files " ") - (cdr rule))))) + (format-spec (cdr rule) + `((?\o . ,(shell-quote-argument out-file)) + (?\i . ,(mapconcat + (lambda (file-desc) + (shell-quote-argument (file-name-nondirectory + file-desc))) + in-files " ")))))) (message "Compressed %d file(s) to %s" (length in-files) (file-name-nondirectory out-file))))))) @@ -997,10 +1051,12 @@ Return nil if no change in files." (prog1 (setq newname (file-name-as-directory newname)) (dired-shell-command (replace-regexp-in-string - "%o" newname + "%o" (shell-quote-argument newname) (replace-regexp-in-string - "%i" file - command)))) + "%i" (shell-quote-argument file) + command + nil t) + nil t))) ;; We found an uncompression rule. (when (not (dired-check-process @@ -1020,10 +1076,12 @@ Return nil if no change in files." (default-directory (file-name-directory file))) (dired-shell-command (replace-regexp-in-string - "%o" out-name + "%o" (shell-quote-argument out-name) (replace-regexp-in-string - "%i" (file-name-nondirectory file) - (cadr suffix)))) + "%i" (shell-quote-argument (file-name-nondirectory file)) + (cadr suffix) + nil t) + nil t)) out-name))) (let ((out-name (concat file ".gz"))) (and (or (not (file-exists-p out-name)) @@ -1743,13 +1801,14 @@ Optional arg HOW-TO determines how to treat the target. (concat (if dired-one-file op1 operation) " %s to: ") target-dir op-symbol arg rfn-list default)))) (into-dir (cond ((null how-to) - ;; Allow DOS/Windows users to change the letter - ;; case of a directory. If we don't test these - ;; conditions up front, file-directory-p below - ;; will return t because the filesystem is - ;; case-insensitive, and Emacs will try to move + ;; Allow users to change the letter case of + ;; a directory on a case-insensitive + ;; filesystem. If we don't test these + ;; conditions up front, file-directory-p + ;; below will return t on a case-insensitive + ;; filesystem, and Emacs will try to move ;; foo -> foo/foo, which fails. - (if (and (memq system-type '(ms-dos windows-nt cygwin)) + (if (and (file-name-case-insensitive-p (car fn-list)) (eq op-symbol 'move) dired-one-file (string= (downcase @@ -2487,8 +2546,8 @@ Lower levels are unaffected." (cur-dir (dired-current-directory)) (cons (assoc-string cur-dir dired-switches-alist)) buffer-read-only) - (if (equal cur-dir default-directory) - (error "Attempt to kill top level directory")) + (when (equal cur-dir (expand-file-name default-directory)) + (error "Attempt to kill top level directory")) (prog1 (if remember-marks (dired-remember-marks beg end)) (delete-region beg end) @@ -2720,16 +2779,23 @@ with the command \\[tags-loop-continue]." ;;;###autoload (defun dired-do-find-regexp (regexp) - "Find all matches for REGEXP in all marked files, recursively." + "Find all matches for REGEXP in all marked files. +For any marked directory, all of its files are searched recursively. +However, files matching `grep-find-ignored-files' and subdirectories +matching `grep-find-ignored-directories' are skipped in the marked +directories. + +REGEXP should use constructs supported by your local `grep' command." (interactive "sSearch marked files (regexp): ") (require 'grep) (defvar grep-find-ignored-files) + (defvar grep-find-ignored-directories) (let* ((files (dired-get-marked-files)) (ignores (nconc (mapcar (lambda (s) (concat s "/")) - vc-directory-exclusion-list) + grep-find-ignored-directories) grep-find-ignored-files)) - (xrefs (cl-mapcan + (xrefs (mapcan (lambda (file) (xref-collect-matches regexp "*" file (and (file-directory-p file) @@ -2741,7 +2807,13 @@ with the command \\[tags-loop-continue]." ;;;###autoload (defun dired-do-find-regexp-and-replace (from to) - "Replace matches of FROM with TO, in all marked files, recursively." + "Replace matches of FROM with TO, in all marked files. +For any marked directory, matches in all of its files are replaced, +recursively. However, files matching `grep-find-ignored-files' +and subdirectories matching `grep-find-ignored-directories' are skipped +in the marked directories. + +REGEXP should use constructs supported by your local `grep' command." (interactive (let ((common (query-replace-read-args diff --git a/lisp/dired-x.el b/lisp/dired-x.el index e8cea85d988..bddf1ebf78d 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -29,20 +29,6 @@ ;; This is based on Sebastian Kremer's excellent dired-x.el (Dired Extra), ;; version 1.191, adapted for GNU Emacs. See the `dired-x' info pages. -;; USAGE: In your ~/.emacs, -;; -;; (add-hook 'dired-load-hook -;; (lambda () -;; (load "dired-x") -;; ;; Set global variables here. For example: -;; ;; (setq dired-guess-shell-gnutar "gtar") -;; )) -;; (add-hook 'dired-mode-hook -;; (lambda () -;; ;; Set buffer-local variables here. For example: -;; ;; (dired-omit-mode 1) -;; )) -;; ;; At load time dired-x.el will install itself and bind some dired keys. ;; Some dired.el and dired-aux.el functions have extra features if ;; dired-x is loaded. @@ -133,6 +119,24 @@ If nil, there is no maximum size." :type '(choice (const :tag "no maximum" nil) integer) :group 'dired-x) +(defcustom dired-omit-case-fold 'filesystem + "Determine whether \"omitting\" patterns are case-sensitive. +When nil, always be case-sensitive; when t, always be +case-insensitive; the default value, `filesystem', causes case +folding to be used on case-insensitive filesystems only." + :type '(choice (const :tag "Always case-sensitive" nil) + (const :tag "Always case-insensitive" t) + (const :tag "According to filesystem" filesystem)) + :group 'dired-x + :version "26.1") + +(declare-function file-name-case-insensitive-p "fileio.c" (filename)) +(defun dired-omit-case-fold-p (dir) + "Non-nil if `dired-omit-mode' should be case-insensitive in DIR." + (if (eq dired-omit-case-fold 'filesystem) + (file-name-case-insensitive-p dir) + dired-omit-case-fold)) + ;; For backward compatibility (define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1") (define-minor-mode dired-omit-mode @@ -333,8 +337,28 @@ See also the functions: "Mark all files with a certain EXTENSION for use in later commands. A `.' is *not* automatically prepended to the string entered. EXTENSION may also be a list of extensions instead of a single one. -Optional MARKER-CHAR is marker to use." - (interactive "sMarking extension: \nP") +Optional MARKER-CHAR is marker to use. +Interactively, ask for EXTENSION. +Prefixed with one C-u, unmark files instead. +Prefixed with two C-u's, prompt for MARKER-CHAR and mark files with it." + (interactive + (let ((suffix + (read-string (format "%s extension: " + (if (equal current-prefix-arg '(4)) + "UNmarking" + "Marking")))) + (marker + (pcase current-prefix-arg + ('(4) ?\s) + ('(16) + (let* ((dflt (char-to-string dired-marker-char)) + (input (read-string + (format + "Marker character to use (default %s): " dflt) + nil nil dflt))) + (aref input 0))) + (_ dired-marker-char)))) + (list suffix marker))) (or (listp extension) (setq extension (list extension))) (dired-mark-files-regexp @@ -413,14 +437,19 @@ If in Dired already, pop up a level and goto old directory's line. In case the proper Dired file line cannot be found, refresh the dired buffer and try again. When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. -Interactively with prefix argument, read FILE-NAME and -move to its line in dired." +When FILE-NAME is non-nil, jump to its line in Dired. +Interactively with prefix argument, read FILE-NAME." (interactive (list nil (and current-prefix-arg (read-file-name "Jump to Dired file: ")))) (if (bound-and-true-p tar-subfile-mode) (switch-to-buffer tar-superior-buffer) - (let* ((file (or file-name buffer-file-name)) + ;; Expand file-name before `dired-goto-file' call: + ;; `dired-goto-file' requires its argument to be an absolute + ;; file name; the result of `read-file-name' could be + ;; an abbreviated file name (Bug#24409). + (let* ((file (or (and file-name (expand-file-name file-name)) + buffer-file-name)) (dir (if file (file-name-directory file) default-directory))) (if (and (eq major-mode 'dired-mode) (null file-name)) (progn @@ -482,7 +511,8 @@ Should never be used as marker by the user or other packages.") "Mark files matching `dired-omit-files' and `dired-omit-extensions'." (interactive) (let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files - (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp)) + (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp + (dired-omit-case-fold-p dired-directory))) (defcustom dired-omit-extensions (append completion-ignored-extensions @@ -526,7 +556,8 @@ This functions works by temporarily binding `dired-marker-char' to (or (string= omit-re "") (let ((dired-marker-char dired-omit-marker-char)) (when dired-omit-verbose (message "Omitting...")) - (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp) + (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp + (dired-omit-case-fold-p dired-directory)) (progn (setq count (dired-do-kill-lines nil @@ -552,12 +583,14 @@ This functions works by temporarily binding `dired-marker-char' to ""))) ;; Returns t if any work was done, nil otherwise. -(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) +(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp case-fold-p) "Mark unmarked files matching REGEXP, displaying MSG. REGEXP is matched against the entire file name. When called interactively, prompt for REGEXP. With prefix argument, unflag all those files. -Optional fourth argument LOCALP is as in `dired-get-filename'." +Optional fourth argument LOCALP is as in `dired-get-filename'. +Optional fifth argument CASE-FOLD-P specifies the value of +`case-fold-search' used for matching REGEXP." (interactive (list (read-regexp "Mark unmarked files matching regexp (default all): " @@ -569,7 +602,10 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." ;; not already marked (looking-at-p " ") ;; uninteresting - (let ((fn (dired-get-filename localp t))) + (let ((fn (dired-get-filename localp t)) + ;; Match patterns case-insensitively on case-insensitive + ;; systems + (case-fold-search case-fold-p)) (and fn (string-match-p regexp fn)))) msg))) @@ -816,12 +852,11 @@ If in a Dired buffer, reverts it." (interactive) (if (file-exists-p dired-local-variables-file) (error "Old-style dired-local-variables-file `./%s' found; -replace it with a dir-locals-file `./%s.el'" +replace it with a dir-locals-file `./%s'" dired-local-variables-file dir-locals-file)) - (if (dir-locals--all-files default-directory) - (message "File `./%s' already exists." - (car (dir-locals--all-files default-directory))) + (if (file-exists-p dir-locals-file) + (message "File `./%s' already exists." dir-locals-file) (add-dir-local-variable 'dired-mode 'subdirs nil) (add-dir-local-variable 'dired-mode 'dired-omit-mode t) ;; Run extra-hooks and revert directory. @@ -1055,17 +1090,7 @@ and the rest will be added temporarily to the history and can be retrieved with \\[previous-history-element] (M-p) . The variable `dired-guess-shell-case-fold-search' controls whether -REGEXP is matched case-sensitively. - -You can set this variable in your ~/.emacs. For example, to add rules for -`.foo' and `.bar' files, write - - (setq dired-guess-shell-alist-user - '((\"\\\\.foo\\\\'\" \"FOO-COMMAND\") - (\"\\\\.bar\\\\'\" - (if condition - \"BAR-COMMAND-1\" - \"BAR-COMMAND-2\"))))" +REGEXP is matched case-sensitively." :group 'dired-x :type '(alist :key-type regexp :value-type (repeat sexp))) @@ -1373,29 +1398,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (memq buffer1 (buffer-list)) (not (memq buffer1 (memq buffer2 (buffer-list)))))) -;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 -;; (defun dired-buffers-for-dir-exact (dir) -;; ;; Return a list of buffers that dired DIR (a directory or wildcard) -;; ;; at top level, or as subdirectory. -;; ;; Top level matches must match the wildcard part too, if any. -;; ;; The list is in reverse order of buffer creation, most recent last. -;; ;; As a side effect, killed dired buffers for DIR are removed from -;; ;; dired-buffers. -;; (let ((alist dired-buffers) result elt) -;; (while alist -;; (setq elt (car alist) -;; alist (cdr alist)) -;; (let ((buf (cdr elt))) -;; (if (buffer-name buf) -;; ;; Top level must match exactly against dired-directory in -;; ;; case one of them is a wildcard. -;; (if (or (equal dir (with-current-buffer buf dired-directory)) -;; (assoc dir (with-current-buffer buf dired-subdir-alist))) -;; (setq result (cons buf result))) -;; ;; else buffer is killed - clean up: -;; (setq dired-buffers (delq elt dired-buffers))))) -;; result)) - ;; Needed if ls -lh is supported and also for GNU ls -ls. (defun dired-x--string-to-number (str) @@ -1413,9 +1415,6 @@ sure that a trailing letter in STR is one of BKkMGTPEZY." (setq val (* 1024.0 val))))) val)) -;; Does anyone use this? - lrd 6/29/93. -;; Apparently people do use it. - lrd 12/22/97. - (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. @@ -1456,7 +1455,13 @@ refer at all to the underlying file system. Contrast this with ;; (string-match "foo" sym) into which a user would soon fall. ;; Give `equal' instead of `=' in the example, as this works on ;; integers and strings. - (interactive "xMark if (lisp expr): \nP") + (interactive + (list (read--expression + (format "%s if (lisp expr): " + (if current-prefix-arg + "UNmark" + "Mark"))) + current-prefix-arg)) (message "%s" predicate) (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)) inode s mode nlink uid gid size time name sym) diff --git a/lisp/dired.el b/lisp/dired.el index 6c7445c3486..468060439b8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -255,6 +255,18 @@ new Dired buffers." :version "24.4" :group 'dired) +(defcustom dired-always-read-filesystem nil + "Non-nil means revert buffers visiting files before searching them. + By default, commands like `dired-mark-files-containing-regexp' will + search any buffers visiting the marked files without reverting them, + even if they were changed on disk. When this option is non-nil, such + buffers are always reverted in a temporary buffer before searching + them: the search is performed on the temporary buffer, the original + buffer visiting the file is not modified." + :type 'boolean + :version "26.1" + :group 'dired) + ;; Internal variables (defvar dired-marker-char ?* ; the answer is 42 @@ -303,7 +315,7 @@ The directory name must be absolute, but need not be fully expanded.") (put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p) -(defvar dired-re-inode-size "[0-9 \t]*" +(defvar dired-re-inode-size "[0-9 \t]*[.,0-9]*[BkKMGTPEZY]?[ \t]*" "Regexp for optional initial inode and file size as made by `ls -i -s'.") ;; These regexps must be tested at beginning-of-line, but are also @@ -1833,11 +1845,11 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." '("--")) (define-key map [menu-bar operate query-replace] - '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp - :help "Replace regexp in marked files")) + '(menu-item "Query Replace in Files..." dired-do-find-regexp-and-replace + :help "Replace regexp matches in marked files")) (define-key map [menu-bar operate search] - '(menu-item "Search Files..." dired-do-search - :help "Search marked files for regexp")) + '(menu-item "Search Files..." dired-do-find-regexp + :help "Search marked files for matches of regexp")) (define-key map [menu-bar operate isearch-regexp] '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp :help "Incrementally search marked files for regexp")) @@ -2455,10 +2467,11 @@ You can then feed the file name(s) to other commands with \\[yank]." 'no-dir (prefix-numeric-value arg)))) (dired-get-marked-files 'no-dir)) " ")))) - (if (eq last-command 'kill-region) - (kill-append string nil) - (kill-new string)) - (message "%s" string))) + (unless (string= string "") + (if (eq last-command 'kill-region) + (kill-append string nil) + (kill-new string)) + (message "%s" string)))) ;; Keeping Dired buffers in sync with the filesystem and with each other @@ -2740,9 +2753,18 @@ instead of `dired-actual-switches'." (save-excursion (goto-char (point-min)) (dired-goto-file-1 file file (point-max))) - ;; Otherwise, look for it as a relative name. The - ;; hair is to get the result of `dired-goto-subdir' - ;; without calling it if we don't have any subdirs. + ;; Next, look for it as a relative name with leading + ;; subdirectories. (This happens in Dired buffers + ;; created by find-dired, for example.) + (save-excursion + (goto-char (point-min)) + (dired-goto-file-1 (file-relative-name file + default-directory) + file (point-max))) + ;; Otherwise, look for it as a relative name, a base + ;; name only. The hair is to get the result of + ;; `dired-goto-subdir' without calling it if we don't + ;; have any subdirs. (save-excursion (when (if (string= dir (expand-file-name default-directory)) (goto-char (point-min)) @@ -3291,7 +3313,7 @@ is one line. If the region is active in Transient Mark mode, unmark all files in the active region." (interactive "p") - (dired-unmark (- arg))) + (dired-unmark (- arg) t)) (defun dired-toggle-marks () "Toggle marks: marked files become unmarked, and vice versa. @@ -3348,7 +3370,13 @@ object files--just `.o' will mark more than you might think." (defun dired-mark-files-containing-regexp (regexp &optional marker-char) "Mark all files with contents containing REGEXP for use in later commands. A prefix argument means to unmark them instead. -`.' and `..' are never marked." +`.' and `..' are never marked. + +Note that if a file is visited in an Emacs buffer, and +`dired-always-read-filesystem' is nil, this command will +look in the buffer without revisiting the file, so the results might +be inconsistent with the file on disk if its contents has changed +since it was last visited." (interactive (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files containing (regexp): ") @@ -3365,7 +3393,7 @@ A prefix argument means to unmark them instead. (message "Checking %s" fn) ;; For now we do it inside emacs ;; Grep might be better if there are a lot of files - (if prebuf + (if (and prebuf (not dired-always-read-filesystem)) (with-current-buffer prebuf (save-excursion (goto-char (point-min)) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 9d912c3f6d9..223565cedb6 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -626,7 +626,7 @@ at the bottom edge of the page moves to the next page." (image-bob) (image-bol 1)) (set-window-hscroll (selected-window) hscroll))) - (image-next-line 1))) + (image-next-line arg))) (defun doc-view-previous-line-or-previous-page (&optional arg) "Scroll downward by ARG lines if possible, else goto previous page. diff --git a/lisp/dom.el b/lisp/dom.el index 03fe75975a4..9f5e177e986 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -1,4 +1,4 @@ -;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions +;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions -*- lexical-binding: t -*- ;; Copyright (C) 2014-2016 Free Software Foundation, Inc. @@ -139,6 +139,16 @@ ATTRIBUTE would typically be `class', `id' or the like." (cons dom matches) matches))) +(defun dom-remove-node (dom node) + "Remove NODE from DOM." + ;; If we're removing the top level node, just return nil. + (dolist (child (dom-children dom)) + (cond + ((eq node child) + (delq node dom)) + ((not (stringp child)) + (dom-remove-node child node))))) + (defun dom-parent (dom node) "Return the parent of NODE in DOM." (if (memq node (dom-children dom)) @@ -151,6 +161,7 @@ ATTRIBUTE would typically be `class', `id' or the like." result))) (defun dom-previous-sibling (dom node) + "Return the previous sibling of NODE in DOM." (when-let (parent (dom-parent dom node)) (let ((siblings (dom-children parent)) (previous nil)) diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 5536f946dc3..74a9dd542d1 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -55,6 +55,8 @@ (define-key map "\177" 'Buffer-menu-backup-unmark) (define-key map "~" 'Buffer-menu-not-modified) (define-key map "u" 'Buffer-menu-unmark) + (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers) + (define-key map "U" 'Buffer-menu-unmark-all) (let ((i ?0)) (while (<= i ?9) (define-key map (char-to-string i) 'digit-argument) @@ -114,6 +116,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. \\[Buffer-menu-save] -- mark that buffer to be saved. \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. \\[Buffer-menu-unmark] -- remove all kinds of marks from current line. +\\[Buffer-menu-unmark-all] -- remove all kinds of marks from all lines. \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. \\[Buffer-menu-backup-unmark] -- back up a line and remove marks." (interactive "P") diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index cb50cce6056..b9f4b1ab846 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -32,7 +32,7 @@ :group 'mail) (defcustom ecomplete-database-file "~/.ecompleterc" - "*The name of the file to store the ecomplete data." + "The name of the file to store the ecomplete data." :group 'ecomplete :type 'file) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 116292027cd..47d44b1cfcc 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -28,7 +28,9 @@ ;;; Electric pairing. (defcustom electric-pair-pairs - '((?\" . ?\")) + '((?\" . ?\") + ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) + ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) "Alist of pairs that should be used regardless of major mode. Pairs of delimiters in this list are a fallback in case they have @@ -42,7 +44,9 @@ See also the variable `electric-pair-text-pairs'." ;;;###autoload (defcustom electric-pair-text-pairs - '((?\" . ?\" )) + '((?\" . ?\" ) + ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) + ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) "Alist of pairs that should always be used in comments and strings. Pairs of delimiters in this list are a fallback in case they have diff --git a/lisp/electric.el b/lisp/electric.el index ab79943c9dd..3e48737e3ac 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -425,17 +425,24 @@ The variable `electric-layout-rules' says when and how to insert newlines." :version "25.1" :type 'boolean :safe 'booleanp :group 'electricity) +(defcustom electric-quote-chars '(?‘ ?’ ?“ ?”) + "Curved quote characters for `electric-quote-mode'. +This list's members correspond to left single quote, right single +quote, left double quote, and right double quote, respectively." + :version "26.1" + :type '(list character character character character) + :safe #'(lambda (x) + (pcase x + (`(,(pred characterp) ,(pred characterp) + ,(pred characterp) ,(pred characterp)) + t))) + :group 'electricity) + (defcustom electric-quote-paragraph t "Non-nil means to use electric quoting in text paragraphs." :version "25.1" :type 'boolean :safe 'booleanp :group 'electricity) -(defun electric--insertable-p (string) - (or (not buffer-file-coding-system) - (eq (coding-system-base buffer-file-coding-system) 'undecided) - (not (unencodable-char-position nil nil buffer-file-coding-system - nil string)))) - (defun electric-quote-post-self-insert-function () "Function that `electric-quote-mode' adds to `post-self-insert-hook'. This requotes when a quoting key is typed." @@ -444,38 +451,41 @@ This requotes when a quoting key is typed." (let ((start (if (and comment-start comment-use-syntax) (when (or electric-quote-comment electric-quote-string) - (let ((syntax (syntax-ppss))) - (and (or (and electric-quote-comment (nth 4 syntax)) + (let* ((syntax (syntax-ppss)) + (beg (nth 8 syntax))) + (and beg + (or (and electric-quote-comment (nth 4 syntax)) (and electric-quote-string (nth 3 syntax))) - (nth 8 syntax)))) + ;; Do not requote a quote that starts or ends + ;; a comment or string. + (eq beg (nth 8 (save-excursion + (syntax-ppss (1- (point))))))))) (and electric-quote-paragraph (derived-mode-p 'text-mode) (or (eq last-command-event ?\`) (save-excursion (backward-paragraph) (point))))))) - (when start - (save-excursion - (if (eq last-command-event ?\`) - (cond ((and (electric--insertable-p "“") - (search-backward "‘`" (- (point) 2) t)) - (replace-match "“") - (when (and electric-pair-mode - (eq (cdr-safe - (assq ?‘ electric-pair-text-pairs)) - (char-after))) - (delete-char 1)) - (setq last-command-event ?“)) - ((and (electric--insertable-p "‘") - (search-backward "`" (1- (point)) t)) - (replace-match "‘") - (setq last-command-event ?‘))) - (cond ((and (electric--insertable-p "”") - (search-backward "’'" (- (point) 2) t)) - (replace-match "”") - (setq last-command-event ?”)) - ((and (electric--insertable-p "’") - (search-backward "'" (1- (point)) t)) - (replace-match "’") - (setq last-command-event ?’))))))))) + (pcase electric-quote-chars + (`(,q< ,q> ,q<< ,q>>) + (when start + (save-excursion + (if (eq last-command-event ?\`) + (cond ((search-backward (string q< ?`) (- (point) 2) t) + (replace-match (string q<<)) + (when (and electric-pair-mode + (eq (cdr-safe + (assq q< electric-pair-text-pairs)) + (char-after))) + (delete-char 1)) + (setq last-command-event q<<)) + ((search-backward "`" (1- (point)) t) + (replace-match (string q<)) + (setq last-command-event q<))) + (cond ((search-backward (string q> ?') (- (point) 2) t) + (replace-match (string q>>)) + (setq last-command-event q>>)) + ((search-backward "'" (1- (point)) t) + (replace-match (string q>)) + (setq last-command-event q>))))))))))) (put 'electric-quote-post-self-insert-function 'priority 10) @@ -486,12 +496,15 @@ With a prefix argument ARG, enable Electric Quote mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -When enabled, as you type this replaces \\=` with \\=‘, \\=' with \\=’, +When enabled, as you type this replaces \\=` with ‘, \\=' with ’, \\=`\\=` with “, and \\='\\=' with ”. This occurs only in comments, strings, and text paragraphs, and these are selectively controlled with `electric-quote-comment', `electric-quote-string', and `electric-quote-paragraph'. +Customize `electric-quote-chars' to use characters other than the +ones listed here. + This is a global minor mode. To toggle the mode in a single buffer, use `electric-quote-local-mode'." :global t :group 'electricity diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index ea01253d1ea..c0da59c81cb 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1832,7 +1832,7 @@ Redefining advices affect the construction of an advised definition." ;; @@ Interactive input functions: ;; =============================== -(declare-function 'function-called-at-point "help") +(declare-function function-called-at-point "help") (defun ad-read-advised-function (&optional prompt predicate default) "Read name of advised function with completion from the minibuffer. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1b06fb6a51d..1292ea992d3 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -87,6 +87,12 @@ that text will be copied verbatim to `generated-autoload-file'.") (defconst generate-autoload-section-continuation ";;;;;; " "String to add on each continuation of the section header form.") +;; In some ways it would be nicer to use a value that is recognizably +;; not a time-value, eg t, but that can cause issues if an older Emacs +;; that does not expect non-time-values loads the file. +(defconst autoload--non-timestamp '(0 0 0 0) + "Value to insert when `autoload-timestamps' is nil.") + (defvar autoload-timestamps nil ; experimental, see bug#22213 "Non-nil means insert a timestamp for each input file into the output. We use these in incremental updates of the output file to decide @@ -177,10 +183,12 @@ expression, in which case we want to handle forms differently." (args (pcase car ((or `defun `defmacro `defun* `defmacro* `cl-defun `cl-defmacro - `define-overloadable-function) (nth 2 form)) + `define-overloadable-function) + (nth 2 form)) (`define-skeleton '(&optional str arg)) ((or `define-generic-mode `define-derived-mode - `define-compilation-mode) nil) + `define-compilation-mode) + nil) (_ t))) (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) (doc (if (stringp (car body)) (pop body)))) @@ -196,7 +204,8 @@ expression, in which case we want to handle forms differently." define-global-minor-mode define-globalized-minor-mode easy-mmode-define-minor-mode - define-minor-mode)) t) + define-minor-mode)) + t) (eq (car-safe (car body)) 'interactive)) ,(if macrop ''macro nil)))) @@ -251,9 +260,22 @@ If a buffer is visiting the desired autoload file, return it." (enable-local-eval nil)) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. - (let ((delay-mode-hooks t)) - (find-file-noselect - (autoload-ensure-default-file (autoload-generated-file)))))) + (let* ((delay-mode-hooks t) + (file (autoload-generated-file)) + (file-missing (not (file-exists-p file)))) + (when file-missing + (autoload-ensure-default-file file)) + (with-current-buffer + (find-file-noselect + (autoload-ensure-file-writeable + file)) + ;; block backups when the file has just been created, since + ;; the backups will just be the auto-generated headers. + ;; bug#23203 + (when file-missing + (setq buffer-backed-up t) + (save-buffer)) + (current-buffer))))) (defun autoload-generated-file () (expand-file-name generated-autoload-file @@ -294,7 +316,7 @@ The variable `autoload-print-form-outbuf' specifies the buffer to put the output in." (cond ;; If the form is a sequence, recurse. - ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form))) + ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form))) ;; Symbols at the toplevel are meaningless. ((symbolp form) nil) (t @@ -374,25 +396,36 @@ not be relied upon." ;;;###autoload (put 'autoload-ensure-writable 'risky-local-variable t) +(defun autoload-ensure-file-writeable (file) + ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, + ;; which was designed to handle CVSREAD=1 and equivalent. + (and autoload-ensure-writable + (let ((modes (file-modes file))) + (if (zerop (logand modes #o0200)) + ;; Ignore any errors here, and let subsequent attempts + ;; to write the file raise any real error. + (ignore-errors (set-file-modes file (logior modes #o0200)))))) + file) + (defun autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists, creating it if needed. If the file already exists and `autoload-ensure-writable' is non-nil, make it writable." - (if (file-exists-p file) - ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, - ;; which was designed to handle CVSREAD=1 and equivalent. - (and autoload-ensure-writable - (let ((modes (file-modes file))) - (if (zerop (logand modes #o0200)) - ;; Ignore any errors here, and let subsequent attempts - ;; to write the file raise any real error. - (ignore-errors (set-file-modes file (logior modes #o0200)))))) - (write-region (autoload-rubric file) nil file)) - file) + (write-region (autoload-rubric file) nil file)) (defun autoload-insert-section-header (outbuf autoloads load-name file time) "Insert the section-header line, which lists the file name and which functions are in it, etc." + ;; (cl-assert ;Make sure we don't insert it in the middle of another section. + ;; (save-excursion + ;; (or (not (re-search-backward + ;; (concat "\\(" + ;; (regexp-quote generate-autoload-section-header) + ;; "\\)\\|\\(" + ;; (regexp-quote generate-autoload-section-trailer) + ;; "\\)") + ;; nil t)) + ;; (match-end 2)))) (insert generate-autoload-section-header) (prin1 `(autoloads ,autoloads ,load-name ,file ,time) outbuf) @@ -451,7 +484,7 @@ which lists the file name and which functions are in it, etc." ;; without checking its content. This makes it generate wrong load ;; names for cases like lisp/term which is not added to load-path. (setq dir (expand-file-name (pop names) dir))) - (t (setq name (mapconcat 'identity names "/"))))) + (t (setq name (mapconcat #'identity names "/"))))) (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) (substring name 0 (match-beginning 0)) name))) @@ -467,8 +500,116 @@ Return non-nil in the case where no autoloads were added at point." (let ((generated-autoload-file buffer-file-name)) (autoload-generate-file-autoloads file (current-buffer)))) -(defvar print-readably) - +(defvar autoload-compute-prefixes t + "If non-nil, autoload will add code to register the prefixes used in a file. +Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines +variables or functions that use \"foo-\" as prefix, that will not be registered. +But all other prefixes will be included.") + +(defconst autoload-def-prefixes-max-entries 5 + "Target length of the list of definition prefixes per file. +If set too small, the prefixes will be too generic (i.e. they'll use little +memory, we'll end up looking in too many files when we need a particular +prefix), and if set too large, they will be too specific (i.e. they will +cost more memory use).") + +(defconst autoload-def-prefixes-max-length 12 + "Target size of definition prefixes. +Don't try to split prefixes that are already longer than that.") + +(require 'radix-tree) + +(defun autoload--make-defs-autoload (defs file) + + ;; Remove the defs that obey the rule that file foo.el (or + ;; foo-mode.el) uses "foo-" as prefix. + ;; FIXME: help--symbol-completion-table still doesn't know how to use + ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix. + ;;(let ((prefix + ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-"))) + ;; (dolist (def (prog1 defs (setq defs nil))) + ;; (unless (string-prefix-p prefix def) + ;; (push def defs)))) + + ;; Then compute a small set of prefixes that cover all the + ;; remaining definitions. + (let* ((tree (let ((tree radix-tree-empty)) + (dolist (def defs) + (setq tree (radix-tree-insert tree def t))) + tree)) + (prefixes nil)) + ;; Get the root prefixes, that we should include in any case. + (radix-tree-iter-subtrees + tree (lambda (prefix subtree) + (push (cons prefix subtree) prefixes))) + ;; In some cases, the root prefixes are too short, e.g. if you define + ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. + (dolist (pair (prog1 prefixes (setq prefixes nil))) + (let ((s (car pair))) + (if (or (> (length s) 2) ;Long enough! + (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? + (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! + (push pair prefixes) ;Keep it as is. + (radix-tree-iter-subtrees + (cdr pair) (lambda (prefix subtree) + (push (cons (concat s prefix) subtree) prefixes)))))) + ;; FIXME: The expansions done below are mostly pointless, such as + ;; for `yenc', where we replace "yenc-" with an exhaustive list (5 + ;; elements). + ;; (while + ;; (let ((newprefixes nil) + ;; (changes nil)) + ;; (dolist (pair prefixes) + ;; (let ((prefix (car pair))) + ;; (if (or (> (length prefix) autoload-def-prefixes-max-length) + ;; (radix-tree-lookup (cdr pair) "")) + ;; ;; No point splitting it any further. + ;; (push pair newprefixes) + ;; (setq changes t) + ;; (radix-tree-iter-subtrees + ;; (cdr pair) (lambda (sprefix subtree) + ;; (push (cons (concat prefix sprefix) subtree) + ;; newprefixes)))))) + ;; (and changes + ;; (<= (length newprefixes) + ;; autoload-def-prefixes-max-entries) + ;; (let ((new nil) + ;; (old nil)) + ;; (dolist (pair prefixes) + ;; (unless (memq pair newprefixes) ;Not old + ;; (push pair old))) + ;; (dolist (pair newprefixes) + ;; (unless (memq pair prefixes) ;Not new + ;; (push pair new))) + ;; (cl-assert new) + ;; (message "Expanding %S to %S" + ;; (mapcar #'car old) (mapcar #'car new)) + ;; t) + ;; (setq prefixes newprefixes) + ;; (< (length prefixes) autoload-def-prefixes-max-entries)))) + + ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) + (when prefixes + (let ((strings + (mapcar + (lambda (x) + (let ((prefix (car x))) + (if (or (> (length prefix) 2) ;Long enough! + (string-match ".[[:punct:]]\\'" prefix)) + prefix + ;; Some packages really don't follow the rules. + ;; Drop the most egregious cases such as the + ;; one-letter prefixes. + (let ((dropped ())) + (radix-tree-iter-mappings + (cdr x) (lambda (s _) + (push (concat prefix s) dropped))) + (message "Not registering prefix \"%s\" from %s. Affects: %S" + prefix file dropped) + nil)))) + prefixes))) + `(if (fboundp 'register-definition-prefixes) + (register-definition-prefixes ,file ',(delq nil strings))))))) (defun autoload--setup-output (otherbuf outbuf absfile load-name) (let ((outbuf @@ -546,11 +687,11 @@ FILE's modification time." (let (load-name (print-length nil) (print-level nil) - (print-readably t) ; This does something in Lucid Emacs. (float-output-format nil) (visited (get-file-buffer file)) (otherbuf nil) (absfile (expand-file-name file)) + (defs '()) ;; nil until we found a cookie. output-start) (when @@ -595,27 +736,93 @@ FILE's modification time." package--builtin-versions)) (princ "\n"))))) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\f") - (cond - ((looking-at (regexp-quote generate-autoload-cookie)) - ;; If not done yet, figure out where to insert this text. - (unless output-start - (setq output-start (autoload--setup-output - otherbuf outbuf absfile load-name))) - (autoload--print-cookie-text output-start load-name file)) - ((looking-at ";") - ;; Don't read the comment. - (forward-line 1)) - (t - (forward-sexp 1) - (forward-line 1)))))) + ;; Do not insert autoload entries for excluded files. + (unless (member absfile autoload-excludes) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n\f") + (cond + ((looking-at (regexp-quote generate-autoload-cookie)) + ;; If not done yet, figure out where to insert this text. + (unless output-start + (setq output-start (autoload--setup-output + otherbuf outbuf absfile load-name))) + (autoload--print-cookie-text output-start load-name file)) + ((looking-at ";") + ;; Don't read the comment. + (forward-line 1)) + (t + ;; Avoid (defvar <foo>) by requiring a trailing space. + ;; Also, ignore this prefix business + ;; for ;;;###tramp-autoload and friends. + (when (and (equal generate-autoload-cookie ";;;###autoload") + (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]") + (not (member + (match-string 1) + '("define-obsolete-function-alias" + "define-obsolete-variable-alias" + "define-category" "define-key" + "defgroup" "defface" "defadvice" + "def-edebug-spec" + ;; Hmm... this is getting ugly: + "define-widget" + "define-erc-response-handler" + "defun-rcirc-command")))) + (push (match-string 2) defs)) + (forward-sexp 1) + (forward-line 1))))))) + + (when (and autoload-compute-prefixes defs) + ;; This output needs to always go in the main loaddefs.el, + ;; regardless of generated-autoload-file. + ;; FIXME: the files that don't have autoload cookies but + ;; do have definitions end up listed twice in loaddefs.el: + ;; once for their register-definition-prefixes and once in + ;; the list of "files without any autoloads". + (let ((form (autoload--make-defs-autoload defs load-name))) + (cond + ((null form)) ;All defs obey the default rule, yay! + ((not otherbuf) + (unless output-start + (setq output-start (autoload--setup-output + nil outbuf absfile load-name))) + (let ((autoload-print-form-outbuf + (marker-buffer output-start))) + (autoload-print-form form))) + (t + (let* ((other-output-start + ;; To force the output to go to the main loaddefs.el + ;; rather than to generated-autoload-file, + ;; there are two cases: if outbuf is non-nil, + ;; then passing otherbuf=nil is enough, but if + ;; outbuf is nil, that won't cut it, so we + ;; locally bind generated-autoload-file. + (let ((generated-autoload-file + (default-value 'generated-autoload-file))) + (autoload--setup-output nil outbuf absfile load-name))) + (autoload-print-form-outbuf + (marker-buffer other-output-start))) + (autoload-print-form form) + (with-current-buffer (marker-buffer other-output-start) + (save-excursion + ;; Insert the section-header line which lists + ;; the file name and which functions are in it, etc. + (goto-char other-output-start) + (let ((relfile (file-relative-name absfile))) + (autoload-insert-section-header + (marker-buffer other-output-start) + "actual autoloads are elsewhere" load-name relfile + (if autoload-timestamps + (nth 5 (file-attributes absfile)) + autoload--non-timestamp)) + (insert ";;; Generated autoloads from " relfile "\n"))) + (insert generate-autoload-section-trailer))))))) (when output-start (let ((secondary-autoloads-file-buf (if otherbuf (current-buffer)))) (with-current-buffer (marker-buffer output-start) + (cl-assert (> (point) output-start)) (save-excursion ;; Insert the section-header line which lists the file name ;; and which functions are in it, etc. @@ -643,7 +850,7 @@ FILE's modification time." nil nil 'emacs-mule-unix) (if autoload-timestamps (nth 5 (file-attributes relfile)) - t))) + autoload--non-timestamp))) (insert ";;; Generated autoloads from " relfile "\n"))) (insert generate-autoload-section-trailer)))) (or noninteractive @@ -741,11 +948,6 @@ removes any prior now out-of-date autoload entries." (if (and (or (null existing-buffer) (not (buffer-modified-p existing-buffer))) (cond - ;; last-time is the time-stamp (specifying - ;; the last time we looked at the file) and - ;; the file hasn't been changed since. - ((listp last-time) - (not (time-less-p last-time file-time))) ;; FIXME? Arguably we should throw a ;; user error, or some kind of warning, ;; if we were called from update-file-autoloads, @@ -754,8 +956,15 @@ removes any prior now out-of-date autoload entries." ;; file modtime in such a case, ;; if there are multiple input files ;; contributing to the output. - ((and output-time (eq t last-time)) + ((and output-time + (member last-time + (list t autoload--non-timestamp))) (not (time-less-p output-time file-time))) + ;; last-time is the time-stamp (specifying + ;; the last time we looked at the file) and + ;; the file hasn't been changed since. + ((listp last-time) + (not (time-less-p last-time file-time))) ;; last-time is an MD5 checksum instead. ((stringp last-time) (equal last-time @@ -803,14 +1012,20 @@ write its autoloads into the specified file instead." (interactive "DUpdate autoloads from directory: ") (let* ((files-re (let ((tmp nil)) (dolist (suf (get-load-suffixes)) - (unless (string-match "\\.elc" suf) (push suf tmp))) + ;; We don't use module-file-suffix below because + ;; we don't want to depend on whether Emacs was + ;; built with or without modules support, nor + ;; what is the suffix for the underlying OS. + (unless (string-match "\\.\\(elc\\|\\so\\|dll\\)" suf) + (push suf tmp))) (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))) - (files (apply 'nconc + (files (apply #'nconc (mapcar (lambda (dir) (directory-files (expand-file-name dir) t files-re)) dirs))) - (done ()) + (done ()) ;Files processed; to remove duplicates. + (changed nil) ;Non-nil if some change occurred. (last-time) ;; Files with no autoload cookies or whose autoloads go to other ;; files because of file-local autoload-generated-file settings. @@ -828,7 +1043,7 @@ write its autoloads into the specified file instead." (save-excursion ;; Canonicalize file names and remove the autoload file itself. (setq files (delete (file-relative-name buffer-file-name) - (mapcar 'file-relative-name files))) + (mapcar #'file-relative-name files))) (goto-char (point-min)) (while (search-forward generate-autoload-section-header nil t) @@ -840,7 +1055,7 @@ write its autoloads into the specified file instead." ;; Remove the obsolete section. (autoload-remove-section (match-beginning 0)) (setq last-time (nth 4 form)) - (if (equal t last-time) + (if (member last-time (list t autoload--non-timestamp)) (setq last-time output-time)) (dolist (file file) (let ((file-time (nth 5 (file-attributes file)))) @@ -852,19 +1067,21 @@ write its autoloads into the specified file instead." ((not (stringp file))) ((or (not (file-exists-p file)) ;; Remove duplicates as well, just in case. - (member file done) - ;; If the file is actually excluded. - (member (expand-file-name file) autoload-excludes)) + (member file done)) ;; Remove the obsolete section. + (setq changed t) (autoload-remove-section (match-beginning 0))) ((not (time-less-p (let ((oldtime (nth 4 form))) - (if (equal t oldtime) + (if (member oldtime + (list + t autoload--non-timestamp)) output-time oldtime)) (nth 5 (file-attributes file)))) ;; File hasn't changed. nil) (t + (setq changed t) (autoload-remove-section (match-beginning 0)) (if (autoload-generate-file-autoloads ;; Passing `current-buffer' makes it insert at point. @@ -876,7 +1093,6 @@ write its autoloads into the specified file instead." (let ((no-autoloads-time (or last-time '(0 0 0 0))) file-time) (dolist (file files) (cond - ((member (expand-file-name file) autoload-excludes) nil) ;; Passing nil as second argument forces ;; autoload-generate-file-autoloads to look for the right ;; spot where to insert each autoloads section. @@ -884,7 +1100,8 @@ write its autoloads into the specified file instead." (autoload-generate-file-autoloads file nil buffer-file-name)) (push file no-autoloads) (if (time-less-p no-autoloads-time file-time) - (setq no-autoloads-time file-time))))) + (setq no-autoloads-time file-time))) + (t (setq changed t)))) (when no-autoloads ;; Sort them for better readability. @@ -895,11 +1112,16 @@ write its autoloads into the specified file instead." (autoload-insert-section-header (current-buffer) nil nil no-autoloads (if autoload-timestamps no-autoloads-time - t)) + autoload--non-timestamp)) (insert generate-autoload-section-trailer))) - (let ((version-control 'never)) - (save-buffer)) + ;; Don't modify the file if its content has not been changed, so `make' + ;; dependencies don't trigger unnecessarily. + (if (not changed) + (set-buffer-modified-p nil) + (let ((version-control 'never)) + (save-buffer))) + ;; In case autoload entries were added to other files because of ;; file-local autoload-generated-file settings. (autoload-save-buffers)))) @@ -931,7 +1153,7 @@ should be non-nil)." (push (expand-file-name file) autoload-excludes))))))) (let ((args command-line-args-left)) (setq command-line-args-left nil) - (apply 'update-directory-autoloads args))) + (apply #'update-directory-autoloads args))) (provide 'autoload) diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 74d8e593bc9..707d1cbd1ff 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -98,7 +98,8 @@ ;; avl-tree-right avl-tree-data] branch) node) "Get value of a branch of a node. NODE is the node, and BRANCH is the branch. -0 for left pointer, 1 for right pointer and 2 for the data.") +0 for left pointer, 1 for right pointer and 2 for the data. +\n(fn BRANCH NODE)") ;; The funcall/aref trick wouldn't work for the setf method, unless we @@ -400,7 +401,8 @@ itself." reverse store) (defalias 'avl-tree-stack-p #'avl-tree--stack-p - "Return t if argument is an avl-tree-stack, nil otherwise.") + "Return t if OBJ is an avl-tree-stack, nil otherwise. +\n(fn OBJ)") (defun avl-tree--stack-repopulate (stack) ;; Recursively push children of the node at the head of STACK onto the @@ -419,12 +421,12 @@ itself." (defalias 'avl-tree-create #'avl-tree--create "Create an empty AVL tree. COMPARE-FUNCTION is a function which takes two arguments, A and B, -and returns non-nil if A is less than B, and nil otherwise.") +and returns non-nil if A is less than B, and nil otherwise. +\n(fn COMPARE-FUNCTION)") (defalias 'avl-tree-compare-function #'avl-tree--cmpfun "Return the comparison function for the AVL tree TREE. - -\(fn TREE)") +\n(fn TREE)") (defun avl-tree-empty (tree) "Return t if AVL tree TREE is empty, otherwise return nil." diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b3bf4a58849..610c3b6c190 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -288,8 +288,8 @@ (if (eq (car-safe newfn) 'function) (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) ;; This can happen because of macroexp-warn-and-return &co. - (byte-compile-log-warning - (format "Inlining closure %S failed" name)) + (byte-compile-warn + "Inlining closure %S failed" name) form)))) (_ ;; Give up on inlining. @@ -1209,8 +1209,9 @@ radians-to-degrees rassq rassoc read-from-string regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring sxhash symbol-function - symbol-name symbol-plist symbol-value string-make-unibyte + string-to-int string-to-number substring + sxhash sxhash-equal sxhash-eq sxhash-eql + symbol-function symbol-name symbol-plist symbol-value string-make-unibyte string-make-multibyte string-as-multibyte string-as-unibyte string-to-multibyte tan truncate diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 83cb7e70f37..818c2683463 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -362,6 +362,9 @@ is equivalent to the following two lines of code: \(defalias \\='old-fun \\='new-fun \"old-fun's doc.\") \(make-obsolete \\='old-fun \\='new-fun \"22.1\") +If provided, WHEN should be a string indicating when the function +was first made obsolete, for example a date or a release number. + See the docstrings of `defalias' and `make-obsolete' for more details." (declare (doc-string 4) (advertised-calling-convention @@ -404,6 +407,9 @@ dumped with Emacs). This is so that any user customizations are applied before the defcustom tries to initialize the variable (this is due to the way `defvaralias' works). +If provided, WHEN should be a string indicating when the variable +was first made obsolete, for example a date or a release number. + For the benefit of `custom-set-variables', if OBSOLETE-NAME has any of the following properties, they are copied to CURRENT-NAME, if it does not already have them: @@ -428,8 +434,8 @@ CURRENT-NAME, if it does not already have them: ;; It only really affects M-x describe-face output. (defmacro define-obsolete-face-alias (obsolete-face current-face when) "Make OBSOLETE-FACE a face alias for CURRENT-FACE and mark it obsolete. -The string WHEN gives the Emacs version where OBSOLETE-FACE became -obsolete." +If provided, WHEN should be a string indicating when the face +was first made obsolete, for example a date or a release number." `(progn (put ,obsolete-face 'face-alias ,current-face) ;; Used by M-x describe-face. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 11eb44cea31..85daa43eaed 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1022,39 +1022,42 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (setcdr list (cddr list))) total))) -;; The purpose of this function is to iterate through the -;; `read-symbol-positions-list'. Each time we process, say, a -;; function definition (`defun') we remove `defun' from -;; `read-symbol-positions-list', and set `byte-compile-last-position' -;; to that symbol's character position. Similarly, if we encounter a -;; variable reference, like in (1+ foo), we remove `foo' from the -;; list. If our current position is after the symbol's position, we -;; assume we've already passed that point, and look for the next -;; occurrence of the symbol. +;; The purpose of `byte-compile-set-symbol-position' is to attempt to +;; set `byte-compile-last-position' to the "current position" in the +;; raw source code. This is used for warning and error messages. ;; -;; This function should not be called twice for the same occurrence of -;; a symbol, and it should not be called for symbols generated by the -;; byte compiler itself; because rather than just fail looking up the -;; symbol, we may find an occurrence of the symbol further ahead, and -;; then `byte-compile-last-position' as advanced too far. +;; The function should be called for most occurrences of symbols in +;; the forms being compiled, strictly in the order they occur in the +;; source code. It should never be called twice for any single +;; occurrence, and should not be called for symbols generated by the +;; byte compiler itself. ;; -;; So your're probably asking yourself: Isn't this function a -;; gross hack? And the answer, of course, would be yes. +;; The function works by scanning the elements in the alist +;; `read-symbol-positions-list' for the next match for the symbol +;; after the current value of `byte-compile-last-position', setting +;; that variable to the match's character position, then deleting the +;; matching element from the list. Thus the new value for +;; `byte-compile-last-position' is later than the old value unless, +;; perhaps, ALLOW-PREVIOUS is non-nil. +;; +;; So your're probably asking yourself: Isn't this function a gross +;; hack? And the answer, of course, would be yes. (defun byte-compile-set-symbol-position (sym &optional allow-previous) (when byte-compile-read-position - (let (last entry) + (let ((last byte-compile-last-position) + entry) (while (progn - (setq last byte-compile-last-position - entry (assq sym read-symbol-positions-list)) + (setq entry (assq sym read-symbol-positions-list)) (when entry (setq byte-compile-last-position (+ byte-compile-read-position (cdr entry)) read-symbol-positions-list (byte-compile-delete-first entry read-symbol-positions-list))) - (or (and allow-previous - (not (= last byte-compile-last-position))) - (> last byte-compile-last-position))))))) + (and entry + (or (and allow-previous + (not (= last byte-compile-last-position))) + (> last byte-compile-last-position)))))))) (defvar byte-compile-last-warned-form nil) (defvar byte-compile-last-logged-file nil) @@ -1160,9 +1163,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (compilation-forget-errors) pt)))) -;; Log a message STRING in `byte-compile-log-buffer'. -;; Also log the current function and file if not already done. (defun byte-compile-log-warning (string &optional fill level) + "Log a message STRING in `byte-compile-log-buffer'. +Also log the current function and file if not already done. If +FILL is non-nil, set `warning-fill-prefix' to four spaces. LEVEL +is the warning level (`:warning' or `:error'). Do not call this +function directly; use `byte-compile-warn' or +`byte-compile-report-error' instead." (let ((warning-prefix-function 'byte-compile-warning-prefix) (warning-type-format "") (warning-fill-prefix (if fill " "))) @@ -1186,15 +1193,16 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs)) (byte-compile-warn "%s" msg))))) -(defun byte-compile-report-error (error-info) +(defun byte-compile-report-error (error-info &optional fill) "Report Lisp error in compilation. ERROR-INFO is the error data, in the form of either (ERROR-SYMBOL . DATA) -or STRING." +or STRING. If FILL is non-nil, set ‘warning-fill-prefix’ to four spaces +when printing the error message." (setq byte-compiler-error-flag t) (byte-compile-log-warning (if (stringp error-info) error-info (error-message-string error-info)) - nil :error)) + fill :error)) ;;; sanity-checking arglists @@ -1279,6 +1287,7 @@ or STRING." (t (format "%d-%d" (car signature) (cdr signature))))) (defun byte-compile-function-warn (f nargs def) + (byte-compile-set-symbol-position f) (when (get f 'byte-obsolete-info) (byte-compile-warn-obsolete f)) @@ -1883,12 +1892,13 @@ The value is non-nil if there were no errors, nil if errors." (rename-file tempfile target-file t) (or noninteractive (message "Wrote %s" target-file))) ;; This is just to give a better error message than write-region - (signal 'file-error - (list "Opening output file" - (if (file-exists-p target-file) - "Cannot overwrite file" - "Directory not writable or nonexistent") - target-file))) + (let ((exists (file-exists-p target-file))) + (signal (if exists 'file-error 'file-missing) + (list "Opening output file" + (if exists + "Cannot overwrite file" + "Directory not writable or nonexistent") + target-file)))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) @@ -2582,7 +2592,13 @@ FUN should be either a `lambda' value or a `closure' value." (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) `(closure ,env ,args . ,body)) fun) + (preamble nil) (renv ())) + ;; Split docstring and `interactive' form from body. + (when (stringp (car body)) + (push (pop body) preamble)) + (when (eq (car-safe (car body)) 'interactive) + (push (pop body) preamble)) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond @@ -2595,8 +2611,8 @@ FUN should be either a `lambda' value or a `closure' value." ((eq binding t)) (t (push `(defvar ,binding) body)))) (if (null renv) - `(lambda ,args ,@body) - `(lambda ,args (let ,(nreverse renv) ,@body))))) + `(lambda ,args ,@preamble ,@body) + `(lambda ,args ,@preamble (let ,(nreverse renv) ,@body))))) ;;;###autoload (defun byte-compile (form) @@ -2656,8 +2672,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (cddr list) (error "Garbage following &rest VAR in lambda-list"))) ((eq arg '&optional) - (unless (cdr list) - (error "Variable name missing after &optional"))) + (when (or (null (cdr list)) + (memq (cadr list) '(&optional &rest))) + (error "Variable name missing after &optional")) + (when (memq '&optional (cddr list)) + (error "Duplicate &optional"))) ((memq arg vars) (byte-compile-warn "repeated variable %s in lambda-list" arg)) (t @@ -2959,6 +2978,8 @@ for symbols generated by the byte compiler itself." ;; Special macro-expander used during byte-compilation. (defun byte-compile-macroexpand-declare-function (fn file &rest args) + (declare (advertised-calling-convention + (fn file &optional arglist fileonly) nil)) (let ((gotargs (and (consp args) (listp (car args)))) (unresolved (assq fn byte-compile-unresolved-functions))) (when unresolved ; function was called before declaration @@ -3017,9 +3038,8 @@ for symbols generated by the byte compiler itself." (pcase (cdr form) (`(',var . ,_) (when (assq var byte-compile-lexical-variables) - (byte-compile-log-warning - (format-message "%s cannot use lexical var `%s'" fn var) - nil :error))))) + (byte-compile-report-error + (format-message "%s cannot use lexical var `%s'" fn var)))))) (when (macroexp--const-symbol-p fn) (byte-compile-warn "`%s' called as a function" fn)) (when (and (byte-compile-warning-enabled-p 'interactive-only) @@ -3036,9 +3056,8 @@ for symbols generated by the byte compiler itself." interactive-only)) (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) - (byte-compile-log-warning - (format "Forgot to expand macro %s in %S" (car form) form) - nil :error)) + (byte-compile-report-error + (format "Forgot to expand macro %s in %S" (car form) form))) (if (and handler ;; Make sure that function exists. (and (functionp handler) @@ -3135,9 +3154,8 @@ for symbols generated by the byte compiler itself." (dotimes (_ (- (/ (1+ fmax2) 2) alen)) (byte-compile-push-constant nil))) ((zerop (logand fmax2 1)) - (byte-compile-log-warning - (format "Too many arguments for inlined function %S" form) - nil :error) + (byte-compile-report-error + (format "Too many arguments for inlined function %S" form)) (byte-compile-discard (- alen (/ fmax2 2)))) (t ;; Turn &rest args into a list. @@ -3747,10 +3765,9 @@ discarding." (len (length args))) (if (= (logand len 1) 1) (progn - (byte-compile-log-warning + (byte-compile-report-error (format-message - "missing value for `%S' at end of setq" (car (last args))) - nil :error) + "missing value for `%S' at end of setq" (car (last args)))) (byte-compile-form `(signal 'wrong-number-of-arguments '(setq ,len)) byte-compile--for-effect)) @@ -4020,8 +4037,8 @@ that suppresses all warnings during execution of BODY." (progn (mapc 'byte-compile-form (cdr form)) (byte-compile-out 'byte-call (length (cdr (cdr form))))) - (byte-compile-log-warning - (format-message "`funcall' called with no arguments") nil :error) + (byte-compile-report-error + (format-message "`funcall' called with no arguments")) (byte-compile-form '(signal 'wrong-number-of-arguments '(funcall 0)) byte-compile--for-effect))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 50b1fe32661..46b5a7f342c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -253,6 +253,32 @@ Returns a form where all lambdas don't have any free variables." `(internal-make-closure ,args ,envector ,docstring . ,body-new))))) +(defun cconv--remap-llv (new-env var closedsym) + ;; In a case such as: + ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) + ;; A naive lambda-lifting would return + ;; (let* ((fun (lambda (y x) (+ x y))) (y 1)) (funcall fun y 1)) + ;; Where the external `y' is mistakenly captured by the inner one. + ;; So when we detect that case, we rewrite it to: + ;; (let* ((closed-y y) (fun (lambda (y x) (+ x y))) (y 1)) + ;; (funcall fun closed-y 1)) + ;; We do that even if there's no `funcall' that uses `fun' in the scope + ;; where `y' is shadowed by another variable because, to treat + ;; this case better, we'd need to traverse the tree one more time to + ;; collect this data, and I think that it's not worth it. + (mapcar (lambda (mapping) + (if (not (eq (cadr mapping) 'apply-partially)) + mapping + (cl-assert (eq (car mapping) (nth 2 mapping))) + `(,(car mapping) + apply-partially + ,(car mapping) + ,@(mapcar (lambda (arg) + (if (eq var arg) + closedsym arg)) + (nthcdr 3 mapping))))) + new-env)) + (defun cconv-convert (form env extend) ;; This function actually rewrites the tree. "Return FORM with all its lambdas changed so they are closed. @@ -299,9 +325,9 @@ places where they originally did not directly appear." (var (if (not (consp binder)) (prog1 binder (setq binder (list binder))) (when (cddr binder) - (byte-compile-log-warning - (format-message "Malformed `%S' binding: %S" - letsym binder))) + (byte-compile-warn + "Malformed `%S' binding: %S" + letsym binder)) (setq value (cadr binder)) (car binder))) (new-val @@ -350,34 +376,13 @@ places where they originally did not directly appear." (if (assq var new-env) (push `(,var) new-env)) (cconv-convert value env extend))))) - ;; The piece of code below letbinds free variables of a λ-lifted - ;; function if they are redefined in this let, example: - ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) - ;; Here we can not pass y as parameter because it is redefined. - ;; So we add a (closed-y y) declaration. We do that even if the - ;; function is not used inside this let(*). The reason why we - ;; ignore this case is that we can't "look forward" to see if the - ;; function is called there or not. To treat this case better we'd - ;; need to traverse the tree one more time to collect this data, and - ;; I think that it's not worth it. - (when (memq var new-extend) - (let ((closedsym - (make-symbol (concat "closed-" (symbol-name var))))) - (setq new-env - (mapcar (lambda (mapping) - (if (not (eq (cadr mapping) 'apply-partially)) - mapping - (cl-assert (eq (car mapping) (nth 2 mapping))) - `(,(car mapping) - apply-partially - ,(car mapping) - ,@(mapcar (lambda (arg) - (if (eq var arg) - closedsym arg)) - (nthcdr 3 mapping))))) - new-env)) - (setq new-extend (remq var new-extend)) - (push closedsym new-extend) + (when (and (eq letsym 'let*) (memq var new-extend)) + ;; One of the lambda-lifted vars is shadowed, so add + ;; a reference to the outside binding and arrange to use + ;; that reference. + (let ((closedsym (make-symbol (format "closed-%s" var)))) + (setq new-env (cconv--remap-llv new-env var closedsym)) + (setq new-extend (cons closedsym (remq var new-extend))) (push `(,closedsym ,var) binders-new))) ;; We push the element after redefined free variables are @@ -390,6 +395,21 @@ places where they originally did not directly appear." (setq extend new-extend)) )) ; end of dolist over binders + (when (not (eq letsym 'let*)) + ;; We can't do the cconv--remap-llv at the same place for let and + ;; let* because in the case of `let', the shadowing may occur + ;; before we know that the var will be in `new-extend' (bug#24171). + (dolist (binder binders-new) + (when (memq (car-safe binder) new-extend) + ;; One of the lambda-lifted vars is shadowed, so add + ;; a reference to the outside binding and arrange to use + ;; that reference. + (let* ((var (car-safe binder)) + (closedsym (make-symbol (format "closed-%s" var)))) + (setq new-env (cconv--remap-llv new-env var closedsym)) + (setq new-extend (cons closedsym (remq var new-extend))) + (push `(,closedsym ,var) binders-new))))) + `(,letsym ,(nreverse binders-new) . ,(mapcar (lambda (form) (cconv-convert @@ -548,8 +568,8 @@ FORM is the parent form that binds this var." (`(,_ nil nil nil nil) nil) (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) ,_ ,_ ,_ ,_) - (byte-compile-log-warning - (format-message "%s `%S' not left unused" varkind var)))) + (byte-compile-warn + "%s `%S' not left unused" varkind var))) (pcase vardata (`((,var . ,_) nil ,_ ,_ nil) ;; FIXME: This gives warnings in the wrong order, with imprecise line @@ -561,8 +581,8 @@ FORM is the parent form that binds this var." (eq ?_ (aref (symbol-name var) 0)) ;; As a special exception, ignore "ignore". (eq var 'ignored)) - (byte-compile-log-warning (format-message "Unused lexical %s `%S'" - varkind var)))) + (byte-compile-warn "Unused lexical %s `%S'" + varkind var))) ;; If it's unused, there's no point converting it into a cons-cell, even if ;; it's captured and mutated. (`(,binder ,_ t t ,_) @@ -586,9 +606,9 @@ FORM is the parent form that binds this var." (dolist (arg args) (cond ((byte-compile-not-lexical-var-p arg) - (byte-compile-log-warning - (format "Lexical argument shadows the dynamic variable %S" - arg))) + (byte-compile-warn + "Lexical argument shadows the dynamic variable %S" + arg)) ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... (t (let ((varstruct (list arg nil nil nil nil))) (cl-pushnew arg byte-compile-lexical-variables) @@ -670,9 +690,8 @@ and updates the data stored in ENV." (setq forms (cddr forms)))) (`((lambda . ,_) . ,_) ; First element is lambda expression. - (byte-compile-log-warning - (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form))) - t :warning) + (byte-compile-warn + "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form))) (dolist (exp `((function ,(car form)) . ,(cdr form))) (cconv-analyze-form exp env))) @@ -681,8 +700,8 @@ and updates the data stored in ENV." (dolist (form forms) (cconv-analyze-form form env)))) ;; ((and `(quote ,v . ,_) (guard (assq v env))) - ;; (byte-compile-log-warning - ;; (format-message "Possible confusion variable/symbol for `%S'" v))) + ;; (byte-compile-warn + ;; "Possible confusion variable/symbol for `%S'" v)) (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote @@ -699,8 +718,8 @@ and updates the data stored in ENV." (`(condition-case ,var ,protected-form . ,handlers) (cconv-analyze-form protected-form env) (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) - (byte-compile-log-warning - (format "Lexical variable shadows the dynamic variable %S" var))) + (byte-compile-warn + "Lexical variable shadows the dynamic variable %S" var)) (let* ((varstruct (list var nil nil nil nil))) (if var (push varstruct env)) (dolist (handler handlers) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index be93c776287..962a85e90e7 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -60,6 +60,7 @@ ;; with all the bitmaps you want to use. (require 'eieio) +(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-generic)) ;;; Code: @@ -118,7 +119,7 @@ Useful if new Emacs is used on B&W display.") List is limited currently, which is ok since you really can't display too much in text characters anyways.") -(define-derived-mode chart-mode fundamental-mode "CHART" +(define-derived-mode chart-mode special-mode "Chart" "Define a mode in Emacs for displaying a chart." (buffer-disable-undo) (set (make-local-variable 'font-lock-global-modes) nil) @@ -205,22 +206,23 @@ Make sure the width/height is correct." (cl-defmethod chart-draw ((c chart) &optional buff) "Start drawing a chart object C in optional BUFF. Erases current contents of buffer." - (save-excursion - (if buff (set-buffer buff)) - (erase-buffer) - (insert (make-string 100 ?\n)) - ;; Start by displaying the axis - (chart-draw-axis c) - ;; Display title - (chart-draw-title c) - ;; Display data - (message "Rendering chart...") - (sit-for 0) - (chart-draw-data c) - ;; Display key - ; (chart-draw-key c) - (message "Rendering chart...done") - )) + (with-silent-modifications + (save-excursion + (if buff (set-buffer buff)) + (erase-buffer) + (insert (make-string (window-height (selected-window)) ?\n)) + ;; Start by displaying the axis + (chart-draw-axis c) + ;; Display title + (chart-draw-title c) + ;; Display data + (message "Rendering chart...") + (sit-for 0) + (chart-draw-data c) + ;; Display key + ; (chart-draw-key c) + (message "Rendering chart...done") + ))) (cl-defmethod chart-draw-title ((c chart)) "Draw a title upon the chart. @@ -434,11 +436,10 @@ or is created with the bounds of SEQ." (setq axis (make-instance 'chart-axis-range :name (oref seq name) :chart c))) - (while l - (if (< (car l) (car range)) (setcar range (car l))) - (if (> (car l) (cdr range)) (setcdr range (car l))) - (setq l (cdr l))) - (oset axis bounds range))) + (dolist (x l) + (if (< x (car range)) (setcar range x)) + (if (> x (cdr range)) (setcdr range x))) + (oset axis bounds range))) (if (eq axis-label 'x-axis) (oset axis loweredge nil)) (eieio-oset c axis-label axis) )) @@ -449,11 +450,10 @@ or is created with the bounds of SEQ." (cl-defmethod chart-trim ((c chart) max) "Trim all sequences in chart C to be at most MAX elements long." (let ((s (oref c sequences))) - (while s - (let ((sl (oref (car s) data))) + (dolist (x s) + (let ((sl (oref x data))) (if (> (length sl) max) - (setcdr (nthcdr (1- max) sl) nil))) - (setq s (cdr s)))) + (setcdr (nthcdr (1- max) sl) nil))))) ) (cl-defmethod chart-sort ((c chart) pred) @@ -614,27 +614,20 @@ SORT-PRED if desired." (defun chart-file-count (dir) "Draw a chart displaying the number of different file extensions in DIR." (interactive "DDirectory: ") - (if (not (string-match "/$" dir)) - (setq dir (concat dir "/"))) (message "Collecting statistics...") (let ((flst (directory-files dir nil nil t)) (extlst (list "<dir>")) (cntlst (list 0))) - (while flst - (let* ((j (string-match "[^\\.]\\(\\.[a-zA-Z]+\\|~\\|#\\)$" (car flst))) - (s (if (file-accessible-directory-p (concat dir (car flst))) - "<dir>" - (if j - (substring (car flst) (match-beginning 1) (match-end 1)) - nil))) + (dolist (f flst) + (let* ((x (file-name-extension f)) + (s (if (file-accessible-directory-p (expand-file-name f dir)) + "<dir>" x)) (m (member s extlst))) - (if (not s) nil + (unless (null s) (if m - (let ((cell (nthcdr (- (length extlst) (length m)) cntlst))) - (setcar cell (1+ (car cell)))) + (cl-incf (car (nthcdr (- (length extlst) (length m)) cntlst))) (setq extlst (cons s extlst) - cntlst (cons 1 cntlst))))) - (setq flst (cdr flst))) + cntlst (cons 1 cntlst)))))) ;; Let's create the chart! (chart-bar-quickie 'vertical "Files Extension Distribution" extlst "File Extensions" diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index b6fa0546088..e1e756be077 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -43,7 +43,7 @@ "Name of buffer used to display any `check-declare' warnings.") (defun check-declare-locate (file basefile) - "Return the full path of FILE. + "Return the relative name of FILE. Expands files with a \".c\" or \".m\" extension relative to the Emacs \"src/\" directory. Otherwise, `locate-library' searches for FILE. If that fails, expands FILE relative to BASEFILE's directory part. @@ -70,6 +70,7 @@ the result." (string-match "\\.el\\'" tfile)) tfile (concat tfile ".el"))))) + (setq file (file-relative-name file)) (if ext (concat "ext:" file) file))) @@ -80,49 +81,40 @@ where only the first two elements need be present. This claims that FNFILE defines FN, with ARGLIST. FILEONLY non-nil means only check that FNFILE exists, not that it defines FN. This is for function definitions that we don't know how to recognize (e.g. some macros)." - (let ((m (format "Scanning %s..." file)) - alist form len fn fnfile arglist fileonly) - (message "%s" m) + (let (alist) (with-temp-buffer (insert-file-contents file) ;; FIXME we could theoretically be inside a string. (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) - (goto-char (match-beginning 1)) - (if (and (setq form (ignore-errors (read (current-buffer)))) + (let ((pos (match-beginning 1))) + (goto-char pos) + (let ((form (ignore-errors (read (current-buffer)))) + len fn formfile fnfile arglist fileonly) + (if (and ;; Exclude element of byte-compile-initial-macro-environment. (or (listp (cdr form)) (setq form nil)) (> (setq len (length form)) 2) (< len 6) + (setq formfile (nth 2 form)) (symbolp (setq fn (cadr form))) (setq fn (symbol-name fn)) ; later we use as a search string - (stringp (setq fnfile (nth 2 form))) - (setq fnfile (check-declare-locate fnfile - (expand-file-name file))) + (stringp formfile) + (setq fnfile (check-declare-locate formfile file)) ;; Use t to distinguish unspecified arglist from empty one. (or (eq t (setq arglist (if (> len 3) (nth 3 form) t))) (listp arglist)) (symbolp (setq fileonly (nth 4 form)))) - (setq alist (cons (list fnfile fn arglist fileonly) alist)) - ;; FIXME make this more noticeable. - (if form (message "Malformed declaration for `%s'" (cadr form)))))) - (message "%sdone" m) + (setq alist (cons (list fnfile fn arglist fileonly) alist)) + (when form + (check-declare-warn file (or fn "unknown function") + (if (stringp formfile) formfile + "unknown file") + "Malformed declaration" + (line-number-at-pos pos)))))))) alist)) -(defun check-declare-errmsg (errlist &optional full) - "Return a string with the number of errors in ERRLIST, if any. -Normally just counts the number of elements in ERRLIST. -With optional argument FULL, sums the number of elements in each element." - (if errlist - (let ((l (length errlist))) - (when full - (setq l 0) - (dolist (e errlist) - (setq l (+ l (1- (length e)))))) - (format "%d problem%s found" l (if (= l 1) "" "s"))) - "OK")) - (autoload 'byte-compile-arglist-signature "bytecomp") (defgroup check-declare nil @@ -144,11 +136,9 @@ to only check that FNFILE exists, not that it actually defines FN. Returns nil if all claims are found to be true, otherwise a list of errors with elements of the form \(FILE FN TYPE), where TYPE is a string giving details of the error." - (let ((m (format "Checking %s..." fnfile)) - (cflag (member (file-name-extension fnfile) '("c" "m"))) + (let ((cflag (member (file-name-extension fnfile) '("c" "m"))) (ext (string-match "^ext:" fnfile)) re fn sig siglist arglist type errlist minargs maxargs) - (message "%s" m) (if ext (setq fnfile (substring fnfile 4))) (if (file-regular-p fnfile) @@ -216,7 +206,8 @@ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) (setq arglist (nth 2 e) type (if (not re) - "file not found" + (when (or check-declare-ext-errors (not ext)) + "file not found") (if (not (setq sig (assoc (cadr e) siglist))) (unless (nth 3 e) ; fileonly "function not found") @@ -235,13 +226,6 @@ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) "arglist mismatch"))))) (when type (setq errlist (cons (list (car e) (cadr e) type) errlist)))) - (message "%s%s" m - (if (or re (or check-declare-ext-errors - (not ext))) - (check-declare-errmsg errlist) - (progn - (setq errlist nil) - "skipping external file"))) errlist)) (defun check-declare-sort (alist) @@ -258,30 +242,27 @@ Returned list has elements FNFILE (FILE ...)." (setq sort (cons (list fnfile (cons file rest)) sort))))) sort)) -(defun check-declare-warn (file fn fnfile type) +(defun check-declare-warn (file fn fnfile type &optional line) "Warn that FILE made a false claim about FN in FNFILE. -TYPE is a string giving the nature of the error. Warning is displayed in -`check-declare-warning-buffer'." +TYPE is a string giving the nature of the error. +Optional LINE is the claim's line number; otherwise, search for the claim. +Display warning in `check-declare-warning-buffer'." (let ((warning-prefix-function (lambda (level entry) - (let ((line 0) - (col 0)) - (insert - (with-current-buffer (find-file-noselect file) - (goto-char (point-min)) - (when (re-search-forward - (format "(declare-function[ \t\n]+%s" fn) nil t) - (goto-char (match-beginning 0)) - (setq line (line-number-at-pos)) - (setq col (1+ (current-column)))) - (format "%s:%d:%d:" - (file-name-nondirectory file) - line col)))) + (insert (format "%s:%d:" (file-relative-name file) (or line 0))) entry)) (warning-fill-prefix " ")) + (unless line + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (when (and (not line) + (re-search-forward + (format "(declare-function[ \t\n]+%s" fn) nil t)) + (goto-char (match-beginning 0)) + (setq line (line-number-at-pos))))) (display-warning 'check-declare (format-message "said `%s' was defined in %s: %s" - fn (file-name-nondirectory fnfile) type) + fn (file-relative-name fnfile) type) nil check-declare-warning-buffer))) (declare-function compilation-forget-errors "compile" ()) @@ -289,7 +270,18 @@ TYPE is a string giving the nature of the error. Warning is displayed in (defun check-declare-files (&rest files) "Check veracity of all `declare-function' statements in FILES. Return a list of any errors found." - (let (alist err errlist) + (if (get-buffer check-declare-warning-buffer) + (kill-buffer check-declare-warning-buffer)) + (let ((buf (get-buffer-create check-declare-warning-buffer)) + alist err errlist) + (with-current-buffer buf + (unless (derived-mode-p 'compilation-mode) + (compilation-mode)) + (setq mode-line-process + '(:propertize ":run" face compilation-mode-line-run)) + (let ((inhibit-read-only t)) + (insert "\f\n")) + (compilation-forget-errors)) (dolist (file files) (setq alist (cons (cons file (check-declare-scan file)) alist))) ;; Sort so that things are ordered by the files supposed to @@ -298,19 +290,15 @@ Return a list of any errors found." (if (setq err (check-declare-verify (car e) (cdr e))) (setq errlist (cons (cons (car e) err) errlist)))) (setq errlist (nreverse errlist)) - (if (get-buffer check-declare-warning-buffer) - (kill-buffer check-declare-warning-buffer)) - (with-current-buffer (get-buffer-create check-declare-warning-buffer) - (unless (derived-mode-p 'compilation-mode) - (compilation-mode)) - (let ((inhibit-read-only t)) - (insert "\f\n")) - (compilation-forget-errors)) ;; Sort back again so that errors are ordered by the files ;; containing the declare-function statements. (dolist (e (check-declare-sort errlist)) (dolist (f (cdr e)) (check-declare-warn (car e) (cadr f) (car f) (nth 2 f)))) + (with-current-buffer buf + (setq mode-line-process + '(:propertize ":exit" face compilation-mode-line-run)) + (force-mode-line-update)) errlist)) ;;;###autoload @@ -320,34 +308,22 @@ See `check-declare-directory' for more information." (interactive "fFile to check: ") (or (file-exists-p file) (error "File `%s' not found" file)) - (let ((m (format "Checking %s..." file)) - errlist) - (message "%s" m) - (setq errlist (check-declare-files file)) - (message "%s%s" m (check-declare-errmsg errlist)) - errlist)) + (check-declare-files file)) ;;;###autoload (defun check-declare-directory (root) "Check veracity of all `declare-function' statements under directory ROOT. Returns non-nil if any false statements are found." (interactive "DDirectory to check: ") - (or (file-directory-p (setq root (expand-file-name root))) + (setq root (directory-file-name (file-relative-name root))) + (or (file-directory-p root) (error "Directory `%s' not found" root)) - (let ((m "Checking `declare-function' statements...") - (m2 "Finding files with declarations...") - errlist files) - (message "%s" m) - (message "%s" m2) - (setq files (process-lines find-program root - "-name" "*.el" - "-exec" grep-program - "-l" "^[ \t]*(declare-function" "{}" ";")) - (message "%s%d found" m2 (length files)) + (let ((files (process-lines find-program root + "-name" "*.el" + "-exec" grep-program + "-l" "^[ \t]*(declare-function" "{}" "+"))) (when files - (setq errlist (apply 'check-declare-files files)) - (message "%s%s" m (check-declare-errmsg errlist t)) - errlist))) + (apply #'check-declare-files files)))) (provide 'check-declare) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index e93294d6cc2..769c2fe5741 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1062,7 +1062,7 @@ Calls `checkdoc' with spell-checking turned on. Prefix argument is the same as for `checkdoc'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc nil current-prefix-arg))) + (call-interactively #'checkdoc))) ;;;###autoload (defun checkdoc-ispell-current-buffer () @@ -1071,7 +1071,7 @@ Calls `checkdoc-current-buffer' with spell-checking turned on. Prefix argument is the same as for `checkdoc-current-buffer'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-current-buffer nil current-prefix-arg))) + (call-interactively #'checkdoc-current-buffer))) ;;;###autoload (defun checkdoc-ispell-interactive () @@ -1080,7 +1080,7 @@ Calls `checkdoc-interactive' with spell-checking turned on. Prefix argument is the same as for `checkdoc-interactive'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-interactive nil current-prefix-arg))) + (call-interactively #'checkdoc-interactive))) ;;;###autoload (defun checkdoc-ispell-message-interactive () @@ -1099,7 +1099,7 @@ Calls `checkdoc-message-text' with spell-checking turned on. Prefix argument is the same as for `checkdoc-message-text'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-message-text nil current-prefix-arg))) + (call-interactively #'checkdoc-message-text))) ;;;###autoload (defun checkdoc-ispell-start () @@ -1108,7 +1108,7 @@ Calls `checkdoc-start' with spell-checking turned on. Prefix argument is the same as for `checkdoc-start'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-start nil current-prefix-arg))) + (call-interactively #'checkdoc-start))) ;;;###autoload (defun checkdoc-ispell-continue () @@ -1117,7 +1117,7 @@ Calls `checkdoc-continue' with spell-checking turned on. Prefix argument is the same as for `checkdoc-continue'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-continue nil current-prefix-arg))) + (call-interactively #'checkdoc-continue))) ;;;###autoload (defun checkdoc-ispell-comments () @@ -1126,7 +1126,7 @@ Calls `checkdoc-comments' with spell-checking turned on. Prefix argument is the same as for `checkdoc-comments'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-comments nil current-prefix-arg))) + (call-interactively #'checkdoc-comments))) ;;;###autoload (defun checkdoc-ispell-defun () @@ -1135,7 +1135,7 @@ Calls `checkdoc-defun' with spell-checking turned on. Prefix argument is the same as for `checkdoc-defun'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively #'checkdoc-defun nil current-prefix-arg))) + (call-interactively #'checkdoc-defun))) ;;; Error Management ;; @@ -1580,7 +1580,7 @@ mouse-[0-3]\\)\\)\\>")) (if (and sym (boundp sym) (fboundp sym) (save-excursion (goto-char mb) - (forward-word -1) + (forward-word-strictly -1) (not (looking-at "variable\\|option\\|function\\|command\\|symbol")))) (if (checkdoc-autofix-ask-replace @@ -1596,7 +1596,7 @@ mouse-[0-3]\\)\\)\\>")) nil t nil nil "variable"))) (goto-char (1- mb)) (insert disambiguate " ") - (forward-word 1)) + (forward-word-strictly 1)) (setq ret (format "Disambiguate %s by preceding w/ \ function,command,variable,option or symbol." ms1)))))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index b5dfe487d07..0033a94fb5c 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -173,7 +173,9 @@ the elements themselves. (defun cl-mapcan (cl-func cl-seq &rest cl-rest) "Like `cl-mapcar', but nconc's together the values returned by the function. \n(fn FUNCTION SEQUENCE...)" - (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest))) + (if cl-rest + (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)) + (mapcan cl-func cl-seq))) ;;;###autoload (defun cl-mapcon (cl-func cl-list &rest cl-rest) @@ -822,7 +824,7 @@ including `cl-block' and `cl-eval-when'." (cl--describe-class-slots class) ;; Describe all the methods specific to this class. - (let ((generics (cl--generic-all-functions type))) + (let ((generics (cl-generic-all-functions type))) (when generics (insert (propertize "Specialized Methods:\n\n" 'face 'bold)) (dolist (generic generics) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 7ad9f307f93..61186e1a881 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -86,6 +86,11 @@ ;;; Code: +;; The autoloads.el mechanism which adds package--builtin-versions +;; maintenance to loaddefs.el doesn't work for preloaded packages (such +;; as this one), so we have to do it by hand! +(push (purecopy '(cl-generic 1 0)) package--builtin-versions) + ;; Note: For generic functions that dispatch on several arguments (i.e. those ;; which use the multiple-dispatch feature), we always use the same "tagcodes" ;; and the same set of arguments on which to dispatch. This works, but is @@ -353,6 +358,26 @@ the specializer used will be the one returned by BODY." ,nbody)))))) (f (error "Unexpected macroexpansion result: %S" f)))))) +(put 'cl-defmethod 'function-documentation + '(cl--generic-make-defmethod-docstring)) + +(defun cl--generic-make-defmethod-docstring () + ;; FIXME: Copy&paste from pcase--make-docstring. + (let* ((main (documentation (symbol-function 'cl-defmethod) 'raw)) + (ud (help-split-fundoc main 'cl-defmethod))) + ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, + ;; where cl-lib is anything using pcase-defmacro. + (require 'help-fns) + (with-temp-buffer + (insert (or (cdr ud) main)) + (insert "\n\n\tCurrently supported forms for TYPE:\n\n") + (dolist (method (reverse (cl--generic-method-table + (cl--generic 'cl-generic-generalizers)))) + (let* ((info (cl--generic-method-info method))) + (when (nth 2 info) + (insert (nth 2 info) "\n\n")))) + (let ((combined-doc (buffer-string))) + (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) ;;;###autoload (defmacro cl-defmethod (name args &rest body) @@ -370,15 +395,17 @@ modifies how the method is combined with other methods, including: :after - Method will be called after the primary :around - Method will be called around everything else The absence of QUALIFIER means this is a \"primary\" method. +The set of acceptable qualifiers and their meaning is defined +\(and can be extended) by the methods of `cl-generic-combine-methods'. -TYPE can be one of the basic types (see the full list and their -hierarchy in `cl--generic-typeof-types'), CL struct type, or an -EIEIO class. +ARGS can also include so-called context specializers, introduced by +`&context' (which should appear right after the mandatory arguments, +before any &optional or &rest). They have the form (EXPR TYPE) where +EXPR is an Elisp expression whose value should match TYPE for the +method to be applicable. -Other than that, TYPE can also be of the form `(eql VAL)' in -which case this method will be invoked when the argument is `eql' -to VAL, or `(head VAL)', in which case the argument is required -to be a cons with VAL as its head. +The set of acceptable TYPEs (also called \"specializers\") is defined +\(and can be extended) by the various methods of `cl-generic-generalizers'. \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" (declare (doc-string 3) (indent 2) @@ -410,7 +437,8 @@ to be a cons with VAL as its head. ;; function, so warnings like "not known to be defined" are fair game. ;; But in practice, it's common to use `cl-defmethod' ;; without a previous `cl-defgeneric'. - (declare-function ,name "") + ;; The ",'" is a no-op that pacifies check-declare. + (,'declare-function ,name "") (cl-generic-define-method ',name ',(nreverse qualifiers) ',args ,uses-cnm ,fun))))) @@ -423,6 +451,12 @@ to be a cons with VAL as its head. (setq methods (cdr methods))) methods) +(defun cl--generic-load-hist-format (name qualifiers specializers) + ;; FIXME: This function is used in elisp-mode.el and + ;; elisp-mode-tests.el, but I still decided to use an internal name + ;; because these uses should be removed or moved into cl-generic.el. + `(,name ,qualifiers . ,specializers)) + ;;;###autoload (defun cl-generic-define-method (name qualifiers args uses-cnm function) (pcase-let* @@ -463,7 +497,9 @@ to be a cons with VAL as its head. (cons method mt) ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) - (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers)) + (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format + (cl--generic-name generic) + qualifiers specializers)) current-load-list :test #'equal) ;; FIXME: Try to avoid re-constructing a new function if the old one ;; is still valid (e.g. still empty method cache)? @@ -666,6 +702,15 @@ FUN is the function that should be called when METHOD calls (setq fun (cl-generic-call-method generic method fun))) fun))))) +(defun cl-generic-apply (generic args) + "Like `apply' but takes a cl-generic object rather than a function." + ;; Handy in cl-no-applicable-method, for example. + ;; In Common Lisp, generic-function objects are funcallable. Ideally + ;; we'd want the same in Elisp, but it would either require using a very + ;; different (and less efficient) representation of cl--generic objects, + ;; or non-trivial changes in the general infrastructure (compiler and such). + (apply (cl--generic-name generic) args)) + (defun cl--generic-arg-specializer (method dispatch-arg) (or (if (integerp dispatch-arg) (nth dispatch-arg @@ -736,7 +781,7 @@ methods.") (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) (cl-defmethod cl-generic-generalizers (specializer) - "Support for the catch-all t specializer." + "Support for the catch-all t specializer which always matches." (if (eq specializer t) (list cl--generic-t-generalizer) (error "Unknown specializer %S" specializer))) @@ -840,18 +885,22 @@ Can only be used from within the lexical body of a primary or around method." (defun cl--generic-search-method (met-name) "For `find-function-regexp-alist'. Searches for a cl-defmethod. -MET-NAME is a cons (SYMBOL . SPECIALIZERS)." +MET-NAME is as returned by `cl--generic-load-hist-format'." (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+" (regexp-quote (format "%s" (car met-name))) "\\_>"))) (or (re-search-forward (concat base-re "[^&\"\n]*" + (mapconcat (lambda (qualifier) + (regexp-quote (format "%S" qualifier))) + (cadr met-name) + "[ \t\n]*") (mapconcat (lambda (specializer) (regexp-quote (format "%S" (if (consp specializer) (nth 1 specializer) specializer)))) - (remq t (cdr met-name)) + (remq t (cddr met-name)) "[ \t\n]*)[^&\"\n]*")) nil t) (re-search-forward base-re nil t)))) @@ -908,8 +957,10 @@ MET-NAME is a cons (SYMBOL . SPECIALIZERS)." (let* ((info (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. (insert (format "%s%S" (nth 0 info) (nth 1 info))) - (let* ((met-name (cons function - (cl--generic-method-specializers method))) + (let* ((met-name (cl--generic-load-hist-format + function + (cl--generic-method-qualifiers method) + (cl--generic-method-specializers method))) (file (find-lisp-object-file-name met-name 'cl-defmethod))) (when file (insert (substitute-command-keys " in `")) @@ -937,7 +988,7 @@ MET-NAME is a cons (SYMBOL . SPECIALIZERS)." (setq applies t))) applies)) -(defun cl--generic-all-functions (&optional type) +(defun cl-generic-all-functions (&optional type) "Return a list of all generic functions. Optional TYPE argument returns only those functions that contain methods for TYPE." @@ -993,7 +1044,8 @@ The value returned is a list of elements of the form (lambda (tag &rest _) (if (eq (car-safe tag) 'head) (list tag)))) (cl-defmethod cl-generic-generalizers :extra "head" (specializer) - "Support for the `(head VAL)' specializers." + "Support for (head VAL) specializers. +These match if the argument is a cons cell whose car is `eql' to VAL." ;; We have to implement `head' here using the :extra qualifier, ;; since we can't use the `head' specializer to implement itself. (if (not (eq (car-safe specializer) 'head)) @@ -1013,7 +1065,8 @@ The value returned is a list of elements of the form (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag)))) (cl-defmethod cl-generic-generalizers ((specializer (head eql))) - "Support for the `(eql VAL)' specializers." + "Support for (eql VAL) specializers. +These match if the argument is `eql' to VAL." (puthash (cadr specializer) specializer cl--generic-eql-used) (list cl--generic-eql-generalizer)) @@ -1068,7 +1121,7 @@ The value returned is a list of elements of the form #'cl--generic-struct-specializers) (cl-defmethod cl-generic-generalizers :extra "cl-struct" (type) - "Support for dispatch on cl-struct types." + "Support for dispatch on types defined by `cl-defstruct'." (or (when (symbolp type) ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than @@ -1112,7 +1165,8 @@ The value returned is a list of elements of the form (and (symbolp tag) (assq tag cl--generic-typeof-types)))) (cl-defmethod cl-generic-generalizers :extra "typeof" (type) - "Support for dispatch on builtin types." + "Support for dispatch on builtin types. +See the full list and their hierarchy in `cl--generic-typeof-types'." ;; FIXME: Add support for other types accepted by `cl-typep' such ;; as `character', `atom', `face', `function', ... (or @@ -1150,7 +1204,8 @@ The value returned is a list of elements of the form #'cl--generic-derived-specializers) (cl-defmethod cl-generic-generalizers ((_specializer (head derived-mode))) - "Support for the `(derived-mode MODE)' specializers." + "Support for (derived-mode MODE) specializers. +Used internally for the (major-mode MODE) context specializers." (list cl--generic-derived-generalizer)) (cl-generic-define-context-rewriter major-mode (mode &rest modes) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ae52e8bebec..210a2083727 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -299,7 +299,8 @@ FORM is of the form (ARGS . BODY)." ;; Be careful with make-symbol and (back)quote, ;; see bug#12884. (help--docstring-quote - (let ((print-gensym nil) (print-quoted t)) + (let ((print-gensym nil) (print-quoted t) + (print-escape-newlines t)) (format "%S" (cons 'fn (cl--make-usage-args orig-args)))))) header))) @@ -326,6 +327,20 @@ FORM is of the form (ARGS . BODY)." Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (cl-block NAME ...). +The full form of a Common Lisp function argument list is + + (VAR... + [&optional (VAR [INITFORM [SVAR]])...] + [&rest|&body VAR] + [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]] + [&aux (VAR [INITFORM])...]) + +VAR maybe be replaced recursively with an argument list for +destructing, `&whole' is supported within these sublists. If +SVAR, INITFORM, and KEYWORD are all omitted, then `(VAR)' may be +written simply `VAR'. See the Info node `(cl)Argument Lists' for +more details. + \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as defun but use cl-lambda-list. @@ -405,6 +420,21 @@ and BODY is implicitly surrounded by (cl-block NAME ...). Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (cl-block NAME ...). +The full form of a Common Lisp macro argument list is + + (VAR... + [&optional (VAR [INITFORM [SVAR]])...] + [&rest|&body VAR] + [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]] + [&aux (VAR [INITFORM])...] + [&environment VAR]) + +VAR maybe be replaced recursively with an argument list for +destructing, `&whole' is supported within these sublists. If +SVAR, INITFORM, and KEYWORD are all omitted, then `(VAR)' may be +written simply `VAR'. See the Info node `(cl)Argument Lists' for +more details. + \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug (&define name cl-macro-list cl-declarations-or-string def-body)) @@ -850,9 +880,9 @@ This is compatible with Common Lisp, but note that `defun' and "The Common Lisp `loop' macro. Valid clauses include: For clauses: - for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 by EXPR3 + for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 [by EXPR3] for VAR = EXPR1 then EXPR2 - for VAR in/on/in-ref LIST by FUNC + for VAR in/on/in-ref LIST [by FUNC] for VAR across/across-ref ARRAY for VAR being: the elements of/of-ref SEQUENCE [using (index VAR2)] @@ -893,6 +923,7 @@ For more details, see Info node `(cl)Loop Facility'. "count" "maximize" "minimize" "if" "unless" "return"] form] + ["using" (symbolp symbolp)] ;; Simple default, which covers 99% of the cases. symbolp form))) (if (not (memq t (mapcar #'symbolp @@ -1807,6 +1838,27 @@ Labels have lexical scope and dynamic extent." `(throw ',catch-tag ',label)))) ,@macroexpand-all-environment))))) +(defun cl--prog (binder bindings body) + (let (decls) + (while (eq 'declare (car-safe (car body))) + (push (pop body) decls)) + `(cl-block nil + (,binder ,bindings + ,@(nreverse decls) + (cl-tagbody . ,body))))) + +;;;###autoload +(defmacro cl-prog (bindings &rest body) + "Run BODY like a `cl-tagbody' after setting up the BINDINGS. +Shorthand for (cl-block nil (let BINDINGS (cl-tagbody BODY)))" + (cl--prog 'let bindings body)) + +;;;###autoload +(defmacro cl-prog* (bindings &rest body) + "Run BODY like a `cl-tagbody' after setting up the BINDINGS. +Shorthand for (cl-block nil (let* BINDINGS (cl-tagbody BODY)))" + (cl--prog 'let* bindings body)) + ;;;###autoload (defmacro cl-do-symbols (spec &rest body) "Loop over all symbols. @@ -2083,7 +2135,7 @@ Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" - (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body))) + (declare (indent 1) (debug ((&rest (symbolp sexp)) cl-declarations body))) (cond ((cdr bindings) `(cl-symbol-macrolet (,(car bindings)) @@ -2527,20 +2579,19 @@ non-nil value, that slot cannot be set via `setf'. [&or symbolp (gate symbolp &rest - (&or [":conc-name" symbolp] - [":constructor" symbolp &optional cl-lambda-list] - [":copier" symbolp] - [":predicate" symbolp] - [":include" symbolp &rest sexp] ;; Not finished. - ;; The following are not supported. - ;; [":print-function" ...] - ;; [":type" ...] - ;; [":initial-offset" ...] - ))] + [&or symbolp + (&or [":conc-name" symbolp] + [":constructor" symbolp &optional cl-lambda-list] + [":copier" symbolp] + [":predicate" symbolp] + [":include" symbolp &rest sexp] ;; Not finished. + [":print-function" sexp] + [":type" symbolp] + [":named"] + [":initial-offset" natnump])])] [&optional stringp] ;; All the above is for the following def-form. - &rest &or symbolp (symbolp def-form - &optional ":read-only" sexp)))) + &rest &or symbolp (symbolp &optional def-form &rest sexp)))) (let* ((name (if (consp struct) (car struct) struct)) (opts (cdr-safe struct)) (slots nil) @@ -2604,7 +2655,7 @@ non-nil value, that slot cannot be set via `setf'. (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t - (error "Slot option %s unrecognized" opt))))) + (error "Structure option %s unrecognized" opt))))) (unless (or include-name type) (setq include-name cl--struct-default-parent)) (when include-name (setq include (cl--struct-get-class include-name))) @@ -2660,7 +2711,7 @@ non-nil value, that slot cannot be set via `setf'. (let ((pos 0) (descp descs)) (while descp (let* ((desc (pop descp)) - (slot (car desc))) + (slot (pop desc))) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (push nil slots) @@ -2670,8 +2721,12 @@ non-nil value, that slot cannot be set via `setf'. (error "Duplicate slots named %s in %s" slot name)) (let ((accessor (intern (format "%s%s" conc-name slot)))) (push slot slots) - (push (nth 1 desc) defaults) + (push (pop desc) defaults) + ;; The arg "cl-x" is referenced by name in eg pred-form + ;; and pred-check, so changing it is not straightforward. (push `(cl-defsubst ,accessor (cl-x) + ,(format "Access slot \"%s\" of `%s' struct CL-X." + slot struct) (declare (side-effect-free t)) ,@(and pred-check (list `(or ,pred-check @@ -2681,7 +2736,9 @@ non-nil value, that slot cannot be set via `setf'. (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) forms) - (if (cadr (memq :read-only (cddr desc))) + (when (cl-oddp (length desc)) + (error "Invalid options for slot %s in %s" slot name)) + (if (plist-get desc ':read-only) (push `(gv-define-expander ,accessor (lambda (_cl-do _cl-x) (error "%s is a read-only slot" ',accessor))) @@ -2973,7 +3030,7 @@ omitted, a default message listing FORM itself is used." (delq nil (mapcar (lambda (x) (unless (macroexp-const-p x) x)) - (cdr form)))))) + (cdr-safe form)))))) `(progn (or ,form (cl--assertion-failed diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index cd1d700f1b0..2b022c49053 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -45,7 +45,7 @@ (defun cl--assertion-failed (form &optional string sargs args) (if debug-on-error - (debug `(cl-assertion-failed ,form ,string ,@sargs)) + (funcall debugger `(cl-assertion-failed ,form ,string ,@sargs)) (if string (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 21aec6cdfcd..3f8b1eec66e 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -116,6 +116,16 @@ (defun cl-reduce (cl-func cl-seq &rest cl-keys) "Reduce two-argument FUNCTION across SEQ. \nKeywords supported: :start :end :from-end :initial-value :key + +Return the result of calling FUNCTION with the first and the +second element of SEQ, then calling FUNCTION with that result and +the third element of SEQ, then with that result and the fourth +element of SEQ, etc. + +If :INITIAL-VALUE is specified, it is added to the front of SEQ. +If SEQ is empty, return :INITIAL-VALUE and FUNCTION is not +called. + \n(fn FUNCTION SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) @@ -134,24 +144,24 @@ cl-accum))) ;;;###autoload -(defun cl-fill (seq item &rest cl-keys) +(defun cl-fill (cl-seq cl-item &rest cl-keys) "Fill the elements of SEQ with ITEM. \nKeywords supported: :start :end \n(fn SEQ ITEM [KEYWORD VALUE]...)" (cl--parsing-keywords ((:start 0) :end) () - (if (listp seq) - (let ((p (nthcdr cl-start seq)) - (n (if cl-end (- cl-end cl-start) 8000000))) - (while (and p (>= (setq n (1- n)) 0)) - (setcar p item) + (if (listp cl-seq) + (let ((p (nthcdr cl-start cl-seq)) + (n (and cl-end (- cl-end cl-start)))) + (while (and p (or (null n) (>= (cl-decf n) 0))) + (setcar p cl-item) (setq p (cdr p)))) - (or cl-end (setq cl-end (length seq))) - (if (and (= cl-start 0) (= cl-end (length seq))) - (fillarray seq item) + (or cl-end (setq cl-end (length cl-seq))) + (if (and (= cl-start 0) (= cl-end (length cl-seq))) + (fillarray cl-seq cl-item) (while (< cl-start cl-end) - (aset seq cl-start item) + (aset cl-seq cl-start cl-item) (setq cl-start (1+ cl-start))))) - seq)) + cl-seq)) ;;;###autoload (defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys) @@ -170,16 +180,20 @@ SEQ1 is destructively modified, then returned. (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) - (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) + (cl-n1 (and cl-end1 (- cl-end1 cl-start1)))) (if (listp cl-seq2) (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) - (cl-n (min cl-n1 - (if cl-end2 (- cl-end2 cl-start2) 4000000)))) - (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) + (cl-n (cond ((and cl-n1 cl-end2) + (min cl-n1 (- cl-end2 cl-start2))) + ((and cl-n1 (null cl-end2)) cl-n1) + ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2))))) + (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0))) (setcar cl-p1 (car cl-p2)) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) - (setq cl-end2 (min (or cl-end2 (length cl-seq2)) - (+ cl-start2 cl-n1))) + (setq cl-end2 (if (null cl-n1) + (or cl-end2 (length cl-seq2)) + (min (or cl-end2 (length cl-seq2)) + (+ cl-start2 cl-n1)))) (while (and cl-p1 (< cl-start2 cl-end2)) (setcar cl-p1 (aref cl-seq2 cl-start2)) (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) @@ -205,9 +219,10 @@ to avoid corrupting the original SEQ. \n(fn ITEM SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) + (let ((len (length cl-seq))) + (if (<= (or cl-count (setq cl-count len)) 0) cl-seq - (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) + (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2)))) (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end cl-from-end))) (if cl-i @@ -219,7 +234,7 @@ to avoid corrupting the original SEQ. (if (listp cl-seq) cl-res (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) cl-seq)) - (setq cl-end (- (or cl-end 8000000) cl-start)) + (setq cl-end (- (or cl-end len) cl-start)) (if (= cl-start 0) (while (and cl-seq (> cl-end 0) (cl--check-test cl-item (car cl-seq)) @@ -240,7 +255,7 @@ to avoid corrupting the original SEQ. :start 0 :end (1- cl-end) :count (1- cl-count) cl-keys)))) cl-seq)) - cl-seq))))) + cl-seq)))))) ;;;###autoload (defun cl-remove-if (cl-pred cl-list &rest cl-keys) @@ -268,20 +283,21 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn ITEM SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) + (let ((len (length cl-seq))) + (if (<= (or cl-count (setq cl-count len)) 0) cl-seq (if (listp cl-seq) - (if (and cl-from-end (< cl-count 4000000)) + (if (and cl-from-end (< cl-count (/ len 2))) (let (cl-i) (while (and (>= (setq cl-count (1- cl-count)) 0) (setq cl-i (cl--position cl-item cl-seq cl-start - cl-end cl-from-end))) + cl-end cl-from-end))) (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) (setcdr cl-tail (cdr (cdr cl-tail))))) (setq cl-end cl-i)) cl-seq) - (setq cl-end (- (or cl-end 8000000) cl-start)) + (setq cl-end (- (or cl-end len) cl-start)) (if (= cl-start 0) (progn (while (and cl-seq @@ -302,7 +318,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (setq cl-p (cdr cl-p))) (setq cl-end (1- cl-end))))) cl-seq) - (apply 'cl-remove cl-item cl-seq cl-keys))))) + (apply 'cl-remove cl-item cl-seq cl-keys)))))) ;;;###autoload (defun cl-delete-if (cl-pred cl-list &rest cl-keys) @@ -337,6 +353,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (defun cl--delete-duplicates (cl-seq cl-keys cl-copy) (if (listp cl-seq) (cl--parsing-keywords + ;; We need to parse :if, otherwise `cl-if' is unbound. (:test :test-not :key (:start 0) :end :from-end :if) () (if cl-from-end @@ -385,15 +402,17 @@ to avoid corrupting the original SEQ. (cl--parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (if (or (eq cl-old cl-new) - (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) + (<= (or cl-count (setq cl-from-end nil + cl-count (length cl-seq))) 0)) cl-seq (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) (if (not cl-i) cl-seq (setq cl-seq (copy-sequence cl-seq)) - (or cl-from-end - (progn (setf (elt cl-seq cl-i) cl-new) - (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) + (unless cl-from-end + (setf (elt cl-seq cl-i) cl-new) + (cl-incf cl-i) + (cl-decf cl-count)) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) @@ -423,17 +442,18 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () - (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) - (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) + (let ((len (length cl-seq))) + (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0) + (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2)))) (let ((cl-p (nthcdr cl-start cl-seq))) - (setq cl-end (- (or cl-end 8000000) cl-start)) + (setq cl-end (- (or cl-end len) cl-start)) (while (and cl-p (> cl-end 0) (> cl-count 0)) (if (cl--check-test cl-old (car cl-p)) (progn (setcar cl-p cl-new) (setq cl-count (1- cl-count)))) (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) - (or cl-end (setq cl-end (length cl-seq))) + (or cl-end (setq cl-end len)) (if cl-from-end (while (and (< cl-start cl-end) (> cl-count 0)) (setq cl-end (1- cl-end)) @@ -446,7 +466,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (progn (aset cl-seq cl-start cl-new) (setq cl-count (1- cl-count)))) - (setq cl-start (1+ cl-start)))))) + (setq cl-start (1+ cl-start))))))) cl-seq)) ;;;###autoload @@ -502,14 +522,13 @@ Return the index of the matching item, or nil if not found. (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) (if (listp cl-seq) - (let ((cl-p (nthcdr cl-start cl-seq))) - (or cl-end (setq cl-end 8000000)) - (let ((cl-res nil)) - (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) + (let ((cl-p (nthcdr cl-start cl-seq)) + cl-res) + (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end)) (if (cl--check-test cl-item (car cl-p)) (setq cl-res cl-start)) (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) - cl-res)) + cl-res) (or cl-end (setq cl-end (length cl-seq))) (if cl-from-end (progn diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index e48376bbabd..c3d3feae876 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -154,7 +154,6 @@ every some mapcon - mapcan mapl maplist map @@ -365,7 +364,7 @@ The two cases that are handled are: `(list 'lambda '(&rest --cl-rest--) ,@(cl-sublis sub (nreverse decls)) (list 'apply - (list 'quote + (list 'function #'(lambda ,(append new (cadr f)) ,@(cl-sublis sub body))) ,@(nconc (mapcar (lambda (x) `(list 'quote ,x)) diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el index ac063d4896a..28b61880d0a 100644 --- a/lisp/emacs-lisp/cursor-sensor.el +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -31,6 +31,7 @@ ;;; Code: +;;;###autoload (defvar cursor-sensor-inhibit nil) (defun cursor-sensor--intangible-p (pos) @@ -113,7 +114,7 @@ ;; non-sticky on both ends, but that means get-pos-property might ;; never see it. (new (or (get-char-property point 'cursor-sensor-functions) - (unless (= point 1) + (unless (<= (point-min) point) (get-char-property (1- point) 'cursor-sensor-functions)))) (old (window-parameter window 'cursor-sensor--last-state)) (oldposmark (car old)) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 22a3f3935f2..5430b72545a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -279,7 +279,9 @@ That buffer should be current already." (goto-char (point-min)) (delete-region (point) (progn - (search-forward "\n debug(") + (search-forward (if debugger-stack-frame-as-list + "\n (debug " + "\n debug(")) (forward-line (if (eq (car args) 'debug) ;; Remove debug--implement-debug-on-entry ;; and the advice's `apply' frame. @@ -304,6 +306,24 @@ That buffer should be current already." (delete-char 1) (insert ? ) (beginning-of-line)) + ;; Watchpoint triggered. + ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) + (insert + "--" + (pcase details + (`(makunbound nil) (format "making %s void" symbol)) + (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" + symbol buffer)) + (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) + (`(let ,_) (format "let-binding %s to %S" symbol newval)) + (`(unlet ,_) (format "ending let-binding of %s" symbol)) + (`(set nil) (format "setting %s to %S" symbol newval)) + (`(set ,buffer) (format "setting %s in buffer %s to %S" + symbol buffer newval)) + (_ (error "unrecognized watchpoint triggered %S" (cdr args)))) + ": ") + (setq pos (point)) + (insert ?\n)) ;; Debugger entered for an error. (`error (insert "--Lisp error: ") @@ -848,6 +868,79 @@ To specify a nil argument interactively, exit with an empty minibuffer." (princ "Note: if you have redefined a function, then it may no longer\n") (princ "be set to debug on entry, even if it is in the list.")))))) +(defun debug--implement-debug-watch (symbol newval op where) + "Conditionally call the debugger. +This function is called when SYMBOL's value is modified." + (if (or inhibit-debug-on-entry debugger-jumping-flag) + nil + (let ((inhibit-debug-on-entry t)) + (funcall debugger 'watchpoint symbol newval op where)))) + +;;;###autoload +(defun debug-on-variable-change (variable) + "Trigger a debugger invocation when VARIABLE is changed. + +When called interactively, prompt for VARIABLE in the minibuffer. + +This works by calling `add-variable-watch' on VARIABLE. If you +quit from the debugger, this will abort the change (unless the +change is caused by the termination of a let-binding). + +The watchpoint may be circumvented by C code that changes the +variable directly (i.e., not via `set'). Changing the value of +the variable (e.g., `setcar' on a list variable) will not trigger +watchpoint. + +Use \\[cancel-debug-on-variable-change] to cancel the effect of +this command. Uninterning VARIABLE or making it an alias of +another symbol also cancels it." + (interactive + (let* ((var-at-point (variable-at-point)) + (var (and (symbolp var-at-point) var-at-point)) + (val (completing-read + (concat "Debug when setting variable" + (if var (format " (default %s): " var) ": ")) + obarray #'boundp + t nil nil (and var (symbol-name var))))) + (list (if (equal val "") var (intern val))))) + (add-variable-watcher variable #'debug--implement-debug-watch)) + +;;;###autoload +(defalias 'debug-watch #'debug-on-variable-change) + + +(defun debug--variable-list () + "List of variables currently set for debug on set." + (let ((vars '())) + (mapatoms + (lambda (s) + (when (memq #'debug--implement-debug-watch + (get s 'watchers)) + (push s vars)))) + vars)) + +;;;###autoload +(defun cancel-debug-on-variable-change (&optional variable) + "Undo effect of \\[debug-on-variable-change] on VARIABLE. +If VARIABLE is nil, cancel debug-on-variable-change for all variables. +When called interactively, prompt for VARIABLE in the minibuffer. +To specify a nil argument interactively, exit with an empty minibuffer." + (interactive + (list (let ((name + (completing-read + "Cancel debug on set for variable (default all variables): " + (mapcar #'symbol-name (debug--variable-list)) nil t))) + (when name + (unless (string= name "") + (intern name)))))) + (if variable + (remove-variable-watcher variable #'debug--implement-debug-watch) + (message "Canceling debug-watch for all variables") + (mapc #'cancel-debug-watch (debug--variable-list)))) + +;;;###autoload +(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change) + (provide 'debug) ;;; debug.el ends here diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index a615f9a5854..0f7691af0f4 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -137,6 +137,9 @@ BODY can start with a bunch of keyword arguments. The following keyword :abbrev-table TABLE Use TABLE instead of the default (CHILD-abbrev-table). A nil value means to simply use the same abbrev-table as the parent. +:after-hook FORM + A single lisp form which is evaluated after the mode hooks have been + run. It should not be quoted. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: @@ -184,7 +187,8 @@ See Info node `(elisp)Derived Modes' for more details." (declare-abbrev t) (declare-syntax t) (hook (derived-mode-hook-name child)) - (group nil)) + (group nil) + (after-hook nil)) ;; Process the keyword args. (while (keywordp (car body)) @@ -192,6 +196,7 @@ See Info node `(elisp)Derived Modes' for more details." (`:group (setq group (pop body))) (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) + (`:after-hook (setq after-hook (pop body))) (_ (pop body)))) (setq docstring (derived-mode-make-docstring @@ -272,7 +277,11 @@ No problems result if this variable is not bound. ,@body ) ;; Run the hooks, if any. - (run-mode-hooks ',hook))))) + (run-mode-hooks ',hook) + ,@(when after-hook + `((if delay-mode-hooks + (push ',after-hook delayed-after-hook-forms) + ,after-hook))))))) ;; PUBLIC: find the ultimate class of a derived mode. @@ -344,7 +353,7 @@ which more-or-less shadow%s %s's corresponding table%s." (format "`%s' " parent)) "might have run,\nthis mode ")) (format "runs the hook `%s'" hook) - ", as the final step\nduring initialization."))) + ", as the final or penultimate step\nduring initialization."))) (unless (string-match "\\\\[{[]" docstring) ;; And don't forget to put the mode's keymap. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index e67b0220e14..8506ed69669 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -54,9 +54,13 @@ OBJECT can be a symbol defined as a function, or a function itself \(a lambda expression or a compiled-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." - (interactive (list (intern (completing-read "Disassemble function: " - obarray 'fboundp t)) - nil 0 t)) + (interactive + (let* ((fn (function-called-at-point)) + (prompt (if fn (format "Disassemble function (default %s): " fn) + "Disassemble function: ")) + (def (and fn (symbol-name fn)))) + (list (intern (completing-read prompt obarray 'fboundp t nil nil def)) + nil 0 t))) (if (and (consp object) (not (functionp object))) (setq object `(lambda () ,object))) (or indent (setq indent 0)) ;Default indent to zero diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 6a4d835b63c..38295c302ea 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -108,9 +108,10 @@ Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), or an expression that returns either a keymap or a list of - arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP - argument that is not a symbol, this macro defines the variable - MODE-map and gives it the value that KEYMAP specifies. + (KEY . BINDING) pairs where KEY and BINDING are suitable for + `define-key'. If you supply a KEYMAP argument that is not a + symbol, this macro defines the variable MODE-map and gives it + the value that KEYMAP specifies. BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. @@ -252,7 +253,8 @@ Use the command `%s' to change this variable." pretty-name mode)) (t (let ((base-doc-string (concat "Non-nil if %s is enabled. -See the command `%s' for a description of this minor mode." +See the `%s' command +for a description of this minor mode." (if body " Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e8484fa1f94..66117b83316 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -233,6 +233,12 @@ If the result is non-nil, then break. Errors are ignored." :type 'number :group 'edebug) +(defcustom edebug-sit-on-break t + "Whether or not to pause for `edebug-sit-for-seconds' on reaching a break." + :type 'boolean + :group 'edebug + :version "26.1") + ;;; Form spec utilities. (defun get-edebug-spec (symbol) @@ -1927,6 +1933,7 @@ expressions; a `progn' form will be returned enclosing these forms." (def-edebug-spec defun (&define name lambda-list [&optional stringp] + [&optional ("declare" &rest sexp)] [&optional ("interactive" interactive)] def-body)) (def-edebug-spec defmacro @@ -2356,7 +2363,7 @@ MSG is printed after `::::} '." (defvar edebug-window-data) ; window and window-start for current function (defvar edebug-outside-windows) ; outside window configuration (defvar edebug-eval-buffer) ; for the evaluation list. -(defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows +(defvar edebug-outside-d-c-i-n-s-w) ; outside default cursor-in-non-selected-windows (defvar edebug-eval-list nil) ;; List of expressions to evaluate. @@ -2489,6 +2496,7 @@ MSG is printed after `::::} '." (progn ;; Display result of previous evaluation. (if (and edebug-break + edebug-sit-on-break (not (eq edebug-execution-mode 'Continue-fast))) (sit-for edebug-sit-for-seconds)) ; Show message. (edebug-previous-result))) @@ -3790,7 +3798,9 @@ Otherwise call `debug' normally." (forward-line 1) (delete-region last-ok-point (point))) - ((looking-at "^ edebug") + ((looking-at (if debugger-stack-frame-as-list + "^ (edebug" + "^ edebug")) (forward-line 1) (delete-region last-ok-point (point)) ))) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 7ee897093b2..413b94f01a8 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -188,7 +188,8 @@ Summary: (`no-applicable-method (setq method 'cl-no-applicable-method) (setq specializers `(generic ,@specializers)) - (lambda (generic arg &rest args) (apply code arg generic args))) + (lambda (generic arg &rest args) + (apply code arg (cl--generic-name generic) (cons arg args)))) (_ code)))) (cl-generic-define-method method (unless (memq kind '(nil :primary)) (list kind)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index fd8ae2abecb..624dccef075 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -460,7 +460,7 @@ See `defclass' for more information." (cl--slot-descriptor-initform (aref slots i))))) (setf (eieio--class-class-allocation-values newc) v)) - ;; Attach slot symbols into a hashtable, and store the index of + ;; Attach slot symbols into a hash table, and store the index of ;; this slot as the value this table. (let* ((slots (eieio--class-slots newc)) ;; (cslots (eieio--class-class-slots newc)) @@ -971,7 +971,7 @@ If a consistent order does not exist, signal an error." (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." - (let ((parents (eieio--class-parents (cl--find-class class)))) + (let ((parents (eieio--class-parents class))) (eieio--c3-merge-lists (list class) (append @@ -1065,6 +1065,7 @@ method invocation orders of the involved classes." (eieio--class-precedence-list (symbol-value tag)))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) + "Support for dispatch on types defined by EIEIO's `defclass'." ;; CLHS says: ;; A class must be defined before it can be used as a parameter ;; specializer in a defmethod form. @@ -1093,6 +1094,8 @@ method invocation orders of the involved classes." #'eieio--generic-subclass-specializers) (cl-defmethod cl-generic-generalizers ((_specializer (head subclass))) + "Support for (subclass CLASS) specializers. +These match if the argument is the name of a subclass of CLASS." (list eieio--generic-subclass-generalizer)) (provide 'eieio-core) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 9e5f524a945..2f1d69f78f8 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -162,7 +162,7 @@ are not abstract." (defun eieio-display-method-list () "Display a list of all the methods and what features are used." (interactive) - (let* ((meth1 (cl--generic-all-functions)) + (let* ((meth1 (cl-generic-all-functions)) (meth (sort meth1 (lambda (a b) (string< (symbol-name a) (symbol-name b))))) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 47aff333d44..fd77654f105 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -235,7 +235,7 @@ This method is obsolete." (let ((f (intern (format "%s-child-p" name)))) `((defalias ',f ',testsym2) (make-obsolete - ',f ,(format "use (cl-typep ... \\='%s) instead" name) + ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1")))) ;; When using typep, (typep OBJ 'myclass) returns t for objects which @@ -679,7 +679,7 @@ This class is not stored in the `parent' slot of a class vector." (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) (define-obsolete-function-alias 'standard-class - 'eieio-default-superclass "25.2") + 'eieio-default-superclass "26.1") (cl-defgeneric make-instance (class &rest initargs) "Make a new instance of CLASS based on INITARGS. @@ -815,7 +815,7 @@ first and modify the returned object.") (cl-defgeneric destructor (_this &rest _params) "Destructor for cleaning up any dynamic links to our object." - (declare (obsolete nil "25.2")) + (declare (obsolete nil "26.1")) ;; No cleanup... yet. nil) @@ -938,7 +938,7 @@ this object." This may create or delete slots, but does not affect the return value of `eq'." (error "EIEIO: `change-class' is unimplemented")) -(define-obsolete-function-alias 'change-class 'eieio-change-class "25.2") +(define-obsolete-function-alias 'change-class 'eieio-change-class "26.1") ;; Hook ourselves into help system for describing classes and methods. ;; FIXME: This is not actually needed any more since we can click on the diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index d5e7178b226..6c2f869f260 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -197,12 +197,23 @@ expression point is on." (t (kill-local-variable 'eldoc-message-commands) (remove-hook 'post-command-hook 'eldoc-schedule-timer t) - (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)))) + (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t) + (when eldoc-timer + (cancel-timer eldoc-timer) + (setq eldoc-timer nil))))) ;;;###autoload (define-minor-mode global-eldoc-mode - "Enable `eldoc-mode' in all buffers where it's applicable." - :group 'eldoc :global t + "Toggle Global Eldoc mode on or off. +With a prefix argument ARG, enable Global Eldoc mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is ‘toggle’. + +If Global Eldoc mode is on, `eldoc-mode' will be enabled in all +buffers where it's applicable. These are buffers that have modes +that have enabled eldoc support. See `eldoc-documentation-function'." + :group 'eldoc + :global t :initialize 'custom-initialize-delay :init-value t (setq eldoc-last-message nil) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index eb10c845d3f..2a2418fa7d2 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -285,46 +285,6 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (kill-buffer clone))))))) -(defmacro ert-with-function-mocked (name mock &rest body) - "Mocks function NAME with MOCK and run BODY. - -Once BODY finishes (be it normally by returning a value or -abnormally by throwing or signalling), the old definition of -function NAME is restored. - -BODY may further change the mock with `fset'. - -If MOCK is nil, the function NAME is mocked with a function -`ert-fail'ing when called. - -For example: - - ;; Regular use, function is mocked inside the BODY: - (should (eq 2 (+ 1 1))) - (ert-with-function-mocked ((+ (lambda (a b) (- a b)))) - (should (eq 0 (+ 1 1)))) - (should (eq 2 (+ 1 1))) - - ;; Macro correctly recovers from a throw or signal: - (should - (catch 'done - (ert-with-function-mocked ((+ (lambda (a b) (- a b)))) - (should (eq 0 (+ 1 1)))) - (throw 'done t))) - (should (eq 2 (+ 1 1))) -" - (declare (indent 2)) - (let ((old-var (make-symbol "old-var")) - (mock-var (make-symbol "mock-var"))) - `(let ((,old-var (symbol-function (quote ,name))) (,mock-var ,mock)) - (fset (quote ,name) - (or ,mock-var (lambda (&rest _) - (ert-fail (concat "`" ,(symbol-name name) - "' unexpectedly called."))))) - (unwind-protect - (progn ,@body) - (fset (quote ,name) ,old-var))))) - (provide 'ert-x) ;;; ert-x.el ends here diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7a914da3977..89f83ddff43 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -276,11 +276,12 @@ DATA is displayed to the user and should state the reason for skipping." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - (macroexpand form (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment))))) + (macroexpand form (append byte-compile-macro-environment + (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (cl-gensym "value-"))) @@ -1470,7 +1471,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." (user-error "This function is only for use in batch mode")) (let ((nlogs (length command-line-args-left)) (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) - nnotrun logfile notests badtests unexpected) + nnotrun logfile notests badtests unexpected skipped) (with-temp-buffer (while (setq logfile (pop command-line-args-left)) (erase-buffer) @@ -1490,9 +1491,10 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (push logfile unexpected) (setq nunexpected (+ nunexpected (string-to-number (match-string 4))))) - (if (match-string 5) - (setq nskipped (+ nskipped - (string-to-number (match-string 5))))))))) + (when (match-string 5) + (push logfile skipped) + (setq nskipped (+ nskipped + (string-to-number (match-string 5))))))))) (setq nnotrun (- ntests nrun)) (message "\nSUMMARY OF TEST RESULTS") (message "-----------------------") @@ -1516,6 +1518,26 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (when unexpected (message "%d files contained unexpected results:" (length unexpected)) (mapc (lambda (l) (message " %s" l)) unexpected)) + ;; More details on hydra, where the logs are harder to get to. + (when (and (getenv "NIX_STORE") + (not (zerop (+ nunexpected nskipped)))) + (message "\nDETAILS") + (message "-------") + (with-temp-buffer + (dolist (x (list (list skipped "skipped" "SKIPPED") + (list unexpected "unexpected" "FAILED"))) + (mapc (lambda (l) + (erase-buffer) + (insert-file-contents l) + (message "%s:" l) + (when (re-search-forward (format "^[ \t]*[0-9]+ %s results:" + (nth 1 x)) + nil t) + (while (and (zerop (forward-line 1)) + (looking-at (format "^[ \t]*%s" (nth 2 x)))) + (message "%s" (buffer-substring (line-beginning-position) + (line-end-position)))))) + (car x))))) (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2) (unexpected 1) (t 0))))) @@ -2460,7 +2482,7 @@ To be used in the ERT results buffer." stats) for end-time across (ert--stats-test-end-times stats) collect (list test - (float-time (subtract-time + (float-time (time-subtract end-time start-time)))))) (setq data (sort data (lambda (a b) (> (cl-second a) (cl-second b))))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 0575ce49f80..cbb134e95d5 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -43,6 +43,8 @@ ;;; Code: +(require 'seq) + ;;; User variables: (defgroup find-function nil @@ -103,7 +105,7 @@ Please send improvements and fixes to the maintainer." (defcustom find-feature-regexp (concat ";;; Code:") "The regexp used by `xref-find-definitions' when searching for a feature definition. -Note it must contain a `%s' at the place where `format' +Note it may contain up to one `%s' at the place where `format' should insert the feature name." ;; We search for ";;; Code" rather than (feature '%s) because the ;; former is near the start of the code, and the latter is very @@ -111,7 +113,7 @@ should insert the feature name." ;; (point-min), which is acceptable in this case. :type 'regexp :group 'xref - :version "25.0") + :version "25.1") (defcustom find-alias-regexp "(defalias +'%s" @@ -120,7 +122,7 @@ Note it must contain a `%s' at the place where `format' should insert the feature name." :type 'regexp :group 'xref - :version "25.0") + :version "25.1") (defvar find-function-regexp-alist '((nil . find-function-regexp) @@ -182,15 +184,15 @@ See the functions `find-function' and `find-variable'." LIBRARY should be a string (the name of the library)." ;; If the library is byte-compiled, try to find a source library by ;; the same name. - (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) - (setq library (replace-match "" t t library))) + (when (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) + (setq library (replace-match "" t t library))) (or (locate-file library - (or find-function-source-path load-path) - (find-library-suffixes)) + (or find-function-source-path load-path) + (find-library-suffixes)) (locate-file library - (or find-function-source-path load-path) - load-file-rep-suffixes) + (or find-function-source-path load-path) + load-file-rep-suffixes) (when (file-name-absolute-p library) (let ((rel (find-library--load-name library))) (when rel @@ -201,8 +203,44 @@ LIBRARY should be a string (the name of the library)." (locate-file rel (or find-function-source-path load-path) load-file-rep-suffixes))))) + (find-library--from-load-path library) (error "Can't find library %s" library))) +(defun find-library--from-load-path (library) + ;; In `load-history', the file may be ".elc", ".el", ".el.gz", and + ;; LIBRARY may be "foo.el" or "foo", so make sure that we get all + ;; potential matches, and then see whether any of them lead us to an + ;; ".el" or an ".el.gz" file. + (let* ((elc-regexp "\\.el\\(c\\(\\..*\\)?\\)\\'") + (suffix-regexp + (concat "\\(" + (mapconcat 'regexp-quote (find-library-suffixes) "\\'\\|") + "\\|" elc-regexp "\\)\\'")) + (potentials + (mapcar + (lambda (entry) + (if (string-match suffix-regexp (car entry)) + (replace-match "" t t (car entry)) + (car entry))) + (seq-filter + (lambda (entry) + (string-match + (concat "\\`" + (regexp-quote + (replace-regexp-in-string suffix-regexp "" library)) + suffix-regexp) + (file-name-nondirectory (car entry)))) + load-history))) + result) + (dolist (file potentials) + (dolist (suffix (find-library-suffixes)) + (when (not result) + (cond ((file-exists-p file) + (setq result file)) + ((file-exists-p (concat file suffix)) + (setq result (concat file suffix))))))) + result)) + (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) (if (file-accessible-directory-p dir) dir)) @@ -255,9 +293,12 @@ TYPE should be nil to find a function, or `defvar' to find a variable." (cons (current-buffer) (match-beginning 0)))) ;;;###autoload -(defun find-library (library) +(defun find-library (library &optional other-window) "Find the Emacs Lisp source of LIBRARY. -LIBRARY should be a string (the name of the library)." +LIBRARY should be a string (the name of the library). If the +optional OTHER-WINDOW argument (i.e., the command argument) is +specified, pop to a different window before displaying the +buffer." (interactive (let* ((dirs (or find-function-source-path load-path)) (suffixes (find-library-suffixes)) @@ -279,11 +320,17 @@ LIBRARY should be a string (the name of the library)." (when (and def (not (test-completion def table))) (setq def nil)) (list - (completing-read (if def (format "Library name (default %s): " def) + (completing-read (if def + (format "Library name (default %s): " def) "Library name: ") - table nil nil nil nil def)))) - (let ((buf (find-file-noselect (find-library-name library)))) - (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) + table nil nil nil nil def) + current-prefix-arg))) + (prog1 + (funcall (if other-window + 'pop-to-buffer + 'pop-to-buffer-same-window) + (find-file-noselect (find-library-name library))) + (run-hooks 'find-function-after-hook))) ;;;###autoload (defun find-function-search-for-symbol (symbol type library) @@ -357,8 +404,10 @@ signal an error. If VERBOSE is non-nil, and FUNCTION is an alias, display a message about the whole chain of aliases." - (let ((def (if (symbolp function) - (find-function-advised-original function))) + (let ((def (when (symbolp function) + (or (fboundp function) + (signal 'void-function (list function))) + (find-function-advised-original function))) aliases) ;; FIXME for completeness, it might be nice to print something like: ;; foo (which is advised), which is an alias for bar (which is advised). diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 93572e5e658..fa7ac64bf04 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -536,7 +536,7 @@ This macro only makes sense when used in a place." "Return a reference to PLACE. This is like the `&' operator of the C language. Note: this only works reliably with lexical binding mode, except for very -simple PLACEs such as (function-symbol \\='foo) which will also work in dynamic +simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic binding mode." (let ((code (gv-letplace (getter setter) place diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index 3507a395436..d7069174c1b 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -76,6 +76,11 @@ symbol, and each cdr is the same symbol without the `.'." ;; with other results in the clause below. (list (cons data (intern (replace-match "" nil nil name))))))) ((not (consp data)) nil) + ((eq (car data) 'let-alist) + ;; For nested ‘let-alist’ forms, ignore symbols appearing in the + ;; inner body because they don’t refer to the alist currently + ;; being processed. See Bug#24641. + (let-alist--deep-dot-search (cadr data))) (t (append (let-alist--deep-dot-search (car data)) (let-alist--deep-dot-search (cdr data)))))) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 7d5b7dc749d..46373da5eb9 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -265,17 +265,16 @@ a section." (defun lm-header (header) "Return the contents of the header named HEADER." - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) - ;; RCS ident likes format "$identifier: data$" - (looking-at - (if (save-excursion - (skip-chars-backward "^$" (match-beginning 0)) - (= (point) (match-beginning 0))) - "[^\n]+" "[^$\n]+"))) - (match-string-no-properties 0))))) + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) + ;; RCS ident likes format "$identifier: data$" + (looking-at + (if (save-excursion + (skip-chars-backward "^$" (match-beginning 0)) + (= (point) (match-beginning 0))) + "[^\n]+" "[^$\n]+"))) + (match-string-no-properties 0)))) (defun lm-header-multiline (header) "Return the contents of the header named HEADER, with continuation lines. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b4bb3b0acce..a277d7a6680 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -58,7 +58,7 @@ (setq i (1+ i))) (modify-syntax-entry ?\s " " table) ;; Non-break space acts as whitespace. - (modify-syntax-entry ?\x8a0 " " table) + (modify-syntax-entry ?\xa0 " " table) (modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\n "> " table) @@ -398,6 +398,9 @@ This will generate compile-time constants from BINDINGS." lisp-el-font-lock-keywords-1 `( ;; Regexp negated char group. ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) + ;; Erroneous structures. + (,(concat "(" el-errs-re "\\_>") + (1 font-lock-warning-face)) ;; Control structures. Common Lisp forms. (lisp--el-match-keyword . 1) ;; Exit/Feature symbols as constants. @@ -405,9 +408,6 @@ This will generate compile-time constants from BINDINGS." "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?") (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - ;; Erroneous structures. - (,(concat "(" el-errs-re "\\_>") - (1 font-lock-warning-face prepend)) ;; Words inside \\[] tend to be for `substitute-command-keys'. (,(concat "\\\\\\\\\\[\\(" lisp-mode-symbol-regexp "\\)\\]") (1 font-lock-constant-face prepend)) @@ -1216,8 +1216,15 @@ and initial semicolons." ;; ;; The `fill-column' is temporarily bound to ;; `emacs-lisp-docstring-fill-column' if that value is an integer. - (let ((paragraph-start (concat paragraph-start - "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)")) + (let ((paragraph-start + (concat paragraph-start + (format "\\|\\s-*\\([(;%s\"]\\|`(\\|#'(\\)" + ;; If we're inside a string (like the doc + ;; string), don't consider a colon to be + ;; a paragraph-start character. + (if (nth 3 (syntax-ppss)) + "" + ":")))) (paragraph-separate (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) (fill-column (if (and (integerp emacs-lisp-docstring-fill-column) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 764d01ce6db..ea7cce67be7 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -587,7 +587,11 @@ Interactively, the behavior depends on `narrow-to-defun-include-comments'." Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR of the pair whose key is equal to the last input character with -or without modifiers, are inserted by `insert-pair'.") +or without modifiers, are inserted by `insert-pair'. + +If COMMAND-CHAR is specified, it is a character that triggers the +insertion of the open/close pair, and COMMAND-CHAR itself isn't +inserted.") (defun insert-pair (&optional arg open close) "Enclose following ARG sexps in a pair of OPEN and CLOSE characters. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index ed4d6e49a93..6d89145c6a2 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -103,7 +103,7 @@ each clause." (defun macroexp--funcall-if-compiled (_form) "Pseudo function used internally by macroexp to delay warnings. The purpose is to delay warnings to bytecomp.el, so they can use things -like `byte-compile-log-warning' to get better file-and-line-number data +like `byte-compile-warn' to get better file-and-line-number data and also to avoid outputting the warning during normal execution." nil) (put 'macroexp--funcall-if-compiled 'byte-compile @@ -122,7 +122,7 @@ and also to avoid outputting the warning during normal execution." (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key)) (defun macroexp--warn-and-return (msg form &optional compile-only) - (let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) + (let ((when-compiled (lambda () (byte-compile-warn "%s" msg)))) (cond ((null msg) form) ((macroexp--compiling-p) @@ -261,7 +261,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (format "%s quoted with ' rather than with #'" (list 'lambda (nth 1 f) '...)) (macroexp--expand-all `(,fun ,arg1 ,f . ,args)))) - (`(funcall (,(or 'quote 'function) ,(and f (pred symbolp)) . ,_) . ,args) + (`(funcall #',(and f (pred symbolp)) . ,args) ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' ;; has a compiler-macro. (macroexp--expand-all `(,f . ,args))) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 86057706ffc..02770d59e2b 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -144,8 +144,7 @@ Returns the number of actions taken." (cons prompt map)) 'quit)) ;; Prompt in the echo area. - (let ((cursor-in-echo-area (not no-cursor-in-echo-area)) - (message-log-max nil)) + (let ((cursor-in-echo-area (not no-cursor-in-echo-area))) (message (apply 'propertize "%s(y, n, !, ., q, %sor %s) " minibuffer-prompt-properties) prompt user-keys diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ec8d3d79d9f..0a0f64a0761 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 1.0 +;; Version: 1.1 ;; Package: map ;; Maintainer: emacs-devel@gnu.org @@ -43,6 +43,7 @@ ;;; Code: (require 'seq) +(eval-when-compile (require 'cl-lib)) (pcase-defmacro map (&rest args) "Build a `pcase' pattern matching map elements. @@ -78,14 +79,14 @@ MAP can be a list, hash-table or array." (eval-when-compile (defmacro map--dispatch (map-var &rest args) - "Evaluate one of the forms specified by ARGS based on the type of MAP. + "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR. The following keyword types are meaningful: `:list', `:hash-table' and `:array'. -An error is thrown if MAP is neither a list, hash-table nor array. +An error is thrown if MAP-VAR is neither a list, hash-table nor array. -Return RESULT if non-nil or the result of evaluation of the form." +Returns the result of evaluating the form associated with MAP-VAR's type." (declare (debug t) (indent 1)) `(cond ((listp ,map-var) ,(plist-get args :list)) ((hash-table-p ,map-var) ,(plist-get args :hash-table)) @@ -123,33 +124,26 @@ MAP can be a list, hash-table or array." default))) (defmacro map-put (map key value) - "Associate KEY with VALUE in MAP and return MAP. + "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value with VALUE. MAP can be a list, hash-table or array." - (macroexp-let2 nil map map - `(progn - (setf (map-elt ,map ,key) ,value) - ,map))) + `(setf (map-elt ,map ,key) ,value)) -(defmacro map-delete (map key) +(defun map-delete (map key) "Delete KEY from MAP and return MAP. No error is signaled if KEY is not a key of MAP. If MAP is an array, store nil at the index KEY. MAP can be a list, hash-table or array." - (declare (debug t)) - (gv-letplace (mgetter msetter) `(gv-delay-error ,map) - (macroexp-let2 nil key key - `(if (not (listp ,mgetter)) - (map--delete ,mgetter ,key) - ;; The alist case is special, since it can't be handled by the - ;; map--delete function. - (setf (alist-get ,key (gv-synthetic-place ,mgetter ,msetter) - nil t) - nil) - ,mgetter)))) + (map--dispatch map + :list (setf (alist-get key map nil t) nil) + :hash-table (remhash key map) + :array (and (>= key 0) + (<= key (seq-length map)) + (aset map key nil))) + map) (defun map-nested-elt (map keys &optional default) "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. @@ -207,6 +201,16 @@ MAP can be a list, hash-table or array." function map)) +(defun map-do (function map) + "Apply FUNCTION to each element of MAP and return nil. +FUNCTION.is called with two arguments, the key and the value." + (funcall (map--dispatch map + :list #'map--do-alist + :hash-table #'maphash + :array #'map--do-array) + function + map)) + (defun map-keys-apply (function map) "Return the result of applying FUNCTION to each key of MAP. @@ -256,7 +260,7 @@ MAP can be a list, hash-table or array." :hash-table (zerop (hash-table-count map)))) (defun map-contains-key (map key &optional testfn) - "Return non-nil if MAP contain KEY, nil otherwise. + "If MAP contain KEY return KEY, nil otherwise. Equality is defined by TESTFN if non-nil or by `equal' if nil. MAP can be a list, hash-table or array." @@ -289,27 +293,33 @@ MAP can be a list, hash-table or array." "Merge into a map of type TYPE all the key/value pairs in MAPS. MAP can be a list, hash-table or array." - (let (result) + (let ((result (map-into (pop maps) type))) (while maps + ;; FIXME: When `type' is `list', we get an O(N^2) behavior. + ;; For small tables, this is fine, but for large tables, we + ;; should probably use a hash-table internally which we convert + ;; to an alist in the end. (map-apply (lambda (key value) - (setf (map-elt result key) value)) - (pop maps))) - (map-into result type))) + (setf (map-elt result key) value)) + (pop maps))) + result)) (defun map-merge-with (type function &rest maps) "Merge into a map of type TYPE all the key/value pairs in MAPS. When two maps contain the same key, call FUNCTION on the two values and use the value returned by it. MAP can be a list, hash-table or array." - (let (result) + (let ((result (map-into (pop maps) type)) + (not-found (cons nil nil))) (while maps (map-apply (lambda (key value) - (setf (map-elt result key) - (if (map-contains-key result key) - (funcall function (map-elt result key) value) - value))) - (pop maps))) - (map-into result type))) + (cl-callf (lambda (old) + (if (eq old not-found) + value + (funcall function old value))) + (map-elt result key not-found))) + (pop maps))) + result)) (defun map-into (map type) "Convert the map MAP into a map of type TYPE. @@ -337,15 +347,6 @@ MAP can be a list, hash-table or array." (cdr pair))) map)) -(defun map--delete (map key) - (map--dispatch map - :list (error "No place to remove the mapping for %S" key) - :hash-table (remhash key map) - :array (and (>= key 0) - (<= key (seq-length map)) - (aset map key nil))) - map) - (defun map--apply-hash-table (function map) "Private function used to apply FUNCTION over MAP, MAP being a hash-table." (let (result) @@ -363,6 +364,20 @@ MAP can be a list, hash-table or array." (setq index (1+ index)))) map))) +(defun map--do-alist (function alist) + "Private function used to iterate over ALIST using FUNCTION." + (seq-do (lambda (pair) + (funcall function + (car pair) + (cdr pair))) + alist)) + +(defun map--do-array (function array) + "Private function used to iterate over ARRAY using FUNCTION." + (seq-do-indexed (lambda (elt index) + (funcall function index elt)) + array)) + (defun map--into-hash-table (map) "Convert MAP into a hash-table." (let ((ht (make-hash-table :size (map-length map) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 1d4c3f0586c..1b30499bf19 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -114,7 +114,10 @@ Each element has the form (WHERE BYTECODE STACK) where: (usage (help-split-fundoc origdoc function))) (setq usage (if (null usage) (let ((arglist (help-function-arglist flist))) - (help--make-usage-docstring function arglist)) + ;; "[Arg list not available until function + ;; definition is loaded]", bug#21299 + (if (stringp arglist) t + (help--make-usage-docstring function arglist))) (setq origdoc (cdr usage)) (car usage))) (help-add-fundoc-usage (concat docstring origdoc) usage)))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 869c1549658..ef129e998c2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -146,6 +146,7 @@ (eval-when-compile (require 'subr-x)) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'epg)) ;For setf accessors. +(require 'seq) (require 'tabulated-list) (require 'macroexp) @@ -301,10 +302,12 @@ contrast, `package-user-dir' contains packages for personal use." :risky t :version "24.1") -(defvar epg-gpg-program) +(declare-function epg-find-configuration "epg-config" + (protocol &optional no-cache program-alist)) (defcustom package-check-signature - (if (progn (require 'epg-config) (executable-find epg-gpg-program)) + (if (and (require 'epg-config) + (epg-find-configuration 'OpenPGP)) 'allow-unsigned) "Non-nil means to check package signatures when installing. The value `allow-unsigned' means to still install a package even if @@ -789,7 +792,7 @@ untar into a directory named DIR; otherwise, signal an error." (tar-mode) ;; Make sure everything extracts into DIR. (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (memq system-type '(windows-nt ms-dos cygwin)))) + (case-fold-search (file-name-case-insensitive-p dir))) (dolist (tar-data tar-parse-info) (let ((name (expand-file-name (tar-header-name tar-data)))) (or (string-match regexp name) @@ -1078,6 +1081,8 @@ The return result is a `package-desc'." (setq files nil) ;; set the 'dir kind, (setf (package-desc-kind info) 'dir)))) + (unless info + (error "No .el files with package headers in `%s'" default-directory)) ;; and return the info. info)))) @@ -1158,38 +1163,43 @@ errors signaled by ERROR-FORM or by BODY). (setq body (cdr (cdr body)))) (macroexp-let2* nil ((url-1 url) (noerror-1 noerror)) - `(cl-macrolet ((unless-error (body-2 &rest before-body) - (let ((err (make-symbol "err"))) - `(with-temp-buffer - (when (condition-case ,err - (progn ,@before-body t) - ,(list 'error ',error-form - (list 'unless ',noerror-1 - `(signal (car ,err) (cdr ,err))))) - ,@body-2))))) - (if (string-match-p "\\`https?:" ,url-1) - (let* ((url (concat ,url-1 ,file)) - (callback (lambda (status) - (let ((b (current-buffer))) - (require 'url-handlers) - (unless-error ,body - (when-let ((er (plist-get status :error))) - (error "Error retrieving: %s %S" url er)) - (with-current-buffer b - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (error "Error retrieving: %s %S" url "incomprehensible buffer"))) - (url-insert-buffer-contents b url) - (kill-buffer b) - (goto-char (point-min))))))) - (if ,async - (unless-error nil (url-retrieve url callback nil 'silent)) - (unless-error ,body (url-insert-file-contents url)))) - (unless-error ,body - (let ((url (expand-file-name ,file ,url-1))) - (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" url)) - (insert-file-contents url))))))) + (let ((url-sym (make-symbol "url")) + (b-sym (make-symbol "b-sym"))) + `(cl-macrolet ((unless-error (body-2 &rest before-body) + (let ((err (make-symbol "err"))) + `(with-temp-buffer + (when (condition-case ,err + (progn ,@before-body t) + ,(list 'error ',error-form + (list 'unless ',noerror-1 + `(signal (car ,err) (cdr ,err))))) + ,@body-2))))) + (if (string-match-p "\\`https?:" ,url-1) + (let ((,url-sym (concat ,url-1 ,file))) + (if ,async + (unless-error nil + (url-retrieve ,url-sym + (lambda (status) + (let ((,b-sym (current-buffer))) + (require 'url-handlers) + (unless-error ,body + (when-let ((er (plist-get status :error))) + (error "Error retrieving: %s %S" ,url-sym er)) + (with-current-buffer ,b-sym + (goto-char (point-min)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer"))) + (url-insert-buffer-contents ,b-sym ,url-sym) + (kill-buffer ,b-sym) + (goto-char (point-min))))) + nil + 'silent)) + (unless-error ,body (url-insert-file-contents ,url-sym)))) + (unless-error ,body + (let ((url (expand-file-name ,file ,url-1))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents url)))))))) (define-error 'bad-signature "Failed to verify signature") @@ -1217,7 +1227,7 @@ errors." (unless (and (eq package-check-signature 'allow-unsigned) (eq (epg-signature-status sig) 'no-pubkey)) (setq had-fatal-error t)))) - (when (and (null good-signatures) had-fatal-error) + (when (or (null good-signatures) had-fatal-error) (package--display-verify-error context sig-file) (signal 'bad-signature (list sig-file))) good-signatures))) @@ -1429,7 +1439,10 @@ If `user-init-file' does not mention `(package-initialize)', add it to the file. If called as part of loading `user-init-file', set `package-enable-at-startup' to nil, to prevent accidentally -loading packages twice." +loading packages twice. +It is not necessary to adjust `load-path' or `require' the +individual packages after calling `package-initialize' -- this is +taken care of by `package-initialize'." (interactive) (setq package-alist nil) (if (equal user-init-file load-file-name) @@ -1456,8 +1469,6 @@ loading packages twice." (defvar package--downloads-in-progress nil "List of in-progress asynchronous downloads.") -(declare-function epg-find-configuration "epg-config" - (protocol &optional force)) (declare-function epg-import-keys-from-file "epg" (context keys)) ;;;###autoload @@ -1557,12 +1568,6 @@ downloads in the background." (let ((default-keyring (expand-file-name "package-keyring.gpg" data-directory)) (inhibit-message async)) - (if (get 'package-check-signature 'saved-value) - (when package-check-signature - (epg-find-configuration 'OpenPGP)) - (setq package-check-signature - (if (epg-find-configuration 'OpenPGP) - 'allow-unsigned))) (when (and package-check-signature (file-exists-p default-keyring)) (condition-case-unless-debug error (package-import-keyring default-keyring) @@ -1870,6 +1875,7 @@ add a call to it along with some explanatory comments." (file-readable-p user-init-file) (file-writable-p user-init-file)) (let* ((buffer (find-buffer-visiting user-init-file)) + buffer-name (contains-init (if buffer (with-current-buffer buffer @@ -1885,8 +1891,12 @@ add a call to it along with some explanatory comments." (re-search-forward "(package-initialize\\_>" nil 'noerror))))) (unless contains-init (with-current-buffer (or buffer - (let ((delay-mode-hooks t)) + (let ((delay-mode-hooks t) + (find-file-visit-truename t)) (find-file-noselect user-init-file))) + (when buffer + (setq buffer-name (buffer-file-name)) + (set-visited-file-name (file-chase-links user-init-file))) (save-excursion (save-restriction (widen) @@ -1905,7 +1915,10 @@ add a call to it along with some explanatory comments." (insert "\n")) (let ((file-precious-flag t)) (save-buffer)) - (unless buffer + (if buffer + (progn + (set-visited-file-name buffer-name) + (set-buffer-modified-p nil)) (kill-buffer (current-buffer))))))))) (setq package--init-file-ensured t)) @@ -1989,7 +2002,8 @@ Downloads and installs required packages as needed." ((derived-mode-p 'tar-mode) (package-tar-file-info)) (t - (package-buffer-info)))) + (save-excursion + (package-buffer-info))))) (name (package-desc-name pkg-desc))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) @@ -2027,17 +2041,21 @@ If some packages are not installed propose to install them." ;; gets installed). (if (not package-selected-packages) (message "`package-selected-packages' is empty, nothing to install") - (cl-loop for p in package-selected-packages - unless (package-installed-p p) - collect p into lst - finally - (if lst - (when (y-or-n-p - (format "%s packages will be installed:\n%s, proceed?" - (length lst) - (mapconcat #'symbol-name lst ", "))) - (mapc #'package-install lst)) - (message "All your packages are already installed"))))) + (let* ((not-installed (seq-remove #'package-installed-p package-selected-packages)) + (available (seq-filter (lambda (p) (assq p package-archive-contents)) not-installed)) + (difference (- (length not-installed) (length available)))) + (cond + (available + (when (y-or-n-p + (format "%s packages will be installed:\n%s, proceed?" + (length available) + (mapconcat #'symbol-name available ", "))) + (mapc (lambda (p) (package-install p 'dont-select)) available))) + ((> difference 0) + (message "%s packages are not available (the rest already installed), maybe you need to `M-x package-refresh-contents'" + difference)) + (t + (message "All your packages are already installed")))))) ;;; Package Deletion @@ -2243,13 +2261,13 @@ Otherwise no newline is inserted." (package--print-help-section "Status") (cond (built-in (insert (propertize (capitalize status) - 'font-lock-face 'package-status-builtin-face) + 'font-lock-face 'package-status-built-in) ".")) (pkg-dir (insert (propertize (if (member status '("unsigned" "dependency")) "Installed" (capitalize status)) - 'font-lock-face 'package-status-builtin-face)) + 'font-lock-face 'package-status-built-in)) (insert (substitute-command-keys " in `")) (let ((dir (abbreviate-file-name (file-name-as-directory @@ -2262,7 +2280,7 @@ Otherwise no newline is inserted." (insert (substitute-command-keys "',\n shadowing a ") (propertize "built-in package" - 'font-lock-face 'package-status-builtin-face)) + 'font-lock-face 'package-status-built-in)) (insert (substitute-command-keys "'"))) (if signed (insert ".") @@ -2814,13 +2832,14 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." "Face used on package description summaries in the package menu." :version "25.1") +;; Shame this hyphenates "built-in", when "font-lock-builtin-face" doesn't. (defface package-status-built-in '((t :inherit font-lock-builtin-face)) "Face used on the status and version of built-in packages." :version "25.1") (defface package-status-external - '((t :inherit package-status-builtin-face)) + '((t :inherit package-status-built-in)) "Face used on the status and version of external packages." :version "25.1") diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7e164c0fe5c..896ad925928 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -298,6 +298,8 @@ any kind of error." ;;;###autoload (defmacro pcase-dolist (spec &rest body) + "Like `dolist' but where the binding can be a `pcase' pattern. +\n(fn (PATTERN LIST) BODY...)" (declare (indent 1) (debug ((pcase-PAT form) body))) (if (pcase--trivial-upat-p (car spec)) `(dolist ,spec ,@body) @@ -509,6 +511,7 @@ MATCH is the pattern that needs to be matched, of the form: (numberp . stringp) (numberp . byte-code-function-p) (consp . arrayp) + (consp . atom) (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el new file mode 100644 index 00000000000..8146bb3c283 --- /dev/null +++ b/lisp/emacs-lisp/radix-tree.el @@ -0,0 +1,246 @@ +;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; This file is part of GNU Emacs. + +;; 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; There are many different options for how to represent radix trees +;; in Elisp. Here I chose a very simple one. A radix-tree can be either: +;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string +;; meaning that everything that starts with PREFIX is in PTREE, +;; and everything else in RTREE. It also has the property that +;; everything that starts with the first letter of PREFIX but not with +;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all). +;; - anything else is taken as the value to associate with the empty string. +;; So every node is basically an (improper) alist where each mapping applies +;; to a different leading letter. +;; +;; The main downside of this representation is that the lookup operation +;; is slower because each level of the tree is an alist rather than some kind +;; of array, so every level's lookup is O(N) rather than O(1). We could easily +;; solve this by using char-tables instead of alists, but that would make every +;; level take up a lot more memory, and it would make the resulting +;; data structure harder to read (by a human) when printed out. + +;;; Code: + +(defun radix-tree--insert (tree key val i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil key i ni))) + (if (eq t cmp) + (let ((nptree (radix-tree--insert ptree key val ni))) + `((,prefix . ,nptree) . ,rtree)) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--insert rtree key val i))) + `((,prefix . ,ptree) . ,nrtree)) + (let* ((nprefix (substring prefix 0 n)) + (kprefix (substring key (+ i n))) + (pprefix (substring prefix n)) + (ktree (if (equal kprefix "") val + `((,kprefix . ,val))))) + `((,nprefix + . ((,pprefix . ,ptree) . ,ktree)) + . ,rtree))))))) + (_ + (if (= (length key) i) val + (let ((prefix (substring key i))) + `((,prefix . ,val) . ,tree)))))) + +(defun radix-tree--remove (tree key i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil key i ni))) + (if (eq t cmp) + (pcase (radix-tree--remove ptree key ni) + (`nil rtree) + (`((,pprefix . ,pptree)) + `((,(concat prefix pprefix) . ,pptree) . ,rtree)) + (nptree `((,prefix . ,nptree) . ,rtree))) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--remove rtree key i))) + `((,prefix . ,ptree) . ,nrtree)) + tree))))) + (_ + (if (= (length key) i) nil tree)))) + + +(defun radix-tree--lookup (tree string i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--lookup ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (radix-tree--lookup rtree string i) + (+ i n)))))) + (val + (if (and val (equal (length string) i)) + (if (integerp val) `(t . ,val) val) + i)))) + +;; (defun radix-tree--trim (tree string i) +;; (if (= i (length string)) +;; tree +;; (pcase tree +;; (`((,prefix . ,ptree) . ,rtree) +;; (let* ((ni (+ i (length prefix))) +;; (cmp (compare-strings prefix nil nil string i ni)) +;; ;; FIXME: We could compute nrtree more efficiently +;; ;; whenever cmp is not -1 or 1. +;; (nrtree (radix-tree--trim rtree string i))) +;; (if (eq t cmp) +;; (pcase (radix-tree--trim ptree string ni) +;; (`nil nrtree) +;; (`((,pprefix . ,pptree)) +;; `((,(concat prefix pprefix) . ,pptree) . ,nrtree)) +;; (nptree `((,prefix . ,nptree) . ,nrtree))) +;; (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) +;; (cond +;; ((equal (+ n i) (length string)) +;; `((,prefix . ,ptree) . ,nrtree)) +;; (t nrtree)))))) +;; (val val)))) + +(defun radix-tree--prefixes (tree string i prefixes) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil string i ni)) + ;; FIXME: We could compute prefixes more efficiently + ;; whenever cmp is not -1 or 1. + (prefixes (radix-tree--prefixes rtree string i prefixes))) + (if (eq t cmp) + (radix-tree--prefixes ptree string ni prefixes) + prefixes))) + (val + (if (null val) + prefixes + (cons (cons (substring string 0 i) + (if (eq (car-safe val) t) (cdr val) val)) + prefixes))))) + +(defun radix-tree--subtree (tree string i) + (if (equal (length string) i) tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--subtree ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (cond + ((zerop n) (radix-tree--subtree rtree string i)) + ((equal (+ n i) (length string)) + (let ((nprefix (substring prefix n))) + `((,nprefix . ,ptree)))) + (t nil)))))) + (_ nil)))) + +;;; Entry points + +(defconst radix-tree-empty nil + "The empty radix-tree.") + +(defun radix-tree-insert (tree key val) + "Insert a mapping from KEY to VAL in radix TREE." + (when (consp val) (setq val `(t . ,val))) + (if val (radix-tree--insert tree key val 0) + (radix-tree--remove tree key 0))) + +(defun radix-tree-lookup (tree key) + "Return the value associated to KEY in radix TREE. +If not found, return nil." + (pcase (radix-tree--lookup tree key 0) + (`(t . ,val) val) + ((pred numberp) nil) + (val val))) + +(defun radix-tree-subtree (tree string) + "Return the subtree of TREE rooted at the prefix STRING." + (radix-tree--subtree tree string 0)) + +;; (defun radix-tree-trim (tree string) +;; "Return a TREE which only holds entries \"related\" to STRING. +;; \"Related\" is here defined as entries where there's a `string-prefix-p' relation +;; between STRING and the key." +;; (radix-tree-trim tree string 0)) + +(defun radix-tree-prefixes (tree string) + "Return an alist of all bindings in TREE for prefixes of STRING." + (radix-tree--prefixes tree string 0 nil)) + +(eval-and-compile + (pcase-defmacro radix-tree-leaf (vpat) + ;; FIXME: We'd like to use a negative pattern (not consp), but pcase + ;; doesn't support it. Using `atom' works but generates sub-optimal code. + `(or `(t . ,,vpat) (and (pred atom) ,vpat)))) + +(defun radix-tree-iter-subtrees (tree fun) + "Apply FUN to every immediate subtree of radix TREE. +FUN is called with two arguments: PREFIX and SUBTREE. +You can test if SUBTREE is a leaf (and extract its value) with the +pcase pattern (radix-tree-leaf PAT)." + (while tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (funcall fun prefix ptree) + (setq tree rtree)) + (_ (funcall fun "" tree) + (setq tree nil))))) + +(defun radix-tree-iter-mappings (tree fun &optional prefix) + "Apply FUN to every mapping in TREE. +FUN is called with two arguments: KEY and VAL. +PREFIX is only used internally." + (radix-tree-iter-subtrees + tree + (lambda (p s) + (let ((nprefix (concat prefix p))) + (pcase s + ((radix-tree-leaf v) (funcall fun nprefix v)) + (_ (radix-tree-iter-mappings s fun nprefix))))))) + +;; (defun radix-tree->alist (tree) +;; (let ((al nil)) +;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al))) +;; al)) + +(defun radix-tree-count (tree) + (let ((i 0)) + (radix-tree-iter-mappings tree (lambda (_k _v) (setq i (1+ i)))) + i)) + +(defun radix-tree-from-map (map) + ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...) + (require 'map) + (let ((rt nil)) + (map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map) + rt)) + +(provide 'radix-tree) +;;; radix-tree.el ends here diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index b1e132a76e3..40033180770 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -1,4 +1,4 @@ -;;; regexp-opt.el --- generate efficient regexps to match strings +;;; regexp-opt.el --- generate efficient regexps to match strings -*- lexical-binding: t -*- ;; Copyright (C) 1994-2016 Free Software Foundation, Inc. @@ -86,18 +86,44 @@ ;;;###autoload (defun regexp-opt (strings &optional paren) "Return a regexp to match a string in the list STRINGS. -Each string should be unique in STRINGS and should not contain any regexps, -quoted or not. If optional PAREN is non-nil, ensure that the returned regexp -is enclosed by at least one regexp grouping construct. -The returned regexp is typically more efficient than the equivalent regexp: +Each string should be unique in STRINGS and should not contain +any regexps, quoted or not. Optional PAREN specifies how the +returned regexp is surrounded by grouping constructs. - (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\"))) - (concat open (mapconcat \\='regexp-quote STRINGS \"\\\\|\") close)) +The optional argument PAREN can be any of the following: -If PAREN is `words', then the resulting regexp is additionally surrounded -by \\=\\< and \\>. -If PAREN is `symbols', then the resulting regexp is additionally surrounded -by \\=\\_< and \\_>." +a string + the resulting regexp is preceded by PAREN and followed by + \\), e.g. use \"\\\\(?1:\" to produce an explicitly numbered + group. + +`words' + the resulting regexp is surrounded by \\=\\<\\( and \\)\\>. + +`symbols' + the resulting regexp is surrounded by \\_<\\( and \\)\\_>. + +non-nil + the resulting regexp is surrounded by \\( and \\). + +nil + the resulting regexp is surrounded by \\(?: and \\), if it is + necessary to ensure that a postfix operator appended to it will + apply to the whole expression. + +The resulting regexp is equivalent to but usually more efficient +than that of a simplified version: + + (defun simplified-regexp-opt (strings &optional paren) + (let ((parens + (cond ((stringp paren) (cons paren \"\\\\)\")) + ((eq paren 'words) '(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) + ((eq paren 'symbols) '(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) + ((null paren) '(\"\\\\(?:\" . \"\\\\)\")) + (t '(\"\\\\(\" . \"\\\\)\"))))) + (concat (car paren) + (mapconcat 'regexp-quote strings \"\\\\|\") + (cdr paren))))" (save-match-data ;; Recurse on the sorted list. (let* ((max-lisp-eval-depth 10000) @@ -236,7 +262,7 @@ CHARS should be a list of characters." ;; The basic idea is to find character ranges. Also we take care in the ;; position of character set meta characters in the character set regexp. ;; - (let* ((charmap (make-char-table 'case-table)) + (let* ((charmap (make-char-table 'regexp-opt-charset)) (start -1) (end -2) (charset "") (bracket "") (dash "") (caret "")) diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index b1b66262d45..c6684ec9493 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -1,4 +1,4 @@ -;;; ring.el --- handle rings of items +;;; ring.el --- handle rings of items -*- lexical-binding: t; -*- ;; Copyright (C) 1992, 2001-2016 Free Software Foundation, Inc. @@ -160,14 +160,15 @@ will be performed." (size (ring-size ring)) (vect (cddr ring)) lst) - (dotimes (var (cadr ring) lst) - (push (aref vect (mod (+ start var) size)) lst)))) + (dotimes (var (cadr ring)) + (push (aref vect (mod (+ start var) size)) lst)) + lst)) (defun ring-member (ring item) "Return index of ITEM if on RING, else nil. Comparison is done via `equal'. The index is 0-based." (catch 'found - (dotimes (ind (ring-length ring) nil) + (dotimes (ind (ring-length ring)) (when (equal item (ring-ref ring ind)) (throw 'found ind))))) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 8b7b594f5e1..5ddc5a53a32 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: sequences -;; Version: 2.3 +;; Version: 2.19 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -57,7 +57,7 @@ ;;; Code: (eval-when-compile (require 'cl-generic)) -(require 'cl-extra) ;; for cl-subseq +(require 'cl-lib) ;; for cl-subseq (defmacro seq-doseq (spec &rest body) "Loop over a sequence. @@ -87,7 +87,7 @@ given, and the match does not fail." ARGS can also include the `&rest' marker followed by a variable name to be bound to the rest of SEQUENCE." - (declare (indent 2) (debug t)) + (declare (indent 2) (debug (sexp form body))) `(pcase-let ((,(seq--make-pcase-patterns args) ,sequence)) ,@body)) @@ -117,6 +117,16 @@ Return SEQUENCE." (defalias 'seq-each #'seq-do) +(defun seq-do-indexed (function sequence) + "Apply FUNCTION to each element of SEQUENCE and return nil. +Unlike `seq-map', FUNCTION takes two arguments: the element of +the sequence, and its index within the sequence." + (let ((index 0)) + (seq-do (lambda (elt) + (funcall function elt index) + (setq index (1+ index))) + sequence))) + (cl-defgeneric seqp (sequence) "Return non-nil if SEQUENCE is a sequence, nil otherwise." (sequencep sequence)) @@ -127,7 +137,7 @@ Return SEQUENCE." (cl-defgeneric seq-subseq (sequence start &optional end) "Return the sequence of elements of SEQUENCE from START to END. -END is inclusive. +END is exclusive. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. Signal an @@ -218,6 +228,16 @@ The result is a sequence of the same type as SEQUENCE." (cl-defmethod seq-sort (pred (list list)) (sort (seq-copy list) pred)) +(defun seq-sort-by (function pred sequence) + "Sort SEQUENCE using PRED as a comparison function. +Elements of SEQUENCE are transformed by FUNCTION before being +sorted. FUNCTION must be a function of one argument." + (seq-sort (lambda (a b) + (funcall pred + (funcall function a) + (funcall function b))) + sequence)) + (cl-defgeneric seq-reverse (sequence) "Return a sequence with elements of SEQUENCE in reverse order." (let ((result '())) @@ -296,7 +316,8 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." t)) (cl-defgeneric seq-some (pred sequence) - "Return the first value for which if (PRED element) is non-nil for in SEQUENCE." + "Return non-nil if PRED is satisfied for at least one element of SEQUENCE. +If so, return the first non-nil value returned by PRED." (catch 'seq--break (seq-doseq (elt sequence) (let ((result (funcall pred elt))) @@ -329,7 +350,8 @@ found or not." "Return the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." (seq-some (lambda (e) - (funcall (or testfn #'equal) elt e)) + (when (funcall (or testfn #'equal) elt e) + e)) sequence)) (cl-defgeneric seq-position (sequence elt &optional testfn) @@ -455,16 +477,20 @@ SEQUENCE must be a sequence of numbers or markers." "Return element of SEQUENCE at the index N. If no element is found, return nil." (ignore-errors (seq-elt sequence n))) + +(cl-defgeneric seq-random-elt (sequence) + "Return a random element from SEQUENCE. +Signal an error if SEQUENCE is empty." + (if (seq-empty-p sequence) + (error "Sequence cannot be empty") + (seq-elt sequence (random (seq-length sequence))))) ;;; Optimized implementations for lists (cl-defmethod seq-drop ((list list) n) "Optimized implementation of `seq-drop' for lists." - (while (and list (> n 0)) - (setq list (cdr list) - n (1- n))) - list) + (nthcdr n list)) (cl-defmethod seq-take ((list list) n) "Optimized implementation of `seq-take' for lists." diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 495ba7cb859..1d8f0cb8f5d 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1493,7 +1493,10 @@ should not be computed on the basis of the following token." (let ((endpos (point))) (goto-char pos) (forward-line 1) - (and (equal res (smie-indent-forward-token)) + ;; As seen in bug#22960, pos may be inside + ;; a string, and forward-token may then stumble. + (and (ignore-errors + (equal res (smie-indent-forward-token))) (eq (point) endpos))))) nil (goto-char pos) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index e8d1939865f..fdcfa7091c4 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -33,6 +33,7 @@ ;;; Code: (require 'pcase) +(eval-when-compile (require 'cl-lib)) (defmacro internal--thread-argument (first? &rest forms) @@ -146,15 +147,11 @@ to bind a single value, BINDINGS can just be a plain tuple." (defsubst hash-table-keys (hash-table) "Return a list of keys in HASH-TABLE." - (let ((keys '())) - (maphash (lambda (k _v) (push k keys)) hash-table) - keys)) + (cl-loop for k being the hash-keys of hash-table collect k)) (defsubst hash-table-values (hash-table) "Return a list of values in HASH-TABLE." - (let ((values '())) - (maphash (lambda (_k v) (push v values)) hash-table) - values)) + (cl-loop for v being the hash-values of hash-table collect v)) (defsubst string-empty-p (string) "Check whether STRING is empty." @@ -198,6 +195,171 @@ to bind a single value, BINDINGS can just be a plain tuple." (substring string 0 (- (length string) (length suffix))) string)) +(defun read-multiple-choice (prompt choices) + "Ask user a multiple choice question. +PROMPT should be a string that will be displayed as the prompt. + +CHOICES is an alist where the first element in each entry is a +character to be entered, the second element is a short name for +the entry to be displayed while prompting (if there's room, it +might be shortened), and the third, optional entry is a longer +explanation that will be displayed in a help buffer if the user +requests more help. + +This function translates user input into responses by consulting +the bindings in `query-replace-map'; see the documentation of +that variable for more information. In this case, the useful +bindings are `recenter', `scroll-up', and `scroll-down'. If the +user enters `recenter', `scroll-up', or `scroll-down' responses, +perform the requested window recentering or scrolling and ask +again. + +The return value is the matching entry from the CHOICES list. + +Usage example: + +\(read-multiple-choice \"Continue connecting?\" + \\='((?a \"always\") + (?s \"session only\") + (?n \"no\")))" + (let* ((altered-names nil) + (full-prompt + (format + "%s (%s): " + prompt + (mapconcat + (lambda (elem) + (let* ((name (cadr elem)) + (pos (seq-position name (car elem))) + (altered-name + (cond + ;; Not in the name string. + ((not pos) + (format "[%c] %s" (car elem) name)) + ;; The prompt character is in the name, so highlight + ;; it on graphical terminals... + ((display-supports-face-attributes-p + '(:underline t) (window-frame)) + (setq name (copy-sequence name)) + (put-text-property pos (1+ pos) + 'face 'read-multiple-choice-face + name) + name) + ;; And put it in [bracket] on non-graphical terminals. + (t + (concat + (substring name 0 pos) + "[" + (upcase (substring name pos (1+ pos))) + "]" + (substring name (1+ pos))))))) + (push (cons (car elem) altered-name) + altered-names) + altered-name)) + (append choices '((?? "?"))) + ", "))) + tchar buf wrong-char answer) + (save-window-excursion + (save-excursion + (while (not tchar) + (message "%s%s" + (if wrong-char + "Invalid choice. " + "") + full-prompt) + (setq tchar + (if (and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (x-popup-dialog + t + (cons prompt + (mapcar + (lambda (elem) + (cons (capitalize (cadr elem)) + (car elem))) + choices))) + (condition-case nil + (let ((cursor-in-echo-area t)) + (read-char)) + (error nil)))) + (setq answer (lookup-key query-replace-map (vector tchar) t)) + (setq tchar + (cond + ((eq answer 'recenter) + (recenter) t) + ((eq answer 'scroll-up) + (ignore-errors (scroll-up-command)) t) + ((eq answer 'scroll-down) + (ignore-errors (scroll-down-command)) t) + ((eq answer 'scroll-other-window) + (ignore-errors (scroll-other-window)) t) + ((eq answer 'scroll-other-window-down) + (ignore-errors (scroll-other-window-down)) t) + (t tchar))) + (when (eq tchar t) + (setq wrong-char nil + tchar nil)) + ;; The user has entered an invalid choice, so display the + ;; help messages. + (when (and (not (eq tchar nil)) + (not (assq tchar choices))) + (setq wrong-char (not (memq tchar '(?? ?\C-h))) + tchar nil) + (when wrong-char + (ding)) + (with-help-window (setq buf (get-buffer-create + "*Multiple Choice Help*")) + (with-current-buffer buf + (erase-buffer) + (pop-to-buffer buf) + (insert prompt "\n\n") + (let* ((columns (/ (window-width) 25)) + (fill-column 21) + (times 0) + (start (point))) + (dolist (elem choices) + (goto-char start) + (unless (zerop times) + (if (zerop (mod times columns)) + ;; Go to the next "line". + (goto-char (setq start (point-max))) + ;; Add padding. + (while (not (eobp)) + (end-of-line) + (insert (make-string (max (- (* (mod times columns) + (+ fill-column 4)) + (current-column)) + 0) + ?\s)) + (forward-line 1)))) + (setq times (1+ times)) + (let ((text + (with-temp-buffer + (insert (format + "%c: %s\n" + (car elem) + (cdr (assq (car elem) altered-names)))) + (fill-region (point-min) (point-max)) + (when (nth 2 elem) + (let ((start (point))) + (insert (nth 2 elem)) + (unless (bolp) + (insert "\n")) + (fill-region start (point-max)))) + (buffer-string)))) + (goto-char start) + (dolist (line (split-string text "\n")) + (end-of-line) + (if (bolp) + (insert line "\n") + (insert line)) + (forward-line 1))))))))))) + (when (buffer-live-p buf) + (kill-buffer buf)) + (assq tchar choices))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index c221a017f51..ac509b3465d 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -272,9 +272,10 @@ Note: back-references in REGEXPs do not work." (cond ,@(nreverse branches)))))) (defun syntax-propertize-via-font-lock (keywords) - "Propertize for syntax in START..END using font-lock syntax. + "Propertize for syntax using font-lock syntax. KEYWORDS obeys the format used in `font-lock-syntactic-keywords'. -The return value is a function suitable for `syntax-propertize-function'." +The return value is a function (with two parameters, START and +END) suitable for `syntax-propertize-function'." (lambda (start end) (with-no-warnings (let ((font-lock-syntactic-keywords keywords)) @@ -283,7 +284,7 @@ The return value is a function suitable for `syntax-propertize-function'." (setq keywords font-lock-syntactic-keywords))))) (defun syntax-propertize (pos) - "Ensure that syntax-table properties are set until POS." + "Ensure that syntax-table properties are set until POS (a buffer point)." (when (< syntax-propertize--done pos) (if (null syntax-propertize-function) (setq syntax-propertize--done (max (point-max) pos)) @@ -315,6 +316,9 @@ The return value is a function suitable for `syntax-propertize-function'." (unless (eq funs (cdr syntax-propertize-extend-region-functions)) (setq funs syntax-propertize-extend-region-functions))))) + ;; Flush ppss cache between the original value of `start' and that + ;; set above by syntax-propertize-extend-region-functions. + (syntax-ppss-flush-cache start) ;; Move the limit before calling the function, so the function ;; can use syntax-ppss. (setq syntax-propertize--done end) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 00b029d8f3e..9523d5e89e3 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -102,6 +102,8 @@ It is called with two arguments, ID and COLS. ID is a Lisp object identifying the entry, and COLS is a vector of column descriptors, as documented in `tabulated-list-entries'.") +(defvar tabulated-list--near-rows) + (defvar-local tabulated-list-sort-key nil "Sort key for the current Tabulated List mode buffer. If nil, no additional sorting is performed. @@ -257,6 +259,12 @@ Do nothing if `tabulated-list--header-string' is nil." (make-overlay (point-min) (point)))) (overlay-put tabulated-list--header-overlay 'face 'underline)))) +(defsubst tabulated-list-header-overlay-p (&optional pos) + "Return non-nil if there is a fake header. +Optional arg POS is a buffer position where to look for a fake header; +defaults to `point-min'." + (overlays-at (or pos (point-min)))) + (defun tabulated-list-revert (&rest ignored) "The `revert-buffer-function' for `tabulated-list-mode'. It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'." @@ -298,6 +306,14 @@ column. Negate the predicate that would be returned if (lambda (a b) (not (funcall sorter a b))) sorter)))) +(defsubst tabulated-list--col-local-max-widths (col) + "Return maximum entry widths at column COL around current row. +Check the current row, the previous one and the next row." + (apply #'max (mapcar (lambda (x) + (let ((nt (elt x col))) + (string-width (if (stringp nt) nt (car nt))))) + tabulated-list--near-rows))) + (defun tabulated-list-print (&optional remember-pos update) "Populate the current Tabulated List mode buffer. This sorts the `tabulated-list-entries' list if sorting is @@ -340,8 +356,14 @@ changing `tabulated-list-sort-key'." (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. - (dolist (elt entries) - (let ((id (car elt))) + (while entries + (let* ((elt (car entries)) + (tabulated-list--near-rows + (list + (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt)) + (cadr elt) + (or (cadr (cadr entries)) (cadr elt)))) + (id (car elt))) (and entry-id (equal entry-id id) (setq entry-id nil @@ -368,7 +390,8 @@ changing `tabulated-list-sort-key'." (t t))) (let ((old (point))) (forward-line 1) - (delete-region old (point))))))) + (delete-region old (point)))))) + (setq entries (cdr entries))) (set-buffer-modified-p nil) ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt @@ -402,8 +425,6 @@ of column descriptors." N is the column number, COL-DESC is a column descriptor (see `tabulated-list-entries'), and X is the column number at point. Return the column number after insertion." - ;; TODO: don't truncate to `width' if the next column is align-right - ;; and has some space left. (let* ((format (aref tabulated-list-format n)) (name (nth 0 format)) (width (nth 1 format)) @@ -414,12 +435,29 @@ Return the column number after insertion." (label-width (string-width label)) (help-echo (concat (car format) ": " label)) (opoint (point)) - (not-last-col (< (1+ n) (length tabulated-list-format)))) + (not-last-col (< (1+ n) (length tabulated-list-format))) + available-space) + (when not-last-col + (let* ((next-col-format (aref tabulated-list-format (1+ n))) + (next-col-right-align (plist-get (nthcdr 3 next-col-format) + :right-align)) + (next-col-width (nth 1 next-col-format))) + (setq available-space + (if (and (not right-align) + next-col-right-align) + (- + (+ width next-col-width) + (min next-col-width + (tabulated-list--col-local-max-widths (1+ n)))) + width)))) ;; Truncate labels if necessary (except last column). - (and not-last-col - (> label-width width) - (setq label (truncate-string-to-width label width nil nil t) - label-width width)) + ;; Don't truncate to `width' if the next column is align-right + ;; and has some space left, truncate to `available-space' instead. + (when (and not-last-col + (> label-width available-space) + (setq label (truncate-string-to-width + label available-space nil nil t) + label-width available-space))) (setq label (bidi-string-mark-left-to-right label)) (when (and right-align (> width label-width)) (let ((shift (- width label-width))) @@ -437,7 +475,7 @@ Return the column number after insertion." (when not-last-col (when (> pad-right 0) (insert (make-string pad-right ?\s))) (insert (propertize - (make-string (- next-x x label-width pad-right) ?\s) + (make-string (- width (min width label-width)) ?\s) 'display `(space :align-to ,next-x)))) (put-text-property opoint (point) 'tabulated-list-column-name name) next-x))) @@ -494,7 +532,12 @@ this is the vector stored within it." (when (< pos eol) (delete-region pos (next-single-property-change pos prop nil eol)) (goto-char pos) - (tabulated-list-print-col col desc (current-column)) + (let ((tabulated-list--near-rows + (list + (tabulated-list-get-entry (point-at-bol 0)) + entry + (or (tabulated-list-get-entry (point-at-bol 2)) entry)))) + (tabulated-list-print-col col desc (current-column))) (if change-entry-data (aset entry col desc)) (put-text-property pos (point) 'tabulated-list-id id) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index a0c0d85fb29..c6a5e3b9d4f 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -184,6 +184,7 @@ call to one of the `testcover-1value-functions'." ;;; Add instrumentation to your module ;;;========================================================================= +;;;###autoload (defun testcover-start (filename &optional byte-compile) "Uses edebug to instrument all macros and functions in FILENAME, then changes the instrumentation from edebug to testcover--much faster, no diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 3f2e2fb5286..64aebeaa818 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -1,4 +1,4 @@ -;;; timer.el --- run a function with args at some time in future +;;; timer.el --- run a function with args at some time in future -*- lexical-binding: t -*- ;; Copyright (C) 1996, 2001-2016 Free Software Foundation, Inc. @@ -424,6 +424,8 @@ This function returns a timer object which you can use in `cancel-timer'." (defun add-timeout (secs function object &optional repeat) "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT. If REPEAT is non-nil, repeat the timer every REPEAT seconds. + +This function returns a timer object which you can use in `cancel-timer'. This function is for compatibility; see also `run-with-timer'." (run-with-timer secs repeat function object)) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 9351fcc6ca6..542dbccd775 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -302,7 +302,7 @@ is not turned on." If there is additional input within this time, the prefix key is used as a normal prefix key. So typing a key sequence quickly will inhibit overriding the prefix key. -As a special case, if the prefix keys repeated within this time, the +As a special case, if the prefix key is repeated within this time, the first prefix key is discarded, so typing a prefix key twice in quick succession will also inhibit overriding the prefix key. If the value is nil, use a shifted prefix key to inhibit the override." diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 6bda15bf98d..f408ff73106 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -497,7 +497,7 @@ Argument NUM is the number of EOL marks to move." ;;; of line, etc.) it takes a bit of special handling. ;;; ;;; The variable edt-word-entities contains a list of characters which -;;; are to be viewed as distinct words where ever they appear in the +;;; are to be viewed as distinct words wherever they appear in the ;;; buffer. This emulates the EDT line mode command SET ENTITY WORD. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 93cf3b0fb10..3ce1b4d6a75 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1,4 +1,4 @@ -;;; viper-cmd.el --- Vi command support for Viper +;;; viper-cmd.el --- Vi command support for Viper -*- lexical-binding:t -*- ;; Copyright (C) 1997-2016 Free Software Foundation, Inc. @@ -40,13 +40,13 @@ (defvar quail-mode) (defvar quail-current-str) (defvar mark-even-if-inactive) -(defvar init-message) +(defvar viper--init-message) (defvar viper-initial) (defvar undo-beg-posn) (defvar undo-end-posn) (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _)))) ;; end pacifier @@ -608,7 +608,7 @@ ;; This also takes care of the annoying incomplete lines in files. ;; Also, this fixes `undo' to work vi-style for complex commands. -(defun viper-change-state-to-vi () +(defun viper-change-state-to-vi (&rest _) "Change Viper state to Vi." (interactive) (if (and viper-first-time (not (viper-is-in-minibuffer))) @@ -694,7 +694,7 @@ ) -(defun viper-change-state-to-emacs () +(defun viper-change-state-to-emacs (&rest _) "Change Viper state to Emacs." (interactive) (or (viper-overlay-p viper-replace-overlay) @@ -1294,7 +1294,7 @@ as a Meta key and any number of multiple escapes are allowed." ;; define functions to be executed ;; invoked by the `C' command -(defun viper-exec-change (m-com com) +(defun viper-exec-change (m-com _com) (or (and (markerp viper-com-point) (marker-position viper-com-point)) (set-marker viper-com-point (point) (current-buffer))) ;; handle C cmd at the eol and at eob. @@ -1316,7 +1316,7 @@ as a Meta key and any number of multiple escapes are allowed." (viper-change (mark t) (point)))) ;; this is invoked by viper-substitute-line -(defun viper-exec-Change (m-com com) +(defun viper-exec-Change (_m-com _com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) @@ -1338,7 +1338,7 @@ as a Meta key and any number of multiple escapes are allowed." (viper-change-state-to-insert) )) -(defun viper-exec-delete (m-com com) +(defun viper-exec-delete (_m-com _com) (or (and (markerp viper-com-point) (marker-position viper-com-point)) (set-marker viper-com-point (point) (current-buffer))) (let (chars-deleted) @@ -1364,7 +1364,7 @@ as a Meta key and any number of multiple escapes are allowed." (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))))) -(defun viper-exec-Delete (m-com com) +(defun viper-exec-Delete (m-com _com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) @@ -1391,7 +1391,7 @@ as a Meta key and any number of multiple escapes are allowed." (back-to-indentation))) ;; save region -(defun viper-exec-yank (m-com com) +(defun viper-exec-yank (_m-com _com) (or (and (markerp viper-com-point) (marker-position viper-com-point)) (set-marker viper-com-point (point) (current-buffer))) (let (chars-saved) @@ -1415,7 +1415,7 @@ as a Meta key and any number of multiple escapes are allowed." (goto-char viper-com-point))) ;; save lines -(defun viper-exec-Yank (m-com com) +(defun viper-exec-Yank (_m-com _com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) @@ -1440,7 +1440,7 @@ as a Meta key and any number of multiple escapes are allowed." (viper-deactivate-mark) (goto-char viper-com-point)) -(defun viper-exec-bang (m-com com) +(defun viper-exec-bang (_m-com com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) @@ -1458,14 +1458,14 @@ as a Meta key and any number of multiple escapes are allowed." viper-last-shell-com) t t))) -(defun viper-exec-equals (m-com com) +(defun viper-exec-equals (_m-com _com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) (if (> (mark t) (point)) (exchange-point-and-mark)) (indent-region (mark t) (point) nil))) -(defun viper-exec-shift (m-com com) +(defun viper-exec-shift (_m-com com) (save-excursion (set-mark viper-com-point) (viper-enlarge-region (mark t) (point)) @@ -1479,10 +1479,10 @@ as a Meta key and any number of multiple escapes are allowed." ;; this is needed because some commands fake com by setting it to ?r, which ;; denotes repeated insert command. -(defsubst viper-exec-dummy (m-com com) +(defsubst viper-exec-dummy (_m-com _com) nil) -(defun viper-exec-buffer-search (m-com com) +(defun viper-exec-buffer-search (_m-com _com) (setq viper-s-string (regexp-quote (buffer-substring (point) viper-com-point))) (setq viper-s-forward t) @@ -1648,7 +1648,7 @@ invokes the command before that, etc." (add-hook 'after-change-functions 'viper-undo-sentinel) ;; Hook used in viper-undo -(defun viper-after-change-undo-hook (beg end len) +(defun viper-after-change-undo-hook (beg end _len) (if (and (boundp 'undo-in-progress) undo-in-progress) (setq undo-beg-posn beg undo-end-posn (or end beg)) @@ -1662,8 +1662,7 @@ invokes the command before that, etc." "Undo previous change." (interactive) (message "undo!") - (let ((modified (buffer-modified-p)) - (before-undo-pt (point-marker)) + (let ((before-undo-pt (point-marker)) undo-beg-posn undo-end-posn) ;; the viper-after-change-undo-hook removes itself after the 1st invocation @@ -1710,36 +1709,20 @@ invokes the command before that, etc." ;; The following two functions are used to set up undo properly. ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, ;; they are undone all at once. -(defun viper-adjust-undo () - (if viper-undo-needs-adjustment - (let ((inhibit-quit t) - tmp tmp2) - (setq viper-undo-needs-adjustment nil) - (if (listp buffer-undo-list) - (if (setq tmp (memq viper-buffer-undo-list-mark buffer-undo-list)) - (progn - (setq tmp2 (cdr tmp)) ; the part after mark - - ;; cut tail from buffer-undo-list temporarily by direct - ;; manipulation with pointers in buffer-undo-list - (setcdr tmp nil) - - (setq buffer-undo-list (delq nil buffer-undo-list)) - (setq buffer-undo-list - (delq viper-buffer-undo-list-mark buffer-undo-list)) - ;; restore tail of buffer-undo-list - (setq buffer-undo-list (nconc buffer-undo-list tmp2))) - (setq buffer-undo-list (delq nil buffer-undo-list))))) - )) +(viper-deflocalvar viper--undo-change-group-handle nil) +(put 'viper--undo-change-group-handle 'permanent-local t) +(defun viper-adjust-undo () + (when viper--undo-change-group-handle + (undo-amalgamate-change-group + (prog1 viper--undo-change-group-handle + (setq viper--undo-change-group-handle nil))))) (defun viper-set-complex-command-for-undo () - (if (listp buffer-undo-list) - (if (not viper-undo-needs-adjustment) - (let ((inhibit-quit t)) - (setq buffer-undo-list - (cons viper-buffer-undo-list-mark buffer-undo-list)) - (setq viper-undo-needs-adjustment t))))) + (and (listp buffer-undo-list) + (not viper--undo-change-group-handle) + (setq viper--undo-change-group-handle + (prepare-change-group)))) ;;; Viper's destructive Command ring utilities @@ -1903,6 +1886,7 @@ Undo previous insertion and inserts new." "Quote string: " nil 'viper-quote-region-history + ;; FIXME: Use comment-region. (cond ((string-match "tex.*-mode" (symbol-name major-mode)) "%%") ((string-match "java.*-mode" (symbol-name major-mode)) "//") ((string-match "perl.*-mode" (symbol-name major-mode)) "#") @@ -1984,13 +1968,13 @@ Undo previous insertion and inserts new." (funcall hook) )) -;; This is a temp hook that uses free variables init-message and viper-initial. +;; This is a temp hook that uses free variables viper--init-message and viper-initial. ;; A dirty feature, but it is the simplest way to have it do the right thing. -;; The INIT-MESSAGE and VIPER-INITIAL vars come from the scope set by +;; The VIPER--INIT-MESSAGE and VIPER-INITIAL vars come from the scope set by ;; viper-read-string-with-history (defun viper-minibuffer-standard-hook () - (if (stringp init-message) - (viper-tmp-insert-at-eob init-message)) + (if (stringp viper--init-message) + (viper-tmp-insert-at-eob viper--init-message)) (when (stringp viper-initial) ;; don't wait if we have unread events or in kbd macro (or unread-command-events @@ -2054,7 +2038,7 @@ To turn this feature off, set this variable to nil." (viper-minibuffer-real-start) (point-max))) found key cmd suff) (goto-char (point-max)) - (if (and viper-smart-suffix-list (string-match "\\.$" file)) + (if (and viper-smart-suffix-list (string-match "\\.\\'" file)) (progn (while (and (not found) (< count len)) (setq suff (nth count viper-smart-suffix-list) @@ -2098,10 +2082,10 @@ problems." ;;; Reading string with history -(defun viper-read-string-with-history (prompt &optional viper-initial +(defun viper-read-string-with-history (prompt &optional initial history-var default keymap init-message) - ;; Read string, prompting with PROMPT and inserting the VIPER-INITIAL + ;; Read string, prompting with PROMPT and inserting the INITIAL ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the ;; input is an empty string. ;; Default value is displayed until the user types something in the @@ -2109,14 +2093,16 @@ problems." ;; KEYMAP is used, if given, instead of minibuffer-local-map. ;; INIT-MESSAGE is the message temporarily displayed after entering the ;; minibuffer. - (let ((minibuffer-setup-hook + (let ((viper-initial initial) + (viper--init-message init-message) + (minibuffer-setup-hook ;; stolen from add-hook (let ((old (if (boundp 'minibuffer-setup-hook) minibuffer-setup-hook nil))) (cons - 'viper-minibuffer-standard-hook + #'viper-minibuffer-standard-hook (if (or (not (listp old)) (eq (car old) 'lambda)) (list old) old)))) (val "") @@ -2124,14 +2110,15 @@ problems." temp-msg) (setq keymap (or keymap minibuffer-local-map) - viper-initial (or viper-initial "") + initial (or initial "") + viper-initial initial temp-msg (if default (format "(default %s) " default) "")) (setq viper-incomplete-ex-cmd nil) (setq val (read-from-minibuffer prompt - (concat temp-msg viper-initial val padding) + (concat temp-msg initial val padding) keymap nil history-var)) (setq minibuffer-setup-hook nil padding (viper-array-to-string (this-command-keys)) @@ -2832,7 +2819,7 @@ On reaching beginning of line, stop and signal error." (viper-looking-at-alphasep)))))) -(defun viper-end-of-word (arg &optional careful) +(defun viper-end-of-word (arg &optional _careful) "Move point to end of current word." (interactive "P") (viper-leave-region-active) @@ -3668,17 +3655,14 @@ the Emacs binding of `/'." (setq msg "Search style remains unchanged"))) (princ msg t))) -(defun viper-set-searchstyle-toggling-macros (unset &optional major-mode) +(defun viper-set-searchstyle-toggling-macros (unset &optional mode) "Set the macros for toggling the search style in Viper's vi-state. The macro that toggles case sensitivity is bound to `//', and the one that toggles regexp search is bound to `///'. With a prefix argument, this function unsets the macros. -If MAJOR-MODE is set, set the macros only in that major mode." +If MODE is set, set the macros only in that major mode." (interactive "P") - (let (scope) - (if (and major-mode (symbolp major-mode)) - (setq scope major-mode) - (setq scope 't)) + (let ((scope (if (and mode (symbolp mode)) mode t))) (or noninteractive (if (not unset) (progn @@ -4871,33 +4855,36 @@ Please, specify your level now: ")) ;;; Bug Report +(defvar reporter-prompt-for-summary-p) + (defun viper-submit-report () "Submit bug report on Viper." (interactive) + (defvar viper-device-type) + (defvar viper-color-display-p) + (defvar viper-frame-parameters) + (defvar viper-minibuffer-emacs-face) + (defvar viper-minibuffer-vi-face) + (defvar viper-minibuffer-insert-face) (let ((reporter-prompt-for-summary-p t) (viper-device-type (viper-device-type)) - color-display-p frame-parameters - minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face - varlist salutation window-config) - - ;; If mode info is needed, add variable to `let' and then set it below, - ;; like we did with color-display-p. - (setq color-display-p (if (viper-window-display-p) + (viper-color-display-p (if (viper-window-display-p) (viper-color-display-p) - 'non-x) - minibuffer-vi-face (if (viper-has-face-support-p) - (viper-get-face viper-minibuffer-vi-face) - 'non-x) - minibuffer-insert-face (if (viper-has-face-support-p) - (viper-get-face - viper-minibuffer-insert-face) - 'non-x) - minibuffer-emacs-face (if (viper-has-face-support-p) - (viper-get-face - viper-minibuffer-emacs-face) - 'non-x) - frame-parameters (if (fboundp 'frame-parameters) - (frame-parameters (selected-frame)))) + 'non-x)) + (viper-frame-parameters (if (fboundp 'frame-parameters) + (frame-parameters (selected-frame)))) + (viper-minibuffer-emacs-face (if (viper-has-face-support-p) + (viper-get-face + viper-minibuffer-emacs-face) + 'non-x)) + (viper-minibuffer-vi-face (if (viper-has-face-support-p) + (viper-get-face viper-minibuffer-vi-face) + 'non-x)) + (viper-minibuffer-insert-face (if (viper-has-face-support-p) + (viper-get-face + viper-minibuffer-insert-face) + 'non-x)) + varlist salutation window-config) (setq varlist (list 'viper-vi-minibuffer-minor-mode 'viper-insert-minibuffer-minor-mode @@ -4942,11 +4929,11 @@ Please, specify your level now: ")) 'viper-expert-level 'major-mode 'viper-device-type - 'color-display-p - 'frame-parameters - 'minibuffer-vi-face - 'minibuffer-insert-face - 'minibuffer-emacs-face + 'viper-color-display-p + 'viper-frame-parameters + 'viper-minibuffer-vi-face + 'viper-minibuffer-insert-face + 'viper-minibuffer-emacs-face )) (setq salutation " Congratulations! You may have unearthed a bug in Viper! diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 2c422cb9534..9c9cd681bfa 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -1250,7 +1250,7 @@ reversed." (kill-region (point) (mark t)))))) -(declare-function viper-change-state-to-vi "viper-cmd" ()) +(declare-function viper-change-state-to-vi "viper-cmd" (&rest _)) ;; Ex edit command ;; In Viper, `e' and `e!' behave identically. In both cases, the user is @@ -1998,7 +1998,7 @@ Please contact your system administrator. " (beginning-of-line) (if opt-c (message "done")))) -(declare-function viper-change-state-to-emacs "viper-cmd" ()) +(declare-function viper-change-state-to-emacs "viper-cmd" (&rest _)) ;; Ex tag command (defun ex-tag () diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 104245b7571..ee093906771 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -369,15 +369,6 @@ Use `\\[viper-set-expert-level]' to change this.") ;; VI-style Undo -;; Used to 'undo' complex commands, such as replace and insert commands. -(viper-deflocalvar viper-undo-needs-adjustment nil) -(put 'viper-undo-needs-adjustment 'permanent-local t) - -;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a -;; complex command that must be undone atomically. If inserted, it is -;; erased by viper-change-state-to-vi and viper-repeat. -(defconst viper-buffer-undo-list-mark 'viper) - (defcustom viper-keep-point-on-undo nil "Non-nil means not to move point while undoing commands. This style is different from Emacs and Vi. Try it to see if @@ -786,7 +777,7 @@ Related buffers can be cycled through via :R and :P commands." "^@end \\|" ; texinfo ")\n\n[ \t\n]*\\|" ; lisp "\\.\\s-*$") ; prolog - "*Regexps to end Headings/Sections. Used by [].") + "Regexps to end Headings/Sections. Used by [].") ;; These two vars control the interaction of jumps performed by ' and `. diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index fd6b22231a6..c8626e412b5 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -274,7 +274,7 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., )) -(declare-function viper-change-state-to-vi "viper-cmd" ()) +(declare-function viper-change-state-to-vi "viper-cmd" (&rest _)) ;; Terminate a Vi kbd macro. ;; optional argument IGNORE, if t, indicates that we are dealing with an diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 1254923669f..68500365dc0 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1332,7 +1332,7 @@ Works best when set in the hooks to various major modes. `reformed-vi' means Viper words are like Emacs words \(as determined using Emacs syntax tables, which are different for different major modes) with two exceptions: the symbol `_' is always part of a word and typical Vi non-word -symbols, such as `,',:,\",),{, etc., are excluded. +symbols like `\\=`', `\\='', `:', `\"', `)', and `{' are excluded. This behaves very close to `strict-vi', but also works well with non-ASCII characters from various alphabets. diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index b24f1c4ee21..c5dac55522a 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1,4 +1,4 @@ -;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs, +;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs, -*-lexical-binding:t -*- ;; a VI Plan for Emacs Rescue, ;; and a venomous VI PERil. ;; Viper Is also a Package for Emacs Rebels. @@ -126,9 +126,9 @@ ;; As an immediate solution, you can hit C-z to bring about the right mode. ;; An interim solution is to add an appropriate hook to the mode like this: ;; -;; (add-hook 'your-favorite-mode 'viper-mode) +;; (add-hook 'your-favorite-mode #'viper-mode) ;; or -;; (add-hook 'your-favorite-mode 'viper-change-state-to-emacs) +;; (add-hook 'your-favorite-mode #'viper-change-state-to-emacs) ;; ;; whichever applies. The right thing to do, however, is to complain to the ;; author of the respective package. (Sometimes they also neglect to equip @@ -308,7 +308,6 @@ (defvar viper-major-mode-modifier-list) ;; end pacifier -(require 'advice) (require 'viper-init) (require 'viper-keym) @@ -337,8 +336,7 @@ This is different from `viper-mode' variable in that `viper-mode' determines whether to use Viper in the first place, while `viper-always', if nil, lets user decide when to invoke Viper in a major mode." :type 'boolean - :tag "Always Invoke Viper" - :group 'viper-misc) + :tag "Always Invoke Viper") ;; Non-viper variables that need to be saved in case the user decides to ;; de-viperize emacs. @@ -354,8 +352,7 @@ Must be set in your init file before Viper is loaded. DO NOT set this variable interactively, unless you are using the customization widget." :type '(choice (const nil) (const t) (const ask)) - :tag "Set Viper Mode on Loading" - :group 'viper-misc) + :tag "Set Viper Mode on Loading") (defcustom viper-vi-state-mode-list '(fundamental-mode @@ -401,8 +398,7 @@ widget." mh-show-mode ) "Major modes that require Vi command state." - :type '(repeat symbol) - :group 'viper-misc) + :type '(repeat symbol)) (defcustom viper-emacs-state-mode-list '(Custom-mode @@ -440,8 +436,7 @@ Normally, Viper would bring buffers up in Emacs state, unless the corresponding major mode has been placed on `viper-vi-state-mode-list' or `viper-insert-state-mode-list'. So, don't place a new mode on this list, unless it is coming up in a wrong Viper state." - :type '(repeat symbol) - :group 'viper-misc) + :type '(repeat symbol)) (defcustom viper-insert-state-mode-list '(internal-ange-ftp-mode @@ -452,18 +447,17 @@ unless it is coming up in a wrong Viper state." eshell-mode shell-mode) "A list of major modes that should come up in Vi Insert state." - :type '(repeat symbol) - :group 'viper-misc) + :type '(repeat symbol)) ;; used to set viper-major-mode-modifier-list in defcustom (defun viper-apply-major-mode-modifiers (&optional symbol value) (if symbol (set symbol value)) - (mapcar (lambda (triple) - (viper-modify-major-mode - (nth 0 triple) (nth 1 triple) (eval (nth 2 triple)))) - viper-major-mode-modifier-list)) + (mapc (lambda (triple) + (viper-modify-major-mode + (nth 0 triple) (nth 1 triple) (symbol-value (nth 2 triple)))) + viper-major-mode-modifier-list)) ;; We change standard bindings in some major modes, making them slightly ;; different than in "normal" vi/insert/emacs states @@ -504,10 +498,7 @@ existing triple." (const vi-state) (const insert-state)) symbol)) - :set 'viper-apply-major-mode-modifiers - :group 'viper-misc) - - + :set #'viper-apply-major-mode-modifiers) @@ -632,17 +623,17 @@ This startup message appears whenever you load Viper, unless you type `y' now." ;; remove viper hooks from SYMBOL (defun viper-remove-hooks (symbol) (cond ((not (boundp symbol)) nil) - ((not (listp (eval symbol))) nil) + ((not (listp (symbol-value symbol))) nil) ((string-match "-hook" (symbol-name symbol)) - (remove-hook symbol 'viper-mode) - (remove-hook symbol 'viper-change-state-to-emacs) - (remove-hook symbol 'viper-change-state-to-insert) - (remove-hook symbol 'viper-change-state-to-vi) - (remove-hook symbol 'viper-minibuffer-post-command-hook) - (remove-hook symbol 'viper-minibuffer-setup-sentinel) - (remove-hook symbol 'viper-major-mode-change-sentinel) - (remove-hook symbol 'set-viper-state-in-major-mode) - (remove-hook symbol 'viper-post-command-sentinel) + (remove-hook symbol #'viper-mode) + (remove-hook symbol #'viper-change-state-to-emacs) + (remove-hook symbol #'viper-change-state-to-insert) + (remove-hook symbol #'viper-change-state-to-vi) + (remove-hook symbol #'viper-minibuffer-post-command-hook) + (remove-hook symbol #'viper-minibuffer-setup-sentinel) + (remove-hook symbol #'viper-major-mode-change-sentinel) + (remove-hook symbol #'set-viper-state-in-major-mode) + (remove-hook symbol #'viper-post-command-sentinel) ))) ;; Remove local value in all existing buffers @@ -652,6 +643,19 @@ This startup message appears whenever you load Viper, unless you type `y' now." (with-current-buffer buf (kill-local-variable symbol)))) +(defvar viper--advice-list nil) + +(defun viper--advice-add (function where advice) + (advice-add function where advice) + (push (cons function advice) viper--advice-list)) + +(defun viper--deactivate-advice-list () + (mapc (lambda (n) + (advice-remove + (car n) + (cdr n))) + viper--advice-list) + (setq viper--advice-list nil)) (defun viper-go-away () "De-Viperize Emacs. @@ -679,7 +683,7 @@ It also can't undo some Viper settings." (delq 'viper-mode-string global-mode-string)) (setq-default major-mode - (viper-standard-value 'default-major-mode + (viper-standard-value 'major-mode viper-saved-non-viper-variables)) (if (featurep 'emacs) @@ -697,7 +701,7 @@ It also can't undo some Viper settings." ;; deactivate all advices done by Viper. - (ad-deactivate-regexp "viper-") + (viper--deactivate-advice-list) (setq viper-mode nil) @@ -769,10 +773,10 @@ It also can't undo some Viper settings." ) ;; remove all hooks set by viper - (mapatoms 'viper-remove-hooks) - (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) - (remove-hook 'erc-mode-hook 'viper-comint-mode-hook) - (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) + (mapatoms #'viper-remove-hooks) + (remove-hook 'comint-mode-hook #'viper-comint-mode-hook) + (remove-hook 'erc-mode-hook #'viper-comint-mode-hook) + (remove-hook 'change-major-mode-hook #'viper-major-mode-change-sentinel) ;; unbind Viper mouse bindings (viper-unbind-mouse-search-key) @@ -781,7 +785,7 @@ It also can't undo some Viper settings." ;; This advice is undone earlier, when all advices matching "viper-" are ;; deactivated. (if (featurep 'xemacs) - (remove-hook 'mouse-leave-frame-hook 'viper-remember-current-frame)) + (remove-hook 'mouse-leave-frame-hook #'viper-remember-current-frame)) ) ; end viper-go-away @@ -813,7 +817,7 @@ It also can't undo some Viper settings." ;; clear the list of bufs that changed major mode (setq viper-new-major-mode-buffer-list nil) ;; change the global value of hook - (remove-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode)) + (remove-hook 'viper-post-command-hooks #'set-viper-state-in-major-mode)) ;; sets up post-command-hook to turn viper-mode, if the current mode is ;; fundamental @@ -823,7 +827,7 @@ It also can't undo some Viper settings." (setq viper-new-major-mode-buffer-list (cons (current-buffer) viper-new-major-mode-buffer-list)))) ;; change the global value of hook - (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) + (add-hook 'viper-post-command-hooks #'set-viper-state-in-major-mode t)) ;;; Handling of tty's ESC event @@ -869,8 +873,8 @@ Two differences: (defun viper-setup-ESC-to-escape (enable) (if enable - (add-hook 'tty-setup-hook 'viper-catch-tty-ESC) - (remove-hook 'tty-setup-hook 'viper-catch-tty-ESC)) + (add-hook 'tty-setup-hook #'viper-catch-tty-ESC) + (remove-hook 'tty-setup-hook #'viper-catch-tty-ESC)) (let ((seen ())) (dolist (frame (frame-list)) (let ((terminal (frame-terminal frame))) @@ -887,21 +891,21 @@ Two differences: ;; in Fundamental Mode and Vi state. ;; When viper-mode is executed in such a case, it will set the major mode ;; back to fundamental-mode. - (if (eq (default-value 'major-mode) 'fundamental-mode) + (if (eq (default-value 'major-mode) #'fundamental-mode) ;; FIXME: We should use after-change-major-mode-hook instead! - (setq-default major-mode 'viper-mode)) + (setq-default major-mode #'viper-mode)) (viper-setup-ESC-to-escape t) - (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) - (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) + (add-hook 'change-major-mode-hook #'viper-major-mode-change-sentinel) + (add-hook 'find-file-hooks #'set-viper-state-in-major-mode) ;; keep this because many modes we don't know about use this hook (defvar text-mode-hook) - (add-hook 'text-mode-hook 'viper-mode) + (add-hook 'text-mode-hook #'viper-mode) (defvar emerge-startup-hook) - (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) + (add-hook 'emerge-startup-hook #'viper-change-state-to-emacs) ;; if viper is started from .emacs, it might be impossible to get certain ;; info about the display and windows until emacs initialization is complete @@ -916,28 +920,15 @@ Two differences: )) ;; Tell vc-diff to put *vc* in Vi mode - (eval-after-load - "vc" - '(defadvice vc-diff (after viper-vc-ad activate) - "Force Vi state in VC diff buffer." - (viper-change-state-to-vi))) - - (eval-after-load - "emerge" - '(defadvice emerge-quit (after viper-emerge-advice activate) - "Run `viper-change-state-to-vi' after quitting emerge." - (viper-change-state-to-vi))) + (viper--advice-add 'vc-diff :after #'viper-change-state-to-vi) + (viper--advice-add 'emerge-quit :after #'viper-change-state-to-vi) ;; passwd.el sets up its own buffer, which turns up in Vi mode, ;; thus overriding the local map. We don't need Vi mode here. - (eval-after-load - "passwd" - '(defadvice read-passwd-1 (before viper-passwd-ad activate) - "Switch to Emacs state while reading password." - (viper-change-state-to-emacs))) - - (defadvice self-insert-command (around viper-self-insert-ad activate) - "Ignore all self-inserting keys in the vi-state." + (viper--advice-add 'read-passwd-1 :before #'viper-change-state-to-emacs) + + (viper--advice-add 'self-insert-command :around + (lambda (orig-fun &rest args) ;; FIXME: Use remapping? (if (and (eq viper-current-state 'vi-state) ;; Do not use called-interactively-p here. XEmacs does not have it @@ -945,16 +936,16 @@ Two differences: ;; (called-interactively-p 'interactive)) (interactive-p)) (beep 1) - ad-do-it - )) + (apply orig-fun args)))) - (defadvice set-cursor-color (after viper-set-cursor-color-ad activate) + (viper--advice-add 'set-cursor-color :after + (lambda (color-name) "Change cursor color in VI state." (modify-frame-parameters - (selected-frame) - (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) - (setq viper-vi-state-cursor-color (ad-get-arg 0)) - ) + (selected-frame) + (list (cons 'viper-vi-state-cursor-color color-name))) + (setq viper-vi-state-cursor-color color-name))) + (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) ;; needs to be as early as possible @@ -965,8 +956,8 @@ Two differences: ) ;; Emacs shell, ange-ftp, and comint-based modes - (add-hook 'comint-mode-hook 'viper-comint-mode-hook) ; comint - (add-hook 'erc-mode-hook 'viper-comint-mode-hook) ; ERC + (add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint + (add-hook 'erc-mode-hook #'viper-comint-mode-hook) ; ERC (add-hook 'eshell-mode-hook (lambda () (setq viper-auto-indent nil))) @@ -984,22 +975,14 @@ Two differences: ;; For RMAIL users. ;; Put buf in Emacs state after edit. - (eval-after-load - "rmailedit" - '(defadvice rmail-cease-edit (after viper-rmail-advice activate) - "Switch to Emacs state when done editing message." - (viper-change-state-to-emacs))) - - ;; ISO accents - ;; Need to do it after loading iso-acc, or else this loading will wipe out - ;; the advice. - (eval-after-load - "iso-acc" - '(defadvice iso-accents-mode (around viper-iso-accents-advice activate) + (viper--advice-add 'rmail-cease-edit :after #'viper-change-state-to-emacs) + + ;; ISO accents. + (viper--advice-add 'iso-accents-mode :after + (lambda (arg &rest _) "Set viper-automatic-iso-accents to iso-accents-mode." - (let ((arg (ad-get-arg 0))) - ad-do-it - (setq viper-automatic-iso-accents + (defvar iso-accents-mode) + (setq viper-automatic-iso-accents (if (eq viper-current-state 'vi-state) (if arg ;; if iso-accents-mode was called with positive arg, turn @@ -1015,35 +998,31 @@ Two differences: (if (memq viper-current-state '(vi-state insert-state replace-state)) (message "Viper ISO accents mode: %s" (if viper-automatic-iso-accents "on" "off"))) - ))) + )) ;; International input methods - (if (featurep 'emacs) - (eval-after-load "mule-cmds" - '(progn - (defadvice deactivate-input-method (after viper-mule-advice activate) - "Set viper-special-input-method to disable intl. input methods." - (viper-deactivate-input-method-action)) - (defadvice activate-input-method (after viper-mule-advice activate) - "Set viper-special-input-method to enable intl. input methods." - (viper-activate-input-method-action)) - )) + (if nil ;; (featurep 'emacs) ;;The hooks should now work! + (progn + (viper--advice-add 'deactivate-input-method :after + #'viper-deactivate-input-method-action) + (viper--advice-add 'activate-input-method :after + #'viper-activate-input-method-action)) ;; XEmacs Although these hooks exist in Emacs, they don't seem to be always ;; called on input-method activation/deactivation, so we the above advise ;; functions instead. (eval-after-load "mule-cmds" '(progn (add-hook 'input-method-activate-hook - 'viper-activate-input-method-action t) + #'viper-activate-input-method-action t) (add-hook 'input-method-deactivate-hook - 'viper-deactivate-input-method-action t))) + #'viper-deactivate-input-method-action t))) ) - (eval-after-load "mule-cmds" - '(defadvice toggle-input-method (around viper-mule-advice activate) + (viper--advice-add 'toggle-input-method :around + (lambda (orig-fun &rest args) "Adjust input-method toggling in vi-state." (if (and viper-special-input-method (eq viper-current-state 'vi-state)) - (viper-deactivate-input-method) - ad-do-it))) + (viper-deactivate-input-method) + (apply orig-fun args)))) ) ; viper-set-hooks @@ -1075,11 +1054,11 @@ Two differences: "Force to read key via `viper-read-key-sequence'." (interactive (list (viper-read-key-sequence "Describe key: ")))) ;; Emacs - (defadvice describe-key (before viper-describe-key-ad protect activate) + (viper--advice-add 'describe-key :before + (lambda (&rest _) "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) + (interactive (let ((key (viper-read-key-sequence + "Describe key (or click or menu item): "))) (list key (prefix-numeric-value current-prefix-arg) ;; If KEY is a down-event, read also the @@ -1098,7 +1077,9 @@ Two differences: (and (> (length key) 1) (eventp (aref key 1)) (memq 'down (event-modifiers (aref key 1))))) - (read-event)))))) + (read-event))))) + nil)) + ) ; (if (featurep 'xemacs) (if (featurep 'xemacs) @@ -1108,12 +1089,11 @@ Two differences: "Force to read key via `viper-read-key-sequence'." (interactive (list (viper-read-key-sequence "Describe key briefly: ")))) ;; Emacs - (defadvice describe-key-briefly - (before viper-describe-key-briefly-ad protect activate) + (viper--advice-add 'describe-key-briefly :before + (lambda (&rest _) "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) + (interactive (let ((key (viper-read-key-sequence + "Describe key (or click or menu item): "))) ;; If KEY is a down-event, read and discard the ;; corresponding up-event. (and (vectorp key) @@ -1124,84 +1104,85 @@ Two differences: (list key (if current-prefix-arg (prefix-numeric-value current-prefix-arg)) - 1)))) + 1))) + nil)) ) ; (if (featurep 'xemacs) - (defadvice find-file (before viper-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (cons (read-file-name "Find file: " nil default-directory) - ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and (featurep 'xemacs) (featurep 'mule)) - (list - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - ;; Emacs: do wildcards - ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - (list find-file-wildcards)))) - )) - - (defadvice find-file-other-window (before viper-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (cons (read-file-name "Find file in other window: " - nil default-directory) - ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and (featurep 'xemacs) (featurep 'mule)) - (list - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - ;; Emacs: do wildcards - ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - (list find-file-wildcards)))) - )) - - - (defadvice find-file-other-frame (before viper-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (cons (read-file-name "Find file in other frame: " - nil default-directory) - ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and (featurep 'xemacs) (featurep 'mule)) - (list - (and current-prefix-arg - (read-coding-system "Coding-system: ")))) - ;; Emacs: do wildcards - ((and (featurep 'emacs) (boundp 'find-file-wildcards)) - (list find-file-wildcards)))) - )) - - - (defadvice read-file-name (around viper-suffix-advice activate) + ;; FIXME: The default already uses read-file-name, so it looks like this + ;; advice is not needed any more. + ;; (defadvice find-file (before viper-add-suffix-advice activate) + ;; "Use `read-file-name' for reading arguments." + ;; (interactive (cons (read-file-name "Find file: " nil default-directory) + ;; ;; XEmacs: if Mule & prefix arg, ask for coding system + ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) + ;; (list + ;; (and current-prefix-arg + ;; (read-coding-system "Coding-system: ")))) + ;; ;; Emacs: do wildcards + ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) + ;; (list find-file-wildcards)))) + ;; )) + ;; (defadvice find-file-other-window (before viper-add-suffix-advice activate) + ;; "Use `read-file-name' for reading arguments." + ;; (interactive (cons (read-file-name "Find file in other window: " + ;; nil default-directory) + ;; ;; XEmacs: if Mule & prefix arg, ask for coding system + ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) + ;; (list + ;; (and current-prefix-arg + ;; (read-coding-system "Coding-system: ")))) + ;; ;; Emacs: do wildcards + ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) + ;; (list find-file-wildcards)))) + ;; )) + ;; (defadvice find-file-other-frame (before viper-add-suffix-advice activate) + ;; "Use `read-file-name' for reading arguments." + ;; (interactive (cons (read-file-name "Find file in other frame: " + ;; nil default-directory) + ;; ;; XEmacs: if Mule & prefix arg, ask for coding system + ;; (cond ((and (featurep 'xemacs) (featurep 'mule)) + ;; (list + ;; (and current-prefix-arg + ;; (read-coding-system "Coding-system: ")))) + ;; ;; Emacs: do wildcards + ;; ((and (featurep 'emacs) (boundp 'find-file-wildcards)) + ;; (list find-file-wildcards)))) + ;; )) + + + (viper--advice-add 'read-file-name :around + (lambda (orig-fun &rest args) "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook." (let ((viper-minibuffer-exit-hook (append viper-minibuffer-exit-hook '(viper-minibuffer-trim-tail viper-file-add-suffix)))) - ad-do-it)) + (apply orig-fun args)))) - (defadvice start-kbd-macro (after viper-kbd-advice activate) + (viper--advice-add 'start-kbd-macro :after + (lambda (&rest _) "Remove Viper's intercepting bindings for C-x ). - This may be needed if the previous `:map' command terminated abnormally." +This may be needed if the previous `:map' command terminated abnormally." (define-key viper-vi-intercept-map "\C-x)" nil) (define-key viper-insert-intercept-map "\C-x)" nil) - (define-key viper-emacs-intercept-map "\C-x)" nil)) + (define-key viper-emacs-intercept-map "\C-x)" nil))) - (defadvice add-minor-mode (after - viper-advice-add-minor-mode - (toggle name &optional keymap after toggle-fun) - activate) + (viper--advice-add 'add-minor-mode :after + (lambda (&rest _) "Run viper-normalize-minor-mode-map-alist after adding a minor mode." (viper-normalize-minor-mode-map-alist) (unless (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist))) + (setq-default minor-mode-map-alist minor-mode-map-alist)))) ;; catch frame switching event (if (viper-window-display-p) (if (featurep 'xemacs) - (add-hook 'mouse-leave-frame-hook - 'viper-remember-current-frame) - (defadvice handle-switch-frame (before viper-frame-advice activate) - "Remember the selected frame before the switch-frame event." - (viper-remember-current-frame (selected-frame)))) ) + (add-hook 'mouse-leave-frame-hook + #'viper-remember-current-frame) + (viper--advice-add 'handle-switch-frame :before + (lambda (&rest _) + "Remember the selected frame before the switch-frame event." + (viper-remember-current-frame (selected-frame)))))) ) ; end viper-non-hook-settings @@ -1253,7 +1234,7 @@ These two lines must come in the order given.")) (if (null viper-saved-non-viper-variables) (setq viper-saved-non-viper-variables (list - (cons 'default-major-mode (list (default-value 'major-mode))) + (cons 'major-mode (list (default-value 'major-mode))) (cons 'next-line-add-newlines (list next-line-add-newlines)) (cons 'require-final-newline (list require-final-newline)) (cons 'scroll-step (list scroll-step)) @@ -1318,97 +1299,83 @@ These two lines must come in the order given.")) (cons 'viper-re-search (list viper-re-search))))) -(if viper-mode - (progn - (viper-set-minibuffer-style) - (if viper-buffer-search-char - (viper-buffer-search-enable)) - (viper-update-syntax-classes 'set-default) - )) - -;;; Familiarize Viper with some minor modes that have their own keymaps -(if viper-mode - (progn - (viper-harness-minor-mode "compile") - (viper-harness-minor-mode "outline") - (viper-harness-minor-mode "allout") - (viper-harness-minor-mode "xref") - (viper-harness-minor-mode "lmenu") - (viper-harness-minor-mode "vc") - (viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which - (viper-harness-minor-mode "latex") ; sits in one of these two files - (viper-harness-minor-mode "cyrillic") - (viper-harness-minor-mode "russian") - (viper-harness-minor-mode "view-less") - (viper-harness-minor-mode "view") - (viper-harness-minor-mode "reftex") - (viper-harness-minor-mode "flyspell") - )) - - ;; Intercept maps could go in viper-keym.el ;; We keep them here in case someone redefines them in viper-custom-file-name -(define-key viper-vi-intercept-map viper-ESC-key 'viper-intercept-ESC-key) -(define-key viper-insert-intercept-map viper-ESC-key 'viper-intercept-ESC-key) +(define-key viper-vi-intercept-map viper-ESC-key #'viper-intercept-ESC-key) +(define-key viper-insert-intercept-map viper-ESC-key #'viper-intercept-ESC-key) ;; This is taken care of by viper-insert-global-user-map. -;;(define-key viper-replace-map viper-ESC-key 'viper-intercept-ESC-key) +;;(define-key viper-replace-map viper-ESC-key #'viper-intercept-ESC-key) ;; The default viper-toggle-key is \C-z; for the novice, it suspends or ;; iconifies Emacs (define-key viper-vi-intercept-map viper-toggle-key 'viper-toggle-key-action) (define-key - viper-emacs-intercept-map viper-toggle-key 'viper-change-state-to-vi) + viper-emacs-intercept-map viper-toggle-key #'viper-change-state-to-vi) -;;; Removed to avoid bad interaction with cua-mode. -;;; Escape from Emacs and Insert modes to Vi for one command +;; Removed to avoid bad interaction with cua-mode. +;; Escape from Emacs and Insert modes to Vi for one command ;;(define-key viper-emacs-intercept-map "\C-c\\" 'viper-escape-to-vi) ;;(define-key viper-insert-intercept-map "\C-c\\" 'viper-escape-to-vi) -(if viper-mode - (setq-default viper-emacs-intercept-minor-mode t - viper-emacs-local-user-minor-mode t - viper-emacs-global-user-minor-mode t - viper-emacs-kbd-minor-mode t - viper-emacs-state-modifier-minor-mode t)) -(if (and viper-mode (eq viper-current-state 'emacs-state)) - (setq viper-emacs-intercept-minor-mode t - viper-emacs-local-user-minor-mode t - viper-emacs-global-user-minor-mode t - viper-emacs-kbd-minor-mode t - viper-emacs-state-modifier-minor-mode t)) - - -(if (and viper-mode - (or viper-always - (and (< viper-expert-level 5) (> viper-expert-level 0)))) - (viper-set-hooks)) - -;; Let all minor modes take effect after loading. -;; This may not be enough, so we also set default minor-mode-alist. -;; Without setting the default, new buffers that come up in emacs mode have -;; minor-mode-map-alist = nil, unless we call viper-change-state-* -(if (and viper-mode (eq viper-current-state 'emacs-state)) - (progn - (viper-change-state-to-emacs) - (unless - (and (fboundp 'add-to-ordered-list) - (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)) - )) +(when viper-mode + (viper-set-minibuffer-style) + (if viper-buffer-search-char + (viper-buffer-search-enable)) + (viper-update-syntax-classes 'set-default) + + ;; Familiarize Viper with some minor modes that have their own keymaps + (viper-harness-minor-mode "compile") + (viper-harness-minor-mode "outline") + (viper-harness-minor-mode "allout") + (viper-harness-minor-mode "xref") + (viper-harness-minor-mode "lmenu") + (viper-harness-minor-mode "vc") + (viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which + (viper-harness-minor-mode "latex") ; sits in one of these two files + (viper-harness-minor-mode "cyrillic") + (viper-harness-minor-mode "russian") + (viper-harness-minor-mode "view-less") + (viper-harness-minor-mode "view") + (viper-harness-minor-mode "reftex") + (viper-harness-minor-mode "flyspell") + + (setq-default viper-emacs-intercept-minor-mode t + viper-emacs-local-user-minor-mode t + viper-emacs-global-user-minor-mode t + viper-emacs-kbd-minor-mode t + viper-emacs-state-modifier-minor-mode t) + (if (eq viper-current-state 'emacs-state) + (setq viper-emacs-intercept-minor-mode t + viper-emacs-local-user-minor-mode t + viper-emacs-global-user-minor-mode t + viper-emacs-kbd-minor-mode t + viper-emacs-state-modifier-minor-mode t)) + + + (if (or viper-always + (and (< viper-expert-level 5) (> viper-expert-level 0))) + (viper-set-hooks)) + + ;; Let all minor modes take effect after loading. + ;; This may not be enough, so we also set default minor-mode-alist. + ;; Without setting the default, new buffers that come up in emacs mode have + ;; minor-mode-map-alist = nil, unless we call viper-change-state-* + (when (eq viper-current-state 'emacs-state) + (viper-change-state-to-emacs) + (unless + (and (fboundp 'add-to-ordered-list) + (boundp 'emulation-mode-map-alists)) + (setq-default minor-mode-map-alist minor-mode-map-alist)) + ) -(if (and viper-mode (this-major-mode-requires-vi-state major-mode)) - (viper-mode)) + (if (this-major-mode-requires-vi-state major-mode) + (viper-mode)) -(if viper-mode - (setq initial-major-mode - `(lambda () - (funcall (quote ,initial-major-mode)) - (set-viper-state-in-major-mode)) - )) + (add-function :after initial-major-mode #'set-viper-state-in-major-mode)) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index ee502ef64a3..4b0d9b3108a 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -120,7 +120,7 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (signal 'file-error + (signal 'file-missing (cons "Opening input file" (cdr error))))) (defvar last-coding-system-used) @@ -161,22 +161,23 @@ encryption is used." ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. ;; Borrowed from jka-compr.el. - (if (and (eq (car error) 'file-error) + (if (and (memq 'file-error (get (car error) 'error-conditions)) (equal (cadr error) "Searching for program")) (error "Decryption program `%s' not found" (nth 3 error))) - (when (file-exists-p local-file) - ;; Hack to prevent find-file from opening empty buffer - ;; when decryption failed (bug#6568). See the place - ;; where `find-file-not-found-functions' are called in - ;; `find-file-noselect-1'. - (setq-local epa-file-error error) - (add-hook 'find-file-not-found-functions - 'epa-file--find-file-not-found-function - nil t) - (epa-display-error context)) - (signal 'file-error - (cons "Opening input file" (cdr error))))) + (let ((exists (file-exists-p local-file))) + (when exists + ;; Hack to prevent find-file from opening empty buffer + ;; when decryption failed (bug#6568). See the place + ;; where `find-file-not-found-functions' are called in + ;; `find-file-noselect-1'. + (setq-local epa-file-error error) + (add-hook 'find-file-not-found-functions + 'epa-file--find-file-not-found-function + nil t) + (epa-display-error context)) + (signal (if exists 'file-error 'file-missing) + (cons "Opening input file" (cdr error)))))) (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! (setq-local epa-file-encrypt-to (mapcar #'car (epg-context-result-for diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 8a208044cba..02b9e45c9bb 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -44,13 +44,17 @@ (defcustom epg-gpg-program (if (executable-find "gpg2") "gpg2" "gpg") - "The `gpg' executable." + "The `gpg' executable. +Setting this variable directly does not take effect; +instead use \\[customize] (see the info node `Easy Customization')." :version "25.1" :group 'epg :type 'string) (defcustom epg-gpgsm-program "gpgsm" - "The `gpgsm' executable." + "The `gpgsm' executable. +Setting this variable directly does not take effect; +instead use \\[customize] (see the info node `Easy Customization')." :group 'epg :type 'string) @@ -81,57 +85,69 @@ Note that the buffer name starts with a space." (defconst epg-config--program-alist '((OpenPGP epg-gpg-program - epg-config--make-gpg-configuration ("gpg2" . "2.1.6") ("gpg" . "1.4.3")) (CMS epg-gpgsm-program - epg-config--make-gpgsm-configuration ("gpgsm" . "2.0.4"))) "Alist used to obtain the usable configuration of executables. The first element of each entry is protocol symbol, which is either `OpenPGP' or `CMS'. The second element is a symbol where -the executable name is remembered. The third element is a -function which constructs a configuration object (actually a -plist). The rest of the entry is an alist mapping executable -names to the minimum required version suitable for the use with -Emacs.") +the executable name is remembered. The rest of the entry is an +alist mapping executable names to the minimum required version +suitable for the use with Emacs.") + +(defconst epg-config--configuration-constructor-alist + '((OpenPGP . epg-config--make-gpg-configuration) + (CMS . epg-config--make-gpgsm-configuration)) + "Alist used to obtain the usable configuration of executables. +The first element of each entry is protocol symbol, which is +either `OpenPGP' or `CMS'. The second element is a function +which constructs a configuration object (actually a plist).") (defvar epg--configurations nil) ;;;###autoload -(defun epg-find-configuration (protocol &optional force) +(defun epg-find-configuration (protocol &optional no-cache program-alist) "Find or create a usable configuration to handle PROTOCOL. This function first looks at the existing configuration found by -the previous invocation of this function, unless FORCE is non-nil. - -Then it walks through `epg-config--program-alist'. If -`epg-gpg-program' or `epg-gpgsm-program' is already set with -custom, use it. Otherwise, it tries the programs listed in the -entry until the version requirement is met." - (let ((entry (assq protocol epg-config--program-alist))) +the previous invocation of this function, unless NO-CACHE is non-nil. + +Then it walks through PROGRAM-ALIST or +`epg-config--program-alist'. If `epg-gpg-program' or +`epg-gpgsm-program' is already set with custom, use it. +Otherwise, it tries the programs listed in the entry until the +version requirement is met." + (unless program-alist + (setq program-alist epg-config--program-alist)) + (let ((entry (assq protocol program-alist))) (unless entry (error "Unknown protocol %S" protocol)) - (cl-destructuring-bind (symbol constructor . alist) + (cl-destructuring-bind (symbol . alist) (cdr entry) - (or (and (not force) (alist-get protocol epg--configurations)) - ;; If the executable value is already set with M-x - ;; customize, use it without checking. - (if (get symbol 'saved-value) - (let ((configuration (funcall constructor (symbol-value symbol)))) - (push (cons protocol configuration) epg--configurations) - configuration) - (catch 'found - (dolist (program-version alist) - (let ((executable (executable-find (car program-version)))) - (when executable - (let ((configuration - (funcall constructor executable))) - (when (ignore-errors - (epg-check-configuration configuration - (cdr program-version)) - t) - (push (cons protocol configuration) epg--configurations) - (throw 'found configuration)))))))))))) + (let ((constructor + (alist-get protocol epg-config--configuration-constructor-alist))) + (or (and (not no-cache) (alist-get protocol epg--configurations)) + ;; If the executable value is already set with M-x + ;; customize, use it without checking. + (if (and symbol (get symbol 'saved-value)) + (let ((configuration + (funcall constructor (symbol-value symbol)))) + (push (cons protocol configuration) epg--configurations) + configuration) + (catch 'found + (dolist (program-version alist) + (let ((executable (executable-find (car program-version)))) + (when executable + (let ((configuration + (funcall constructor executable))) + (when (ignore-errors + (epg-check-configuration configuration + (cdr program-version)) + t) + (unless no-cache + (push (cons protocol configuration) + epg--configurations)) + (throw 'found configuration))))))))))))) ;; Create an `epg-configuration' object for `gpg', using PROGRAM. (defun epg-config--make-gpg-configuration (program) diff --git a/lisp/epg.el b/lisp/epg.el index f4058ed35a4..315eb40f0a4 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -604,9 +604,13 @@ callback data (if any)." (setq process-environment (cons (concat "GPG_TTY=" terminal-name) (cons "TERM=xterm" process-environment)))) - ;; Start the Emacs Pinentry server if allow-emacs-pinentry is set - ;; in ~/.gnupg/gpg-agent.conf. + ;; Automatically start the Emacs Pinentry server if appropriate. (when (and (fboundp 'pinentry-start) + ;; Emacs Pinentry is useless if Emacs has no interactive session. + (not noninteractive) + ;; Prefer pinentry-mode over Emacs Pinentry. + (null (epg-context-pinentry-mode context)) + ;; Check if the allow-emacs-pinentry option is set. (executable-find epg-gpgconf-program) (with-temp-buffer (when (= (call-process epg-gpgconf-program nil t nil @@ -1749,12 +1753,7 @@ If optional 3rd argument MODE is t or `detached', it makes a detached signature. If it is nil or `normal', it makes a normal signature. Otherwise, it makes a cleartext signature." (let ((input-file - (unless (or (eq (epg-context-protocol context) 'CMS) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - t) - (error))) + (unless (eq (epg-context-protocol context) 'CMS) (epg--make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect @@ -1861,12 +1860,7 @@ If RECIPIENTS is nil, it performs symmetric encryption." If RECIPIENTS is nil, it performs symmetric encryption." (let ((input-file (unless (or (not sign) - (eq (epg-context-protocol context) 'CMS) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - t) - (error))) + (eq (epg-context-protocol context) 'CMS)) (epg--make-temp-file "epg-input"))) (coding-system-for-write 'binary)) (unwind-protect diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 407beb47d79..15644967787 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -10324,8 +10324,8 @@ * TODO: TODO list created. Add comments and expand it. - * erc.el: - Fixed bug in query buffer handling (only happend in mixed-case situations) + * erc.el: Fixed bug in query buffer handling (only happened in + mixed-case situations) * erc.el: shapr checkdoc patch #1 massive docfixes! yay, keep going! diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index b413ee5a547..288e8efe73e 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1,4 +1,4 @@ -;;; erc-backend.el --- Backend network communication for ERC +;;; erc-backend.el --- Backend network communication for ERC -*- lexical-binding:t -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -108,7 +108,7 @@ ;;;; Variables and options (defvar erc-server-responses (make-hash-table :test #'equal) - "Hashtable mapping server responses to their handler hooks.") + "Hash table mapping server responses to their handler hooks.") (cl-defstruct (erc-response (:conc-name erc-response.)) (unparsed "" :type string) @@ -376,7 +376,7 @@ alist." :type '(repeat (cons (string :tag "Target") coding-system))) -(defcustom erc-server-connect-function 'erc-open-network-stream +(defcustom erc-server-connect-function #'erc-open-network-stream "Function used to initiate a connection. It should take same arguments as `open-network-stream' does." :group 'erc-server @@ -574,8 +574,8 @@ We will store server variables in the buffer given by BUFFER." (when (fboundp 'set-process-coding-system) (set-process-coding-system process 'raw-text)) ;; process handlers - (set-process-sentinel process 'erc-process-sentinel) - (set-process-filter process 'erc-server-filter-function) + (set-process-sentinel process #'erc-process-sentinel) + (set-process-filter process #'erc-server-filter-function) (set-process-buffer process buffer) (erc-log "\n\n\n********************************************\n") (message "%s" (erc-format-message @@ -603,11 +603,11 @@ Make sure you are in an ERC buffer when running this." (setq erc-server-last-sent-time 0) (setq erc-server-lines-sent 0) (let ((erc-server-connect-function (or erc-session-connector - 'erc-open-network-stream))) + #'erc-open-network-stream))) (erc-open erc-session-server erc-session-port erc-server-current-nick erc-session-user-full-name t erc-session-password))))) -(defun erc-server-delayed-reconnect (event buffer) +(defun erc-server-delayed-reconnect (buffer) (if (buffer-live-p buffer) (with-current-buffer buffer (erc-server-reconnect)))) @@ -648,7 +648,6 @@ EVENT is the message received from the closed connection process." (or erc-server-reconnecting (and erc-server-auto-reconnect (not erc-server-banned) - (not erc-server-error-occurred) ;; make sure we don't infinitely try to reconnect, unless the ;; user wants that (or (eq erc-server-reconnect-attempts t) @@ -677,18 +676,18 @@ EVENT is the message received from the closed connection process." (erc-update-mode-line) (set-buffer-modified-p nil)) ;; reconnect - (condition-case err + (condition-case nil (progn (setq erc-server-reconnecting nil erc-server-reconnect-count (1+ erc-server-reconnect-count)) (setq delay erc-server-reconnect-timeout) (run-at-time delay nil - #'erc-server-delayed-reconnect event buffer)) + #'erc-server-delayed-reconnect buffer)) (error (unless (integerp erc-server-reconnect-attempts) (message "%s ... %s" "Reconnecting until we succeed" "kill the ERC server buffer to stop")) - (erc-server-delayed-reconnect event buffer)))))))) + (erc-server-delayed-reconnect buffer)))))))) (defun erc-process-sentinel-1 (event buffer) "Called when `erc-process-sentinel' has decided that we're disconnecting. @@ -811,7 +810,7 @@ protection algorithm." (+ erc-server-flood-penalty erc-server-flood-last-message)) (erc-log-irc-protocol str 'outbound) - (condition-case err + (condition-case nil (progn ;; Set encoding just before sending the string (when (fboundp 'set-process-coding-system) @@ -878,7 +877,7 @@ protection algorithm." (erc-log (concat "erc-server-send-queue: " msg "(" (buffer-name buffer) ")")) (when (erc-server-process-alive) - (condition-case err + (condition-case nil ;; Set encoding just before sending the string (progn (when (fboundp 'set-process-coding-system) @@ -1062,14 +1061,14 @@ See also `erc-server-responses'." (defun erc-call-hooks (process message) "Call hooks associated with MESSAGE in PROCESS. -Finds hooks by looking in the `erc-server-responses' hashtable." +Finds hooks by looking in the `erc-server-responses' hash table." (let ((hook (or (erc-get-hook (erc-response.command message)) 'erc-default-server-functions))) (run-hook-with-args-until-success hook process message) (erc-with-server-buffer (run-hook-with-args 'erc-timer-hook (erc-current-time))))) -(add-hook 'erc-default-server-functions 'erc-handle-unknown-server-response) +(add-hook 'erc-default-server-functions #'erc-handle-unknown-server-response) (defun erc-handle-unknown-server-response (proc parsed) "Display unknown server response's message." @@ -1077,7 +1076,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable." " " (erc-response.command parsed) " " - (mapconcat 'identity (erc-response.command-args parsed) + (mapconcat #'identity (erc-response.command-args parsed) " ")))) (erc-display-message parsed 'notice proc line))) @@ -1208,17 +1207,18 @@ add things to `%s' instead." ;; value at this point, so I default to nil, and (add-hook) ;; unconditionally (defvar ,hook-name nil ,(format hook-doc name)) - (add-to-list ',hook-name ',fn-name) + (add-hook ',hook-name #',fn-name) ;; Handler function (defun ,fn-name (proc parsed) ,fn-doc + (ignore proc parsed) ,@fn-body) ;; Make find-function and find-variable find them (put ',fn-name 'definition-name ',name) (put ',hook-name 'definition-name ',name) - ;; Hashtable map of responses to hook variables + ;; Hash table map of responses to hook variables ,@(cl-loop for response in (cons name aliases) for var in (cons hook-name var-alternates) collect `(puthash ,(format "%s" response) ',var @@ -1324,7 +1324,7 @@ add things to `%s' instead." (define-erc-response-handler (MODE) "Handle server mode changes." nil (let ((tgt (car (erc-response.command-args parsed))) - (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) + (mode (mapconcat #'identity (cdr (erc-response.command-args parsed)) " "))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) @@ -1366,11 +1366,11 @@ add things to `%s' instead." (cons nn (cdr erc-default-recipients))) (rename-buffer nn t) ; bug#12002 (erc-update-mode-line) - (add-to-list 'bufs (current-buffer))))) + (cl-pushnew (current-buffer) bufs)))) (erc-update-user-nick nick nn host nil nil login) (cond ((string= nick (erc-current-nick)) - (add-to-list 'bufs (erc-server-buffer)) + (cl-pushnew (erc-server-buffer) bufs) (erc-set-current-nick nn) (erc-update-mode-line) (setq erc-nick-change-attempt-count 0) @@ -1491,7 +1491,7 @@ add things to `%s' instead." ;; FIXME: need clean way of specifying extra hooks in ;; define-erc-response-handler. -(add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) +(add-hook 'erc-server-PRIVMSG-functions #'erc-auto-query) (define-erc-response-handler (QUIT) "Another user has quit IRC." nil @@ -1522,7 +1522,7 @@ add things to `%s' instead." (define-erc-response-handler (WALLOPS) "Display a WALLOPS message." nil (let ((message (erc-response.contents parsed))) - (pcase-let ((`(,nick ,login ,host) + (pcase-let ((`(,nick ,_login ,_host) (erc-parse-user (erc-response.sender parsed)))) (erc-display-message parsed 'notice nil @@ -1574,7 +1574,7 @@ certain commands are accepted and more. See documentation for A server may send more than one 005 message." nil - (let ((line (mapconcat 'identity + (let ((line (mapconcat #'identity (setf (erc-response.command-args parsed) (cdr (erc-response.command-args parsed))) " "))) @@ -1593,7 +1593,7 @@ A server may send more than one 005 message." (define-erc-response-handler (221) "Display the current user modes." nil (let* ((nick (car (erc-response.command-args parsed))) - (modes (mapconcat 'identity + (modes (mapconcat #'identity (cdr (erc-response.command-args parsed)) " "))) (erc-set-modes nick modes) (erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes))) @@ -1621,12 +1621,12 @@ See `erc-display-server-message'." nil (define-erc-response-handler (275) "Display secure connection message." nil - (pcase-let ((`(,nick ,user ,message) + (pcase-let ((`(,nick ,_user ,_message) (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's275 ?n nick - ?m (mapconcat 'identity (cddr (erc-response.command-args parsed)) + ?m (mapconcat #'identity (cddr (erc-response.command-args parsed)) " ")))) (define-erc-response-handler (290) @@ -1657,12 +1657,12 @@ See `erc-display-server-message'." nil (define-erc-response-handler (307) "Display nick-identified message." nil - (pcase-let ((`(,nick ,user ,message) + (pcase-let ((`(,nick ,_user ,_message) (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's307 ?n nick - ?m (mapconcat 'identity (cddr (erc-response.command-args parsed)) + ?m (mapconcat #'identity (cddr (erc-response.command-args parsed)) " ")))) (define-erc-response-handler (311 314) @@ -1736,12 +1736,12 @@ See `erc-display-server-message'." nil "Display a message for the 321 event." (erc-display-message parsed 'notice proc 's321) nil) -(add-hook 'erc-server-321-functions 'erc-server-321-message t) +(add-hook 'erc-server-321-functions #'erc-server-321-message t) (define-erc-response-handler (322) "LIST notice." nil (let ((topic (erc-response.contents parsed))) - (pcase-let ((`(,channel ,num-users) + (pcase-let ((`(,channel ,_num-users) (cdr (erc-response.command-args parsed)))) (add-to-list 'erc-channel-list (list channel)) (erc-update-channel-topic channel topic)))) @@ -1754,12 +1754,12 @@ See `erc-display-server-message'." nil (erc-display-message parsed 'notice proc 's322 ?c channel ?u num-users ?t (or topic ""))))) -(add-hook 'erc-server-322-functions 'erc-server-322-message t) +(add-hook 'erc-server-322-functions #'erc-server-322-message t) (define-erc-response-handler (324) "Channel or nick modes." nil (let ((channel (cadr (erc-response.command-args parsed))) - (modes (mapconcat 'identity (cddr (erc-response.command-args parsed)) + (modes (mapconcat #'identity (cddr (erc-response.command-args parsed)) " "))) (erc-set-modes channel modes) (erc-display-message @@ -1801,8 +1801,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (331) "No topic set for channel." nil - (let ((channel (cadr (erc-response.command-args parsed))) - (topic (erc-response.contents parsed))) + (let ((channel (cadr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's331 ?c channel))) @@ -1836,12 +1835,10 @@ See `erc-display-server-message'." nil (define-erc-response-handler (352) "WHO notice." nil - (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag) + (pcase-let ((`(,channel ,user ,host ,_server ,nick ,away-flag) (cdr (erc-response.command-args parsed)))) - (let ((full-name (erc-response.contents parsed)) - hopcount) + (let ((full-name (erc-response.contents parsed))) (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) - (setq hopcount (match-string 1 full-name)) (setq full-name (match-string 2 full-name))) (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name) (erc-display-message parsed 'notice 'active 's352 @@ -2005,7 +2002,7 @@ See `erc-display-server-message'." nil "You need to be a channel operator to do that." nil (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) - (erc-display-message parsed '(error notice) 'active 's482 + (erc-display-message parsed '(notice error) 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 7d509196330..f63ac17ab47 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -390,9 +390,9 @@ REGEXP is the regular expression which matched for this button." ;; merged correctly. If we use overlays, then redisplay will be ;; very slow with lots of buttons. This is why we manually merge ;; face text properties. - (let ((old (erc-list (get-text-property from 'face))) + (let ((old (erc-list (get-text-property from 'font-lock-face))) (pos from) - (end (next-single-property-change from 'face nil to)) + (end (next-single-property-change from 'font-lock-face nil to)) new) ;; old is the face at pos, in list form. It is nil if there is no ;; face at pos. If nil, the new face is FACE. If not nil, the @@ -400,10 +400,10 @@ REGEXP is the regular expression which matched for this button." ;; where this face changes. (while (< pos to) (setq new (if old (cons face old) face)) - (put-text-property pos end 'face new) + (put-text-property pos end 'font-lock-face new) (setq pos end - old (erc-list (get-text-property pos 'face)) - end (next-single-property-change pos 'face nil to))))) + old (erc-list (get-text-property pos 'font-lock-face)) + end (next-single-property-change pos 'font-lock-face nil to))))) ;; widget-button-click calls with two args, we ignore the first. ;; Since Emacs runs this directly, rather than with diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 4b956cc01ac..1a93e212100 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -191,7 +191,8 @@ PARSED is an `erc-parsed' response struct." (re-search-forward (regexp-quote nickname) nil t)) (goto-char (match-beginning 0)) (insert (erc-propertize erc-capab-identify-prefix - 'face 'erc-capab-identify-unidentified)))))) + 'font-lock-face + 'erc-capab-identify-unidentified)))))) (defun erc-capab-identify-get-unidentified-nickname (parsed) "Return the nickname of the user if unidentified. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 1bf380d47d1..1b9b8ac679a 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1005,7 +1005,7 @@ rather than every 1024 byte block, but nobody seems to care." ((and (> (plist-get erc-dcc-entry-data :size) 0) (> received-bytes (plist-get erc-dcc-entry-data :size))) (erc-display-message - nil '(error notice) 'active + nil '(notice error) 'active 'dcc-get-file-too-long ?f (file-name-nondirectory buffer-file-name)) (delete-process proc)) @@ -1205,7 +1205,7 @@ other client." (setq posn (match-end 0)) (erc-display-message nil nil proc - 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'face + 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face 'erc-nick-default-face) ?m line)) (setq erc-dcc-unprocessed-output (substring str posn))))) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 2a1d18720aa..afe8c555ce3 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -475,7 +475,7 @@ to a region in the current buffer." (font-lock-prepend-text-property from to - 'face + 'font-lock-face (append (if boldp '(erc-bold-face) nil) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 1313ecc6072..4104a433995 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -486,7 +486,7 @@ Use this defun with `erc-insert-modify-hook'." nick-end) (erc-put-text-property nick-beg nick-end - 'face match-face (current-buffer))) + 'font-lock-face match-face (current-buffer))) ;; Highlight the nick of the message, or the current ;; nick if there's no nick in the message (e.g. /NAMES ;; output) @@ -495,17 +495,17 @@ Use this defun with `erc-insert-modify-hook'." (if nick-end (erc-put-text-property nick-beg nick-end - 'face match-face (current-buffer)) + 'font-lock-face match-face (current-buffer)) (goto-char (+ 2 (or nick-end (point-min)))) (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face match-face)))) + 'font-lock-face match-face)))) ;; Highlight the whole message ((eq match-htype 'all) (erc-put-text-property (point-min) (point-max) - 'face match-face (current-buffer))) + 'font-lock-face match-face (current-buffer))) ;; Highlight all occurrences of the word to be ;; highlighted. ((and (string= match-type "keyword") @@ -521,7 +521,7 @@ Use this defun with `erc-insert-modify-hook'." (while (re-search-forward regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face face)))) + 'font-lock-face face)))) match-regex)) ;; Highlight all occurrences of our nick. ((and (string= match-type "current-nick") @@ -530,7 +530,7 @@ Use this defun with `erc-insert-modify-hook'." (point-min)))) (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) - 'face match-face))) + 'font-lock-face match-face))) ;; Else twiddle your thumbs. (t nil)) (run-hook-with-args diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a4c91ca9fb5..ee4e1d2fb6d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -347,7 +347,8 @@ changed, it will then print it off to the right." Return the empty string if FORMAT is nil." (if format (let ((ts (format-time-string format time))) - (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts) + (erc-put-text-property 0 (length ts) + 'font-lock-face 'erc-timestamp-face ts) (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) (erc-put-text-property 0 (length ts) 'isearch-open-invisible 'timestamp ts) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 4d8feb52759..a6d72d07d1d 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -480,99 +480,6 @@ START is the minimum length of the name used." (setq result other))) result)) -;;; Test: - -(cl-assert - (and - ;; verify examples from the doc strings - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#em" "#vi")) ; emacs is different from electronica - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#em" "#v")) ; vi is shortened by one letter - (equal (let ((erc-track-shorten-aggressively 'max)) - (erc-unique-channel-names - '("#emacs" "#vi" "#electronica" "#folk") - '("#emacs" "#vi"))) - '("#e" "#v")) ; emacs need not be different from electronica - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#linux-de" "#linux-fr") - '("#linux-de" "#linux-fr"))) - '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-channel-names - '("#linux-de" "#linux-fr") - '("#linux-de" "#linux-fr"))) - '("#linux-d" "#linux-f")); now we want to be aggressive - ;; specific problems - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" - "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny" - "#emacs") - '("#hurd-bunny" "#hurd" "#sawfish" "#lisp"))) - '("#hurd-" "#hurd" "#s" "#l")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-substrings - '("#emacs" "#vi" "#electronica" "#folk"))) - '("#em" "#vi" "#el" "#f")) - (equal (let ((erc-track-shorten-aggressively t)) - (erc-unique-substrings - '("#emacs" "#vi" "#electronica" "#folk"))) - '("#em" "#v" "#el" "#f")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("#emacs" "#burse" "+linux.de" "#starwars" - "#bitlbee" "+burse" "#ratpoison") - '("+linux.de" "#starwars" "#burse"))) - '("+l" "#s" "#bu")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot"))) - '("fs")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot") - (lambda (s) - (> (length s) 4)) - 1)) - '("f")) - (equal (let ((erc-track-shorten-aggressively nil)) - (erc-unique-channel-names - '("fsbot" "#emacs" "deego") - '("fsbot") - (lambda (s) - (> (length s) 4)) - 2)) - '("fs")) - (let ((erc-track-shorten-aggressively nil)) - (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs") - '("#hurd" "#hurd-bunny")) - '("#hurd" "#hurd-"))) - ;; general examples - (let ((erc-track-shorten-aggressively t)) - (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") - (not (erc-unique-substring-1 "a" '("xyz" "xab"))) - (equal (erc-unique-substrings '("abc" "xyz" "xab")) - '("ab" "xy" "xa")) - (equal (erc-unique-substrings '("abc" "abcdefg")) - '("abc" "abcd")))) - (let ((erc-track-shorten-aggressively nil)) - (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") - (not (erc-unique-substring-1 "a" '("xyz" "xab"))) - (equal (erc-unique-substrings '("abc" "xyz" "xab")) - '("abc" "xyz" "xab")) - (equal (erc-unique-substrings '("abc" "abcdefg")) - '("abc" "abcd")))))) - ;;; Minor mode ;; Play nice with other IRC clients (and Emacs development rules) by @@ -981,13 +888,6 @@ is in `erc-mode'." (push cur faces))) faces)) -(cl-assert - (let ((str "is bold")) - (put-text-property 3 (length str) - 'face '(bold erc-current-nick-face) - str) - (erc-faces-in str))) - ;;; Buffer switching (defvar erc-track-last-non-erc-buffer nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 52adec1ce46..8501e2cba7d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2276,7 +2276,7 @@ and appears in face `erc-input-face' in the buffer." (aref string (1- (length string)))) "\n")) - 'face 'erc-input-face))))) + 'font-lock-face 'erc-input-face))))) (let ((orig-win (selected-window)) (debug-buffer-window (get-buffer-window (current-buffer) t))) (when debug-buffer-window @@ -2466,9 +2466,9 @@ See also `erc-make-notice'." (t (erc-put-text-property 0 (length string) - 'face (or (intern-soft - (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'font-lock-face (or (intern-soft + (concat "erc-" (symbol-name type) "-face")) + "erc-default-face") string) string))) @@ -3897,7 +3897,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, 'front-sticky t 'read-only t)) (erc-put-text-property 0 (1- (length prompt)) - 'face (or face 'erc-prompt-face) + 'font-lock-face (or face 'erc-prompt-face) prompt) (insert prompt)) ;; Set the input marker @@ -4260,11 +4260,11 @@ and as second argument the event parsed as a vector." (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick - (erc-put-text-property 0 (length mark-s) 'face msg-face str) + (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'face nick-face str) + 'font-lock-face nick-face str) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) - 'face msg-face str) + 'font-lock-face msg-face str) str)) (defcustom erc-format-nick-function 'erc-format-nick @@ -4301,7 +4301,7 @@ also `erc-format-nick-function'." (let ((nick (erc-server-user-nickname user))) (concat (erc-propertize (erc-get-user-mode-prefix nick) - 'face 'erc-nick-prefix-face) + 'font-lock-face 'erc-nick-prefix-face) nick)))) (defun erc-format-my-nick () @@ -4312,12 +4312,12 @@ also `erc-format-nick-function'." (nick (erc-current-nick)) (mode (erc-get-user-mode-prefix nick))) (concat - (erc-propertize open 'face 'erc-default-face) - (erc-propertize mode 'face 'erc-my-nick-prefix-face) - (erc-propertize nick 'face 'erc-my-nick-face) - (erc-propertize close 'face 'erc-default-face))) + (erc-propertize open 'font-lock-face 'erc-default-face) + (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face) + (erc-propertize nick 'font-lock-face 'erc-my-nick-face) + (erc-propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) - (erc-propertize prefix 'face 'erc-default-face)))) + (erc-propertize prefix 'font-lock-face 'erc-default-face)))) (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) "Echos a private notice in the default buffer, namely the @@ -5238,10 +5238,10 @@ See also variable `erc-notice-highlight-type'." (cond ((eq erc-notice-highlight-type 'prefix) (erc-put-text-property 0 (length erc-notice-prefix) - 'face 'erc-notice-face s) + 'font-lock-face 'erc-notice-face s) s) ((eq erc-notice-highlight-type 'all) - (erc-put-text-property 0 (length s) 'face 'erc-notice-face s) + (erc-put-text-property 0 (length s) 'font-lock-face 'erc-notice-face s) s) (t s))) @@ -5253,7 +5253,7 @@ See also variable `erc-notice-highlight-type'." (defun erc-highlight-error (s) "Highlight error message S and return it." - (erc-put-text-property 0 (length s) 'face 'erc-error-face s) + (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) (defun erc-put-text-property (start end property value &optional object) @@ -5443,7 +5443,7 @@ This returns non-nil only if we actually send anything." (let ((beg (point))) (insert line) (erc-put-text-property beg (point) - 'face 'erc-command-indicator-face) + 'font-lock-face 'erc-command-indicator-face) (insert "\n")) (when (processp erc-server-process) (set-marker (process-mark erc-server-process) (point))) @@ -5463,7 +5463,7 @@ current position." (let ((beg (point))) (insert line) (erc-put-text-property beg (point) - 'face 'erc-input-face)) + 'font-lock-face 'erc-input-face)) (insert "\n") (when (processp erc-server-process) (set-marker (process-mark erc-server-process) (point))) @@ -5887,7 +5887,7 @@ user input." (setq args (substring args 1))) ;; prepare the prompt string for echo (erc-put-text-property 0 (length sp) - 'face 'erc-command-indicator-face sp) + 'font-lock-face 'erc-command-indicator-face sp) (while lines (setq s (car lines)) (erc-log (concat "erc-load-script: CMD: " s)) @@ -5897,7 +5897,7 @@ user input." erc-script-echo) (progn (erc-put-text-property 0 (length line) - 'face 'erc-input-face line) + 'font-lock-face 'erc-input-face line) (erc-display-line (concat sp line) cb))))) (setq lines (cdr lines))))) @@ -6007,10 +6007,8 @@ Returns a list of the form (HIGH LOW), compatible with Emacs time format." (list (truncate (/ n 65536)) (truncate (mod n 65536))))) -(defalias 'erc-emacs-time-to-erc-time - (if (featurep 'xemacs) 'time-to-seconds 'float-time)) - -(defalias 'erc-current-time 'erc-emacs-time-to-erc-time) +(defalias 'erc-emacs-time-to-erc-time 'float-time) +(defalias 'erc-current-time 'float-time) (defun erc-time-diff (t1 t2) "Return the time difference in seconds between T1 and T2." diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 198b1d017c4..067c5ea7ff2 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -119,15 +119,14 @@ If set to t, history will always be saved, silently." (const :tag "Always save" t)) :group 'eshell-hist) -(defcustom eshell-input-filter - (function - (lambda (str) - (not (string-match "\\`\\s-*\\'" str)))) +(defcustom eshell-input-filter 'eshell-input-filter-default "Predicate for filtering additions to input history. Takes one argument, the input. If non-nil, the input may be saved on the input history list. Default is to save anything that isn't all whitespace." - :type 'function + :type '(radio (function-item eshell-input-filter-default) + (function-item eshell-input-filter-initial-space) + (function :tag "Other function")) :group 'eshell-hist) (put 'eshell-input-filter 'risky-local-variable t) @@ -206,6 +205,16 @@ element, regardless of any text on the command line. In that case, ;;; Functions: +(defun eshell-input-filter-default (input) + "Do not add blank input to input history. +Returns non-nil if INPUT is blank." + (not (string-match "\\`\\s-*\\'" input))) + +(defun eshell-input-filter-initial-space (input) + "Do not add input beginning with empty space to history. +Returns nil if INPUT is prepended by blank space, otherwise non-nil." + (not (string-match-p "\\`\\s-+" input))) + (defun eshell-hist-initialize () "Initialize the history management code for one Eshell buffer." (add-hook 'eshell-expand-input-functions diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index cf6609ff729..8616dd2479b 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -101,46 +101,36 @@ faster and conserves more memory." (((class color) (background dark)) (:foreground "SkyBlue" :weight bold)) (t (:weight bold))) "The face used for highlighting directories.") -(define-obsolete-face-alias 'eshell-ls-directory-face - 'eshell-ls-directory "22.1") (defface eshell-ls-symlink '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) (((class color) (background dark)) (:foreground "Cyan" :weight bold))) "The face used for highlighting symbolic links.") -(define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1") (defface eshell-ls-executable '((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) (((class color) (background dark)) (:foreground "Green" :weight bold))) "The face used for highlighting executables (not directories, though).") -(define-obsolete-face-alias 'eshell-ls-executable-face - 'eshell-ls-executable "22.1") (defface eshell-ls-readonly '((((class color) (background light)) (:foreground "Brown")) (((class color) (background dark)) (:foreground "Pink"))) "The face used for highlighting read-only files.") -(define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1") (defface eshell-ls-unreadable '((((class color) (background light)) (:foreground "Grey30")) (((class color) (background dark)) (:foreground "DarkGrey"))) "The face used for highlighting unreadable files.") -(define-obsolete-face-alias 'eshell-ls-unreadable-face - 'eshell-ls-unreadable "22.1") (defface eshell-ls-special '((((class color) (background light)) (:foreground "Magenta" :weight bold)) (((class color) (background dark)) (:foreground "Magenta" :weight bold))) "The face used for highlighting non-regular files.") -(define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1") (defface eshell-ls-missing '((((class color) (background light)) (:foreground "Red" :weight bold)) (((class color) (background dark)) (:foreground "Red" :weight bold))) "The face used for highlighting non-existent file names.") -(define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1") (defcustom eshell-ls-archive-regexp (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|" @@ -155,7 +145,6 @@ files." '((((class color) (background light)) (:foreground "Orchid" :weight bold)) (((class color) (background dark)) (:foreground "Orchid" :weight bold))) "The face used for highlighting archived and compressed file names.") -(define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1") (defcustom eshell-ls-backup-regexp "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" @@ -166,7 +155,6 @@ files." '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) "The face used for highlighting backup file names.") -(define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1") (defcustom eshell-ls-product-regexp "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'" @@ -179,7 +167,6 @@ ought to be recreatable if they are deleted." '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) "The face used for highlighting files that are build products.") -(define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1") (defcustom eshell-ls-clutter-regexp "\\(^texput\\.log\\|^core\\)\\'" @@ -192,7 +179,6 @@ really need to stick around for very long." '((((class color) (background light)) (:foreground "OrangeRed" :weight bold)) (((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) "The face used for highlighting junk file names.") -(define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1") (defsubst eshell-ls-filetype-p (attrs type) "Test whether ATTRS specifies a directory." diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 3e5de0c0097..208629ce135 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -102,10 +102,11 @@ See also `eshell-visual-commands' and `eshell-visual-options'." of commands with options that present their output in a visual fashion. For example, a sensible entry would be - (\"git\" \"--help\") + (\"git\" \"--help\" \"--paginate\") because \"git <command> --help\" shows the command's -documentation with a pager. +documentation with a pager and \"git --paginate <command>\" +always uses a pager for output. See also `eshell-visual-commands' and `eshell-visual-subcommands'." :type '(repeat (cons (string :tag "Command") diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 9105c482b38..3eff20d1a1b 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -72,8 +72,7 @@ Become another USER during a login session.") (let ((user "root") (host (or (file-remote-p default-directory 'host) "localhost")) - (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory))) + (dir (file-local-name (expand-file-name default-directory))) (prefix (file-remote-p default-directory))) (dolist (arg args) (if (string-equal arg "-") (setq login t) (setq user arg))) @@ -111,8 +110,7 @@ Execute a COMMAND as the superuser or another USER.") (let ((user (or user "root")) (host (or (file-remote-p default-directory 'host) "localhost")) - (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory))) + (dir (file-local-name (expand-file-name default-directory))) (prefix (file-remote-p default-directory))) ;; `eshell-eval-using-options' reads options of COMMAND. (while (and (stringp (car orig-args)) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c27c18c52ba..e40dbded60b 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -748,7 +748,12 @@ external command." (cmd (progn (set-text-properties 0 (length args) '(invisible t) args) - (format "%s -n %s" command args))) + (format "%s -n %s" + (pcase command + ("egrep" "grep -E") + ("fgrep" "grep -F") + (x x)) + args))) compilation-scroll-output) (grep cmd))))) @@ -757,11 +762,11 @@ external command." (eshell-grep "grep" args t)) (defun eshell/egrep (&rest args) - "Use Emacs grep facility instead of calling external egrep." + "Use Emacs grep facility instead of calling external grep -E." (eshell-grep "egrep" args t)) (defun eshell/fgrep (&rest args) - "Use Emacs grep facility instead of calling external fgrep." + "Use Emacs grep facility instead of calling external grep -F." (eshell-grep "fgrep" args t)) (defun eshell/agrep (&rest args) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 60615131e20..d3613d31405 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -800,7 +800,7 @@ This macro calls itself recursively, with NOTFIRST non-nil." (defmacro eshell-do-pipelines-synchronously (pipeline) "Execute the commands in PIPELINE in sequence synchronously. Output of each command is passed as input to the next one in the pipeline. -This is used on systems where `start-process' is not supported." +This is used on systems where async subprocesses are not supported." (when (setq pipeline (cadr pipeline)) `(progn ,(when (cdr pipeline) @@ -838,7 +838,7 @@ This is used on systems where `start-process' is not supported." "Execute the commands in PIPELINE, connecting each to one another." `(let ((eshell-in-pipeline-p t) tailproc) (progn - ,(if (fboundp 'start-process) + ,(if (fboundp 'make-process) `(eshell-do-pipelines ,pipeline) `(let ((tail-handles (eshell-create-handles (car (aref eshell-current-handles diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index ca62d0cf8b0..4d658cd718e 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -203,7 +203,7 @@ all the output from the remote command, and sends it all at once, causing the user to wonder if anything's really going on..." (let ((outbuf (generate-new-buffer " *eshell remote output*")) (errbuf (generate-new-buffer " *eshell remote error*")) - (command (or (file-remote-p command 'localname) command)) + (command (file-local-name command)) (exitcode 1)) (unwind-protect (progn diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 074b94cc75d..e687fd2dcbd 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -143,7 +143,7 @@ See variable `eshell-scroll-show-maximum-output' and function :type '(radio (const :tag "Do not scroll Eshell windows" nil) (const :tag "Scroll all windows showing the buffer" all) (const :tag "Scroll only the selected window" this) - (const :tag "Scroll all windows other than selected" this)) + (const :tag "Scroll all windows other than selected" others)) :group 'eshell-mode) (defcustom eshell-scroll-show-maximum-output t @@ -380,6 +380,11 @@ and the hook `eshell-exit-hook'." (make-local-variable 'eshell-modules-list) (setq eshell-modules-list modules-list)) + ;; This is to avoid making the paragraph base direction + ;; right-to-left if the first word just happens to start with a + ;; strong R2L character. + (setq bidi-paragraph-direction 'left-to-right) + ;; load extension modules into memory. This will cause any global ;; variables they define to be visible, since some of the core ;; modules sometimes take advantage of their functionality if used. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 8c6bad089c5..21680df765d 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -279,7 +279,7 @@ See `eshell-needs-pipe'." (let ((process-connection-type (unless (eshell-needs-pipe-p command) process-connection-type)) - (command (or (file-remote-p command 'localname) command))) + (command (file-local-name command))) (apply 'start-file-process (file-name-nondirectory command) nil ;; `start-process' can't deal with relative filenames. diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 7213ad70e84..5915efbac1e 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -530,7 +530,7 @@ Integers imply a direct index, and names, an associate lookup using For example, to retrieve the second element of a user's record in '/etc/passwd', the variable reference would look like: - ${egrep johnw /etc/passwd}[: 2]" + ${grep johnw /etc/passwd}[: 2]" (while indices (let ((refs (car indices))) (when (stringp value) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 0da6be7430b..9c2cae14b38 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -256,6 +256,23 @@ disable `text-scale-mode' as necessary)." text-scale-mode-amount)))) (force-window-update (current-buffer))) +(defun text-scale-min-amount () + "Return the minimum amount of text-scaling we allow." + ;; When the resulting pixel-height of characters will become smaller + ;; than 1 pixel, we can expect trouble from the display engine. + ;; E.g., it requires that the character glyph's ascent is + ;; non-negative. + (log (/ 1.0 (frame-char-height)) text-scale-mode-step)) + +(defun text-scale-max-amount () + "Return the maximum amount of text-scaling we allow." + ;; The display engine uses a 16-bit short for pixel-width of + ;; characters, thus the 0xffff limitation. It also makes no sense + ;; to have characters wider than the display. + (log (/ (min (display-pixel-width) #xffff) + (frame-char-width)) + text-scale-mode-step)) + ;;;###autoload (defun text-scale-set (level) "Set the scale factor of the default face in the current buffer to LEVEL. @@ -266,7 +283,8 @@ Each step scales the height of the default face by the variable `text-scale-mode-step' (a negative number decreases the height by the same amount)." (interactive "p") - (setq text-scale-mode-amount level) + (setq text-scale-mode-amount + (max (min level (text-scale-max-amount)) (text-scale-min-amount))) (text-scale-mode (if (zerop text-scale-mode-amount) -1 1))) ;;;###autoload @@ -279,8 +297,13 @@ Each step scales the height of the default face by the variable height by the same amount). As a special case, an argument of 0 will remove any scaling currently active." (interactive "p") - (setq text-scale-mode-amount - (if (= inc 0) 0 (+ (if text-scale-mode text-scale-mode-amount 0) inc))) + (let* ((current-value (if text-scale-mode text-scale-mode-amount 0)) + (new-value (if (= inc 0) 0 (+ current-value inc)))) + (if (or (> new-value (text-scale-max-amount)) + (< new-value (text-scale-min-amount))) + (user-error "Cannot %s the default face height more than it already is" + (if (> inc 0) "increase" "decrease"))) + (setq text-scale-mode-amount new-value)) (text-scale-mode (if (zerop text-scale-mode-amount) -1 1))) ;;;###autoload diff --git a/lisp/faces.el b/lisp/faces.el index c9cc611a97a..f536015e981 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,4 +1,4 @@ -;;; faces.el --- Lisp faces +;;; faces.el --- Lisp faces -*- lexical-binding: t -*- ;; Copyright (C) 1992-1996, 1998-2016 Free Software Foundation, Inc. @@ -98,7 +98,31 @@ a font height that isn't optimal." (defcustom face-font-family-alternatives (mapcar (lambda (arg) (mapcar 'purecopy arg)) '(("Monospace" "courier" "fixed") + + ;; Monospace Serif is an Emacs invention, intended to work around + ;; portability problems when using Courier. It should work well + ;; when combined with Monospaced and with other standard fonts. + ("Monospace Serif" + + ;; This looks good on GNU/Linux. + "Courier 10 Pitch" + ;; This looks good on MS-Windows and OS X. + "Consolas" + ;; This looks good on macOS. "Courier" looks good too, but is + ;; jagged on GNU/Linux and so is listed later as "courier". + "Courier Std" + ;; Although these are anti-aliased, they are a bit faint compared + ;; to the above. + "FreeMono" "Nimbus Mono L" + ;; These are aliased and look jagged. + "courier" "fixed" + ;; Omit Courier New, as it is the default MS-Windows font and so + ;; would look no different, and is pretty faint on other platforms. + ) + + ;; This is present for backward compatibility. ("courier" "CMU Typewriter Text" "fixed") + ("Sans Serif" "helv" "helvetica" "arial" "fixed") ("helv" "helvetica" "arial" "fixed"))) "Alist of alternative font family names. @@ -979,31 +1003,41 @@ of the default face. Value is FACE." "Read one or more face names, prompting with PROMPT. PROMPT should not end in a space or a colon. -Return DEFAULT if the user enters the empty string. -If DEFAULT is non-nil, it should be a single face or a list of face names -\(symbols or strings). In the latter case, return the `car' of DEFAULT -\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil). - -If MULTIPLE is non-nil, this function uses `completing-read-multiple' -to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp -and it returns a list of face names. Otherwise, it reads and returns -a single face name." - (if (and default (not (stringp default))) - (setq default - (cond ((symbolp default) - (symbol-name default)) - (multiple - (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) - default ", ")) - ;; If we only want one, and the default is more than one, - ;; discard the unwanted ones. - (t (symbol-name (car default)))))) +If DEFAULT is non-nil, it should be a face (a symbol) or a face +name (a string). It can also be a list of faces or face names. + +If MULTIPLE is non-nil, the return value from this function is a +list of faces. Otherwise a single face is returned. + +If the user enter the empty string at the prompt, DEFAULT is +returned after a possible transformation according to MULTIPLE. +That is, if DEFAULT is a list and MULTIPLE is nil, the first +element of DEFAULT is returned. If DEFAULT isn't a list, but +MULTIPLE is non-nil, a one-element list containing DEFAULT is +returned. Otherwise, DEFAULT is returned verbatim." + (unless (listp default) + (setq default (list default))) + (when default + (setq default + (if multiple + (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) + default ", ") + ;; If we only want one, and the default is more than one, + ;; discard the unwanted ones. + (setq default (car default)) + (if (symbolp default) + (symbol-name default) + default)))) (when (and default (not multiple)) (require 'crm) ;; For compatibility with `completing-read-multiple' use `crm-separator' ;; to define DEFAULT if MULTIPLE is nil. (setq default (car (split-string default crm-separator t)))) + ;; Older versions of `read-face-name' did not append ": " to the + ;; prompt, so there are third party libraries that have that in the + ;; prompt. If so, remove it. + (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt)) (let ((prompt (if default (format-message "%s (default `%s'): " prompt default) (format "%s: " prompt))) @@ -2308,8 +2342,17 @@ If you set `term-file-prefix' to nil, this function does nothing." "The basic fixed-pitch face." :group 'basic-faces) +(defface fixed-pitch-serif + '((t :family "Monospace Serif")) + "The basic fixed-pitch face with serifs." + :group 'basic-faces) + (defface variable-pitch - '((t :family "Sans Serif")) + '((((type w32)) + ;; This is a kludgy workaround for an issue discussed in + ;; http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00746.html. + :font "-outline-Arial-normal-normal-normal-sans-*-*-*-*-p-*-iso8859-1") + (t :family "Sans Serif")) "The basic variable-pitch face." :group 'basic-faces) @@ -2427,6 +2470,14 @@ If you set `term-file-prefix' to nil, this function does nothing." :group 'basic-faces :version "22.1") +(defface homoglyph + '((((background dark)) :foreground "cyan") + (((type pc)) :foreground "magenta") + (t :foreground "brown")) + "Face for lookalike characters." + :group 'basic-faces + :version "26.1") + (defface nobreak-space '((((class color) (min-colors 88)) :inherit escape-glyph :underline t) (((class color) (min-colors 8)) :background "magenta") @@ -2435,6 +2486,14 @@ If you set `term-file-prefix' to nil, this function does nothing." :group 'basic-faces :version "22.1") +(defface nobreak-hyphen + '((((background dark)) :foreground "cyan") + (((type pc)) :foreground "magenta") + (t :foreground "brown")) + "Face for displaying nobreak hyphens." + :group 'basic-faces + :version "26.1") + (defgroup mode-line-faces nil "Faces used in the mode line." :group 'mode-line @@ -2467,7 +2526,6 @@ If you set `term-file-prefix' to nil, this function does nothing." :version "22.1" :group 'mode-line-faces :group 'basic-faces) -(define-obsolete-face-alias 'modeline-inactive 'mode-line-inactive "22.1") (defface mode-line-highlight '((((class color) (min-colors 88)) @@ -2478,7 +2536,6 @@ If you set `term-file-prefix' to nil, this function does nothing." :version "22.1" :group 'mode-line-faces :group 'basic-faces) -(define-obsolete-face-alias 'modeline-highlight 'mode-line-highlight "22.1") (defface mode-line-emphasis '((t (:weight bold))) @@ -2494,7 +2551,6 @@ Use the face `mode-line-highlight' for features that can be selected." :version "22.1" :group 'mode-line-faces :group 'basic-faces) -(define-obsolete-face-alias 'modeline-buffer-id 'mode-line-buffer-id "22.1") (defface header-line '((default @@ -2701,9 +2757,9 @@ It is used for characters of no fonts too." (defface read-multiple-choice-face '((t (:inherit underline :weight bold))) - "Face for the symbol name in Apropos output." + "Face for the symbol name in `read-multiple-choice' output." :group 'basic-faces - :version "25.2") + :version "26.1") ;; Faces for TTY menus. (defface tty-menu-enabled-face @@ -2833,7 +2889,7 @@ also the same size as FACE on FRAME, or fail." pattern face))) (error "No fonts match `%s'" pattern))) (car fonts)) - (cdr (assq 'font (frame-parameters (selected-frame)))))) + (frame-parameter nil 'font))) (defcustom font-list-limit 100 "This variable is obsolete and has no effect." diff --git a/lisp/ffap.el b/lisp/ffap.el index abf979f6129..3d7cebadcf6 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1510,9 +1510,9 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'." ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. (expand-file-name filename))) ;; User does not want to find a non-existent file: - ((signal 'file-error (list "Opening file buffer" - "No such file or directory" - filename))))))) + ((signal 'file-missing (list "Opening file buffer" + "No such file or directory" + filename))))))) ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. ;;;###autoload @@ -1888,7 +1888,10 @@ If `dired-at-point-require-prefix' is set, the prefix meaning is reversed." (y-or-n-p "Directory does not exist, create it? ")) (make-directory filename) (funcall ffap-directory-finder filename)) - ((error "No such file or directory `%s'" filename)))))) + (t + (signal 'file-missing (list "Opening directory" + "No such file or directory" + filename))))))) (defun dired-at-point-prompter (&optional guess) ;; Does guess and prompt step for find-file-at-point. @@ -1966,7 +1969,9 @@ Only intended for interactive use." (defun ffap-guess-file-name-at-point () "Try to get a file name at point. This hook is intended to be put in `file-name-at-point-functions'." - (let ((guess (ffap-guesser))) + ;; ffap-guesser can signal an error, and we don't want that when, + ;; e.g., the user types M-n at the "C-x C-f" prompt. + (let ((guess (ignore-errors (ffap-guesser)))) (when (stringp guess) (let ((url (ffap-url-p guess))) (or url diff --git a/lisp/files-x.el b/lisp/files-x.el index 05ad7f57c57..212c936414f 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -543,6 +543,145 @@ from the MODE alist ignoring the input argument VALUE." (add-file-local-variable-prop-line (car elt) (cdr elt)))) +;;; connection-local variables. + +;;;###autoload +(defvar enable-connection-local-variables t + "Non-nil means enable use of connection-local variables.") + +(defvar connection-local-variables-alist nil + "Alist of connection-local variable settings in the current buffer. +Each element in this list has the form (VAR . VALUE), where VAR +is a connection-local variable (a symbol) and VALUE is its value. +The actual value in the buffer may differ from VALUE, if it is +changed by the user.") +(make-variable-buffer-local 'connection-local-variables-alist) +(setq ignored-local-variables + (cons 'connection-local-variables-alist ignored-local-variables)) + +(defvar connection-local-class-alist '() + "Alist mapping connection-local variable classes (symbols) to variable lists. +Each element in this list has the form (CLASS VARIABLES). +CLASS is the name of a variable class (a symbol). +VARIABLES is a list that declares connection-local variables for +CLASS. An element in VARIABLES is an alist whose elements are of +the form (VAR . VALUE).") + +(defvar connection-local-criteria-alist '() + "Alist mapping criteria to connection-local variable classes (symbols). +Each element in this list has the form (CRITERIA CLASSES). +CRITERIA is either a regular expression identifying a remote +server, or a function with one argument IDENTIFICATION, which +returns non-nil when a remote server shall apply CLASS'es +variables. If CRITERIA is nil, it always applies. +CLASSES is a list of variable classes (symbols).") + +(defsubst connection-local-get-classes (criteria &optional identification) + "Return the connection-local classes list for CRITERIA. +CRITERIA is either a regular expression identifying a remote +server, or a function with one argument IDENTIFICATION, which +returns non-nil when a remote server shall apply CLASS'es +variables. If CRITERIA is nil, it always applies. +If IDENTIFICATION is non-nil, CRITERIA must be nil, or match +IDENTIFICATION accordingly." + (and (cond ((null identification)) + ((not (stringp identification)) + (error "Wrong identification `%s'" identification)) + ((null criteria)) + ((stringp criteria) (string-match criteria identification)) + ((functionp criteria) (funcall criteria identification)) + (t "Wrong criteria `%s'" criteria)) + (cdr (assoc criteria connection-local-criteria-alist)))) + +;;;###autoload +(defun connection-local-set-classes (criteria &rest classes) + "Add CLASSES for remote servers. +CRITERIA is either a regular expression identifying a remote +server, or a function with one argument IDENTIFICATION, which +returns non-nil when a remote server shall apply CLASS'es +variables. If CRITERIA is nil, it always applies. +CLASSES are the names of a variable class (a symbol). + +When a connection to a remote server is opened and CRITERIA +matches to that server, the connection-local variables from CLASSES +are applied to the corresponding process buffer. The variables +for a class are defined using `connection-local-set-class-variables'." + (unless (or (null criteria) (stringp criteria) (functionp criteria)) + (error "Wrong criteria `%s'" criteria)) + (dolist (class classes) + (unless (assq class connection-local-class-alist) + (error "No such class `%s'" (symbol-name class)))) + (let ((slot (assoc criteria connection-local-criteria-alist))) + (if slot + (setcdr slot (delete-dups (append (cdr slot) classes))) + (setq connection-local-criteria-alist + (cons (cons criteria (delete-dups classes)) + connection-local-criteria-alist))))) + +(defsubst connection-local-get-class-variables (class) + "Return the connection-local variable list for CLASS." + (cdr (assq class connection-local-class-alist))) + +;;;###autoload +(defun connection-local-set-class-variables (class variables) + "Map the symbol CLASS to a list of variable settings. +VARIABLES is a list that declares connection-local variables for +the class. An element in VARIABLES is an alist whose elements +are of the form (VAR . VALUE). + +When a connection to a remote server is opened, the server's +classes are found. A server may be assigned a class using +`connection-local-set-class'. Then variables are set in the +server's process buffer according to the VARIABLES list of the +class. The list is processed in order." + (setf (alist-get class connection-local-class-alist) variables)) + +(defun hack-connection-local-variables () + "Read per-connection local variables for the current buffer. +Store the connection-local variables in `connection-local-variables-alist'. + +This does nothing if `enable-connection-local-variables' is nil." + (let ((identification (file-remote-p default-directory))) + (when (and enable-connection-local-variables identification) + ;; Loop over criteria. + (dolist (criteria (mapcar 'car connection-local-criteria-alist)) + ;; Filter classes which map identification. + (dolist (class (connection-local-get-classes criteria identification)) + ;; Loop over variables. + (dolist (variable (connection-local-get-class-variables class)) + (unless (assq (car variable) connection-local-variables-alist) + (push variable connection-local-variables-alist)))))))) + +;;;###autoload +(defun hack-connection-local-variables-apply () + "Apply connection-local variables identified by `default-directory'. +Other local variables, like file-local and dir-local variables, +will not be changed." + (hack-connection-local-variables) + (let ((file-local-variables-alist + (copy-tree connection-local-variables-alist))) + (hack-local-variables-apply))) + +;;;###autoload +(defmacro with-connection-local-classes (classes &rest body) + "Apply connection-local variables according to CLASSES in current buffer. +Execute BODY, and unwind connection local variables." + (declare (indent 1) (debug t)) + `(let ((enable-connection-local-variables t) + (old-buffer-local-variables (buffer-local-variables)) + connection-local-variables-alist connection-local-criteria-alist) + (apply 'connection-local-set-classes "" ,classes) + (hack-connection-local-variables-apply) + (unwind-protect + (progn ,@body) + ;; Cleanup. + (dolist (variable connection-local-variables-alist) + (let ((elt (assq (car variable) old-buffer-local-variables))) + (if elt + (set (make-local-variable (car elt)) (cdr elt)) + (kill-local-variable (car variable)))))))) + + (provide 'files-x) diff --git a/lisp/files.el b/lisp/files.el index bd9792a51a2..790f6cedfd6 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -51,20 +51,21 @@ when it has unsaved changes." nil "Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace -FROM with TO when it appears in a directory name. This replacement is -done when setting up the default directory of a newly visited file. +a match for FROM with TO when a directory name matches FROM. This +replacement is done when setting up the default directory of a +newly visited file buffer. -FROM is matched against directory names anchored at the first -character, so it should start with a \"\\\\\\=`\", or, if directory -names cannot have embedded newlines, with a \"^\". +FROM is a regexp that is matched against directory names anchored at +the first character, so it should start with a \"\\\\\\=`\", or, if +directory names cannot have embedded newlines, with a \"^\". FROM and TO should be equivalent names, which refer to the -same directory. Do not use `~' in the TO strings; -they should be ordinary absolute directory names. +same directory. TO should be an absolute directory name. +Do not use `~' in the TO strings. Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM -the name it is linked to." +a regexp matching the name it is linked to." :type '(repeat (cons :format "%v" :value ("\\`" . "") (regexp :tag "From") @@ -277,8 +278,7 @@ The value `never' means do not make them." :type '(choice (const :tag "Never" never) (const :tag "If existing" nil) (other :tag "Always" t)) - :group 'backup - :group 'vc) + :group 'backup) (put 'version-control 'safe-local-variable (lambda (x) (or (booleanp x) (equal x 'never)))) @@ -610,9 +610,7 @@ is a valid DOS file name, but c:/bar/c:/foo is not. This function's standard definition is trivial; it just returns the argument. However, on Windows and DOS, replace invalid characters. On DOS, make sure to obey the 8.3 limitations. -In the native Windows build, turn Cygwin names into native names, -and also turn slashes into backslashes if the shell requires it (see -`w32-shell-dos-semantics'). +In the native Windows build, turn Cygwin names into native names. See Info node `(elisp)Standard File Names' for more details." (cond @@ -1131,6 +1129,12 @@ consecutive checks. For example: :format "Do not use file name cache older then %v seconds" :value 10))) +(defun file-local-name (file) + "Return the local name component of FILE. +It returns a file name which can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + (or (file-remote-p file 'localname) file)) + (defun file-local-copy (file) "Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly @@ -1215,7 +1219,7 @@ containing it, until no links are left at any level. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) - (and (memq system-type '(windows-nt ms-dos cygwin nacl)) + (and (file-name-case-insensitive-p dir) (eq (compare-strings dir 0 nil dirfile 0 nil t) t)) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. @@ -1315,6 +1319,36 @@ Optional second argument FLAVOR controls the units and the display format: (car post-fixes)) (if (eq flavor 'iec) "iB" "")))) +(defcustom mounted-file-systems + (if (memq system-type '(windows-nt cygwin)) + "^//[^/]+/" + ;; regexp-opt.el is not dumped into emacs binary. + ;;(concat + ;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))) + "^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)") + "File systems which ought to be mounted." + :group 'files + :version "26.1" + :require 'regexp-opt + :type 'regexp) + +(defun temporary-file-directory () + "The directory for writing temporary files. +In case of a remote `default-directory', this is a directory for +temporary files on that remote host. If such a directory does +not exist, or `default-directory' ought to be located on a +mounted file system (see `mounted-file-systems'), the function +returns `default-directory'. +For a non-remote and non-mounted `default-directory', the value of +the variable `temporary-file-directory' is returned." + (let ((handler (find-file-name-handler + default-directory 'temporary-file-directory))) + (if handler + (funcall handler 'temporary-file-directory) + (if (string-match mounted-file-systems default-directory) + default-directory + temporary-file-directory)))) + (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end @@ -1351,6 +1385,21 @@ If SUFFIX is non-nil, add that at the end of the file name." nil) file))) +(defun make-nearby-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file as close as possible to `default-directory'. +If PREFIX is a relative file name, and `default-directory' is a +remote file name or located on a mounted file systems, the +temporary file is created in the directory returned by the +function `temporary-file-directory'. Otherwise, the function +`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the +same meaning as in `make-temp-file'." + (let ((handler (find-file-name-handler + default-directory 'make-nearby-temp-file))) + (if (and handler (not (file-name-absolute-p default-directory))) + (funcall handler 'make-nearby-temp-file prefix dir-flag suffix) + (let ((temporary-file-directory (temporary-file-directory))) + (make-temp-file prefix dir-flag suffix))))) + (defun recode-file-name (file coding new-coding &optional ok-if-already-exists) "Change the encoding of FILE's name from CODING to NEW-CODING. The value is a new name of FILE. @@ -1556,7 +1605,7 @@ file names with wildcards." (defun find-file--read-only (fun filename wildcards) (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (file-exists-p filename)) (error "%s does not exist" filename)) @@ -1736,7 +1785,8 @@ Choose the buffer's name using `generate-new-buffer-name'." (make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3") (defvar abbreviated-home-dir nil - "The user's homedir abbreviated according to `directory-abbrev-alist'.") + "Regexp matching the user's homedir at the beginning of file name. +The value includes abbreviation according to `directory-abbrev-alist'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. @@ -1751,10 +1801,7 @@ home directory is a root directory) and removes automounter prefixes (substring filename (1- (match-end 0)))))) (setq filename (substring filename (1- (match-end 0))))) ;; Avoid treating /home/foo as /home/Foo during `~' substitution. - ;; To fix this right, we need a `file-name-case-sensitive-p' - ;; function, but we don't have that yet, so just guess. - (let ((case-fold-search - (memq system-type '(ms-dos windows-nt darwin cygwin)))) + (let ((case-fold-search (file-name-case-insensitive-p filename))) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (dolist (dir-abbrev directory-abbrev-alist) @@ -1770,8 +1817,23 @@ home directory is a root directory) and removes automounter prefixes (or abbreviated-home-dir (setq abbreviated-home-dir (let ((abbreviated-home-dir "$foo")) - (concat "\\`" (abbreviate-file-name (expand-file-name "~")) - "\\(/\\|\\'\\)")))) + (setq abbreviated-home-dir + (concat "\\`" + (abbreviate-file-name (expand-file-name "~")) + "\\(/\\|\\'\\)")) + ;; Depending on whether default-directory does or + ;; doesn't include non-ASCII characters, the value + ;; of abbreviated-home-dir could be multibyte or + ;; unibyte. In the latter case, we need to decode + ;; it. Note that this function is called for the + ;; first time (from startup.el) when + ;; locale-coding-system is already set up. + (if (multibyte-string-p abbreviated-home-dir) + abbreviated-home-dir + (decode-coding-string abbreviated-home-dir + (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system)))))) ;; If FILENAME starts with the abbreviated homedir, ;; make it start with `~' instead. @@ -1923,7 +1985,7 @@ the various files." (error "%s is a directory" filename)) (if (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (let ((files (condition-case nil (file-expand-wildcards filename t) @@ -2143,6 +2205,7 @@ Do you want to revisit the file normally now? ") (defun insert-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents', but only reads in the file literally. +See `insert-file-contents' for an explanation of the parameters. A buffer may be modified in several ways after reading into the buffer, due to Emacs features such as format decoding, character code conversion, `find-file-hook', automatic uncompression, etc. @@ -2315,14 +2378,21 @@ not set local variables (though we do notice a mode specified with -*-.) or from Lisp without specifying the optional argument FIND-FILE; in that case, this function acts as if `enable-local-variables' were t." (interactive) - (fundamental-mode) + (kill-all-local-variables) + (unless delay-mode-hooks + (run-hooks 'change-major-mode-after-body-hook + 'after-change-major-mode-hook)) (let ((enable-local-variables (or (not find-file) enable-local-variables))) ;; FIXME this is less efficient than it could be, since both ;; s-a-m and h-l-v may parse the same regions, looking for "mode:". (with-demoted-errors "File mode specification error: %s" (set-auto-mode)) - (with-demoted-errors "File local-variables error: %s" - (hack-local-variables))) + ;; `delay-mode-hooks' being non-nil will have prevented the major + ;; mode's call to `run-mode-hooks' from calling + ;; `hack-local-variables'. In that case, call it now. + (when delay-mode-hooks + (with-demoted-errors "File local-variables error: %s" + (hack-local-variables 'no-mode)))) ;; Turn font lock off and on, to make sure it takes account of ;; whatever file local variables are relevant to it. (when (and font-lock-mode @@ -2455,8 +2525,8 @@ since only a single case-insensitive search through the alist is made." ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. ("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode) ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in @@ -2848,7 +2918,9 @@ we don't actually set it to the same mode the buffer already has." (unless done (if buffer-file-name (let ((name buffer-file-name) - (remote-id (file-remote-p buffer-file-name))) + (remote-id (file-remote-p buffer-file-name)) + (case-insensitive-p (file-name-case-insensitive-p + buffer-file-name))) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) ;; Remove remote file name identification. @@ -2858,12 +2930,12 @@ we don't actually set it to the same mode the buffer already has." (while name ;; Find first matching alist entry. (setq mode - (if (memq system-type '(windows-nt cygwin)) - ;; System is case-insensitive. + (if case-insensitive-p + ;; Filesystem is case-insensitive. (let ((case-fold-search t)) (assoc-default name auto-mode-alist 'string-match)) - ;; System is case-sensitive. + ;; Filesystem is case-sensitive. (or ;; First match case-sensitively. (let ((case-fold-search nil)) @@ -3171,16 +3243,21 @@ n -- to ignore the local variables list.") (defconst hack-local-variable-regexp "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*") -(defun hack-local-variables-prop-line (&optional mode-only) +(defun hack-local-variables-prop-line (&optional handle-mode) "Return local variables specified in the -*- line. -Returns an alist of elements (VAR . VAL), where VAR is a variable -and VAL is the specified value. Ignores any specification for -`mode:' and `coding:' (which should have already been handled -by `set-auto-mode' and `set-auto-coding', respectively). -Return nil if the -*- line is malformed. - -If MODE-ONLY is non-nil, just returns the symbol specifying the -mode, if there is one, otherwise nil." +Usually returns an alist of elements (VAR . VAL), where VAR is a +variable and VAL is the specified value. Ignores any +specification for `coding:', and sometimes for `mode' (which +should have already been handled by `set-auto-coding' and +`set-auto-mode', respectively). Return nil if the -*- line is +malformed. + +If HANDLE-MODE is nil, we return the alist of all the local +variables in the line except `coding' as described above. If it +is neither nil nor t, we do the same, except that any settings of +`mode' and `coding' are ignored. If HANDLE-MODE is t, we ignore +all settings in the line except for `mode', which \(if present) we +return as the symbol specifying the mode." (catch 'malformed-line (save-excursion (goto-char (point-min)) @@ -3190,14 +3267,14 @@ mode, if there is one, otherwise nil." nil) ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") ;; Simple form: "-*- MODENAME -*-". - (if mode-only + (if (eq handle-mode t) (intern (concat (match-string 1) "-mode")))) (t ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' ;; (last ";" is optional). - ;; If MODE-ONLY, just check for `mode'. + ;; If HANDLE-MODE is t, just check for `mode'. ;; Otherwise, parse the -*- line into the RESULT alist. - (while (not (or (and mode-only result) + (while (not (or (and (eq handle-mode t) result) (>= (point) end))) (unless (looking-at hack-local-variable-regexp) (message "Malformed mode-line: %S" @@ -3218,19 +3295,24 @@ mode, if there is one, otherwise nil." ;; That is inconsistent, but we're stuck with it. ;; The same can be said for `coding' in set-auto-coding. (keyname (downcase (symbol-name key)))) - (if mode-only - (and (equal keyname "mode") - (setq result - (intern (concat (downcase (symbol-name val)) - "-mode")))) - (or (equal keyname "coding") - (condition-case nil - (push (cons (cond ((eq key 'eval) 'eval) - ;; Downcase "Mode:". - ((equal keyname "mode") 'mode) - (t (indirect-variable key))) - val) result) - (error nil)))) + (cond + ((eq handle-mode t) + (and (equal keyname "mode") + (setq result + (intern (concat (downcase (symbol-name val)) + "-mode"))))) + ((equal keyname "coding")) + (t + (when (or (not handle-mode) + (not (equal keyname "mode"))) + (condition-case nil + (push (cons (cond ((eq key 'eval) 'eval) + ;; Downcase "Mode:". + ((equal keyname "mode") 'mode) + (t (indirect-variable key))) + val) + result) + (error nil))))) (skip-chars-forward " \t;"))) result)))))) @@ -3296,11 +3378,15 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; TODO? Warn once per file rather than once per session? (defvar hack-local-variables--warned-lexical nil) -(defun hack-local-variables (&optional mode-only) +(defun hack-local-variables (&optional handle-mode) "Parse and put into effect this buffer's local variables spec. Uses `hack-local-variables-apply' to apply the variables. -If MODE-ONLY is non-nil, all we do is check whether a \"mode:\" +If HANDLE-MODE is nil, we apply all the specified local +variables. If HANDLE-MODE is neither nil nor t, we do the same, +except that any settings of `mode' are ignored. + +If HANDLE-MODE is t, all we do is check whether a \"mode:\" is specified, and return the corresponding mode symbol, or nil. In this case, we try to ignore minor-modes, and only return a major-mode. @@ -3318,7 +3404,7 @@ local variables, but directory-local variables may still be applied." (let ((enable-local-variables (and local-enable-local-variables enable-local-variables)) result) - (unless mode-only + (unless (eq handle-mode t) (setq file-local-variables-alist nil) (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. @@ -3326,18 +3412,19 @@ local variables, but directory-local variables may still be applied." ;; This entire function is basically a no-op if enable-local-variables ;; is nil. All it does is set file-local-variables-alist to nil. (when enable-local-variables - ;; This part used to ignore enable-local-variables when mode-only - ;; was non-nil. That was inappropriate, eg consider the + ;; This part used to ignore enable-local-variables when handle-mode + ;; was t. That was inappropriate, eg consider the ;; (artificial) example of: ;; (setq local-enable-local-variables nil) ;; Open a file foo.txt that contains "mode: sh". ;; It correctly opens in text-mode. ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode. (unless (or (inhibit-local-variables-p) - ;; If MODE-ONLY is non-nil, and the prop line specifies a + ;; If HANDLE-MODE is t, and the prop line specifies a ;; mode, then we're done, and have no need to scan further. - (and (setq result (hack-local-variables-prop-line mode-only)) - mode-only)) + (and (setq result (hack-local-variables-prop-line + handle-mode)) + (eq handle-mode t))) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) @@ -3392,7 +3479,7 @@ local variables, but directory-local variables may still be applied." (goto-char (point-min)) (while (not (or (eobp) - (and mode-only result))) + (and (eq handle-mode t) result))) ;; Find the variable name; (unless (looking-at hack-local-variable-regexp) (error "Malformed local variable line: %S" @@ -3409,7 +3496,7 @@ local variables, but directory-local variables may still be applied." (forward-char 1) (let ((read-circle nil)) (setq val (read (current-buffer)))) - (if mode-only + (if (eq handle-mode t) (and (eq var 'mode) ;; Specifying minor-modes via mode: is ;; deprecated, but try to reject them anyway. @@ -3431,6 +3518,7 @@ local variables, but directory-local variables may still be applied." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((and (eq var 'mode) handle-mode)) (t (ignore-errors (push (cons (if (eq var 'eval) @@ -3439,8 +3527,8 @@ local variables, but directory-local variables may still be applied." val) result)))))) (forward-line 1)))))))) ;; Now we've read all the local variables. - ;; If MODE-ONLY is non-nil, return whether the mode was specified. - (if mode-only result + ;; If HANDLE-MODE is t, return whether the mode was specified. + (if (eq handle-mode t) result ;; Otherwise, set the variables. (hack-local-variables-filter result nil) (hack-local-variables-apply))))) @@ -3803,8 +3891,10 @@ This function returns either: ;; The entry MTIME should match the most recent ;; MTIME among matching files. (and cached-files - (= (time-to-seconds (nth 2 dir-elt)) - (apply #'max (mapcar (lambda (f) (time-to-seconds (nth 5 (file-attributes f)))) + (= (float-time (nth 2 dir-elt)) + (apply #'max (mapcar (lambda (f) + (float-time + (nth 5 (file-attributes f)))) cached-files)))))) ;; This cache entry is OK. dir-elt @@ -3846,7 +3936,7 @@ Return the new class name, which is a symbol named DIR." (seconds-to-time (if success (apply #'max (mapcar (lambda (file) - (time-to-seconds (nth 5 (file-attributes file)))) + (float-time (nth 5 (file-attributes file)))) files)) ;; If there was a problem, use the values we could get but ;; don't let the cache prevent future reads. @@ -4265,8 +4355,7 @@ See also `file-name-version-regexp'." (defun file-ownership-preserved-p (file &optional group) "Return t if deleting FILE and rewriting it would preserve the owner. -Return nil if FILE does not exist, or if deleting and recreating it -might not preserve the owner. If GROUP is non-nil, check whether +Return also t if FILE does not exist. If GROUP is non-nil, check whether the group would be preserved too." (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) (if handler @@ -4304,8 +4393,8 @@ the group would be preserved too." (defun file-name-sans-extension (filename) "Return FILENAME sans final \"extension\". -The extension, in a file name, is the part that follows the last `.', -except that a leading `.', if any, doesn't count." +The extension, in a file name, is the part that begins with the last `.', +except that a leading `.' of the file name, if there is one, doesn't count." (save-match-data (let ((file (file-name-sans-versions (file-name-nondirectory filename))) directory) @@ -4320,15 +4409,16 @@ except that a leading `.', if any, doesn't count." (defun file-name-extension (filename &optional period) "Return FILENAME's final \"extension\". -The extension, in a file name, is the part that follows the last `.', -excluding version numbers and backup suffixes, -except that a leading `.', if any, doesn't count. +The extension, in a file name, is the part that begins with the last `.', +excluding version numbers and backup suffixes, except that a leading `.' +of the file name, if there is one, doesn't count. Return nil for extensionless file names such as `foo'. Return the empty string for file names such as `foo.'. -If PERIOD is non-nil, then the returned value includes the period -that delimits the extension, and if FILENAME has no extension, -the value is \"\"." +By default, the returned value excludes the period that starts the +extension, but if the optional argument PERIOD is non-nil, the period +is included in the value, and in that case, if FILENAME has no +extension, the value is \"\"." (save-match-data (let ((file (file-name-sans-versions (file-name-nondirectory filename)))) (if (and (string-match "\\.[^.]*\\'" file) @@ -4388,7 +4478,7 @@ ignored." (defun normal-backup-enable-predicate (name) "Default `backup-enable-predicate' function. Checks for files in `temporary-file-directory', -`small-temporary-file-directory', and /tmp." +`small-temporary-file-directory', and \"/tmp\"." (let ((temporary-file-directory temporary-file-directory) caseless) ;; On MS-Windows, file-truename will convert short 8+3 aliases to @@ -4623,7 +4713,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (setq filename (expand-file-name filename)) (let ((fremote (file-remote-p filename)) (dremote (file-remote-p directory)) - (fold-case (or (memq system-type '(ms-dos cygwin windows-nt)) + (fold-case (or (file-name-case-insensitive-p filename) read-file-name-completion-ignore-case))) (if ;; Conditions for separate trees (or @@ -4683,14 +4773,20 @@ By default, makes the previous version into a backup file Prefixed with one \\[universal-argument], marks this version to become a backup when the next save is done. Prefixed with two \\[universal-argument]'s, - unconditionally makes the previous version into a backup file. + makes the previous version into a backup file. Prefixed with three \\[universal-argument]'s, marks this version to become a backup when the next save is done, - and unconditionally makes the previous version into a backup file. + and makes the previous version into a backup file. With a numeric prefix argument of 0, never make the previous version into a backup file. +Note that the various variables that control backups, such +as `version-control', `backup-enable-predicate', `vc-make-backup-files', +and `backup-inhibited', to name just the more popular ones, still +control whether a backup will actually be produced, even when you +invoke this command prefixed with two or three \\[universal-argument]'s. + If a file's name is FOO, the names of its numbered backup versions are FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. Numeric backups (rather than FOO~) will be made if value of @@ -5122,7 +5218,7 @@ change the additional actions you can take on files." (defun clear-visited-file-modtime () "Clear out records of last mod time of visited file. -Next attempt to save will certainly not complain of a discrepancy." +Next attempt to save will not complain of a discrepancy." (set-visited-file-modtime 0)) (defun not-modified (&optional arg) @@ -5262,14 +5358,24 @@ raised." "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" "Regexp matching any file name except \".\" and \"..\".") +(defun files--force (no-such fn &rest args) + "Use NO-SUCH to affect behavior of function FN applied to list ARGS. +This acts like (apply FN ARGS) except it returns NO-SUCH if it is +non-nil and if FN fails due to a missing file or directory." + (condition-case err + (apply fn args) + (file-missing (or no-such (signal (car err) (cdr err)))))) + (defun delete-directory (directory &optional recursive trash) "Delete the directory named DIRECTORY. Does not follow symlinks. -If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well. +If RECURSIVE is non-nil, delete files in DIRECTORY as well, with +no error if something else is simultaneously deleting them. TRASH non-nil means to trash the directory instead, provided `delete-by-moving-to-trash' is non-nil. -When called interactively, TRASH is t if no prefix argument is -given. With a prefix argument, TRASH is nil." +When called interactively, TRASH is nil if and only if a prefix +argument is given, and a further prompt asks the user for +RECURSIVE if DIRECTORY is nonempty." (interactive (let* ((trashing (and delete-by-moving-to-trash (null current-prefix-arg))) @@ -5307,18 +5413,22 @@ given. With a prefix argument, TRASH is nil." (move-file-to-trash directory))) ;; Otherwise, call ourselves recursively if needed. (t - (if (and recursive (not (file-symlink-p directory))) - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file recursive nil) - (delete-file file nil))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full directory-files-no-dot-files-regexp))) - (delete-directory-internal directory))))) + (when (or (not recursive) (file-symlink-p directory) + (let* ((files + (files--force t #'directory-files directory 'full + directory-files-no-dot-files-regexp)) + (directory-exists (listp files))) + (when directory-exists + (mapc (lambda (file) + ;; This test is equivalent to but more efficient + ;; than (and (file-directory-p fn) + ;; (not (file-symlink-p fn))). + (if (eq t (car (file-attributes file))) + (delete-directory file recursive) + (files--force t #'delete-file file))) + files)) + directory-exists)) + (files--force recursive #'delete-directory-internal directory)))))) (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. @@ -6125,9 +6235,7 @@ default directory. However, if FULL is non-nil, they are absolute." ;; This can be more than one dir ;; if DIRPART contains wildcards. (dirs (if (and dirpart - (string-match "[[*?]" - (or (file-remote-p dirpart 'localname) - dirpart))) + (string-match "[[*?]" (file-local-name dirpart))) (mapcar 'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) @@ -6193,7 +6301,7 @@ and `list-directory-verbose-switches'." PATTERN is assumed to represent a file-name wildcard suitable for the underlying filesystem. For Unix and GNU/Linux, each character from the -set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all +set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all the parts of the pattern which don't include wildcard characters are quoted with double quotes. @@ -6568,7 +6676,7 @@ normally equivalent short `-D' option is just passed on to (setq error-lines (nreverse error-lines)) ;; Now read the numeric positions of file names. (goto-char linebeg) - (forward-word 1) + (forward-word-strictly 1) (forward-char 3) (while (< (point) end) (let ((start (insert-directory-adj-pos @@ -6663,11 +6771,14 @@ message to that effect instead of signaling an error." ;; Simulate the message printed by `ls'. (insert (format "%s: No such file or directory\n" file)))) -(defvar kill-emacs-query-functions nil +(defcustom kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is canceled. `save-buffers-kill-emacs' calls these functions, but `kill-emacs', -the low level primitive, does not. See also `kill-emacs-hook'.") +the low level primitive, does not. See also `kill-emacs-hook'." + :type 'hook + :version "26.1" + :group 'convenience) (defcustom confirm-kill-emacs nil "How to ask for confirmation when leaving Emacs. @@ -6680,11 +6791,22 @@ be a predicate function; for example `yes-or-no-p'." :group 'convenience :version "21.1") +(defcustom confirm-kill-processes t + "Non-nil if Emacs should confirm killing processes on exit. +If this variable is nil, the value of +`process-query-on-exit-flag' is ignored. Otherwise, if there are +processes with a non-nil `process-query-on-exit-flag', Emacs will +prompt the user before killing them." + :type 'boolean + :group 'convenience + :version "26.1") + (defun save-buffers-kill-emacs (&optional arg) "Offer to save each buffer, then kill this Emacs process. With prefix ARG, silently save all file-visiting buffers without asking. If there are active processes where `process-query-on-exit-flag' -returns non-nil, asks whether processes should be killed. +returns non-nil and `confirm-kill-processes' is non-nil, +asks whether processes should be killed. Runs the members of `kill-emacs-query-functions' in turn and stops if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (interactive "P") @@ -6699,6 +6821,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (yes-or-no-p "Modified buffers exist; exit anyway? "))) (or (not (fboundp 'process-list)) ;; process-list is not defined on MSDOS. + (not confirm-kill-processes) (let ((processes (process-list)) active) (while processes @@ -6726,7 +6849,8 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (defun save-buffers-kill-terminal (&optional arg) "Offer to save each buffer, then kill the current connection. -If the current frame has no client, kill Emacs itself. +If the current frame has no client, kill Emacs itself using +`save-buffers-kill-emacs'. With prefix ARG, silently save all file-visiting buffers, then kill. @@ -6820,6 +6944,28 @@ only these files will be asked to be saved." (apply operation arguments))) (_ (apply operation arguments))))) + +(defsubst file-name-quoted-p (name) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name, check the local part of NAME." + (string-prefix-p "/:" (file-local-name name))) + +(defsubst file-name-quote (name) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name, the local part of NAME is quoted. +If NAME is already a quoted file name, NAME is returned unchanged." + (if (file-name-quoted-p name) + name + (concat (file-remote-p name) "/:" (file-local-name name)))) + +(defsubst file-name-unquote (name) + "Remove quotation prefix \"/:\" from file NAME, if any. +If NAME is a remote file name, the local part of NAME is unquoted." + (let ((localname (file-local-name name))) + (when (file-name-quoted-p localname) + (setq + localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))) ;; Symbolic modes and read-file-modes. @@ -7084,61 +7230,61 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (rename-file fn new-fn))))))))) (defsubst file-attribute-type (attributes) - "The type field in ATTRIBUTES returned by `file-attribute'. + "The type field in ATTRIBUTES returned by `file-attributes'. The value is either t for directory, string (name linked to) for symbolic link, or nil." (nth 0 attributes)) (defsubst file-attribute-link-number (attributes) - "Return the number of links in ATTRIBUTES returned by `file-attribute'." + "Return the number of links in ATTRIBUTES returned by `file-attributes'." (nth 1 attributes)) (defsubst file-attribute-user-id (attributes) - "The UID field in ATTRIBUTES returned by `file-attribute'. + "The UID field in ATTRIBUTES returned by `file-attributes'. This is either a string or a number. If a string value cannot be looked up, a numeric value, either an integer or a float, is returned." (nth 2 attributes)) (defsubst file-attribute-group-id (attributes) - "The GID field in ATTRIBUTES returned by `file-attribute'. + "The GID field in ATTRIBUTES returned by `file-attributes'. This is either a string or a number. If a string value cannot be looked up, a numeric value, either an integer or a float, is returned." (nth 3 attributes)) (defsubst file-attribute-access-time (attributes) - "The last access time in ATTRIBUTES returned by `file-attribute'. + "The last access time in ATTRIBUTES returned by `file-attributes'. This a list of integers (HIGH LOW USEC PSEC) in the same style as (current-time)." (nth 4 attributes)) (defsubst file-attribute-modification-time (attributes) - "The modification time in ATTRIBUTES returned by `file-attribute'. + "The modification time in ATTRIBUTES returned by `file-attributes'. This is the time of the last change to the file's contents, and is a list of integers (HIGH LOW USEC PSEC) in the same style as (current-time)." (nth 5 attributes)) (defsubst file-attribute-status-change-time (attributes) - "The status modification time in ATTRIBUTES returned by `file-attribute'. + "The status modification time in ATTRIBUTES returned by `file-attributes'. This is the time of last change to the file's attributes: owner and group, access mode bits, etc, and is a list of integers (HIGH LOW USEC PSEC) in the same style as (current-time)." (nth 6 attributes)) (defsubst file-attribute-size (attributes) - "The size (in bytes) in ATTRIBUTES returned by `file-attribute'. + "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. This is a floating point number if the size is too large for an integer." (nth 7 attributes)) (defsubst file-attribute-modes (attributes) - "The file modes in ATTRIBUTES returned by `file-attribute'. + "The file modes in ATTRIBUTES returned by `file-attributes'. This is a string of ten letters or dashes as in ls -l." (nth 8 attributes)) (defsubst file-attribute-inode-number (attributes) - "The inode number in ATTRIBUTES returned by `file-attribute'. + "The inode number in ATTRIBUTES returned by `file-attributes'. If it is larger than what an Emacs integer can hold, this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. If even HIGH is too large for an Emacs integer, this is instead @@ -7147,7 +7293,7 @@ middle 24 bits, and finally the low 16 bits." (nth 10 attributes)) (defsubst file-attribute-device-number (attributes) - "The file system device number in ATTRIBUTES returned by `file-attribute'. + "The file system device number in ATTRIBUTES returned by `file-attributes'. If it is larger than what an Emacs integer can hold, this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. If even HIGH is too large for an Emacs integer, this is instead @@ -7155,6 +7301,26 @@ of the form (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits, and finally the low 16 bits." (nth 11 attributes)) +(defun file-attribute-collect (attributes &rest attr-names) + "Return a sublist of ATTRIBUTES returned by `file-attributes'. +ATTR-NAMES are symbols with the selected attribute names. + +Valid attribute names are: type, link-number, user-id, group-id, +access-time, modification-time, status-change-time, size, modes, +inode-number and device-number." + (let ((all '(type link-number user-id group-id access-time + modification-time status-change-time + size modes inode-number device-number)) + result) + (while attr-names + (let ((attr (pop attr-names))) + (if (memq attr all) + (push (funcall + (intern (format "file-attribute-%s" (symbol-name attr))) + attributes) + result) + (error "Wrong attribute name '%S'" attr)))) + (nreverse result))) (define-key ctl-x-map "\C-f" 'find-file) (define-key ctl-x-map "\C-r" 'find-file-read-only) diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 475001f5707..8591eb841c1 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -118,7 +118,7 @@ Argument DIR is the directory containing FILE." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun find-lisp-find-files (directory regexp) - "Find files in DIRECTORY which match REGEXP." + "Find files under DIRECTORY, recursively, that match REGEXP." (let ((file-predicate 'find-lisp-default-file-predicate) (directory-predicate 'find-lisp-default-directory-predicate) (find-lisp-regexp regexp)) @@ -297,6 +297,9 @@ It is a function which takes two arguments, the directory and its parent." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun find-lisp-format (file-name file-attr switches now) + "Format one line of long ls output for file FILE-NAME. +FILE-ATTR and FILE-SIZE give the file's attributes and size. +SWITCHES and TIME-INDEX give the full switch list and time data." (let ((file-type (nth 0 file-attr))) (concat (if (memq ?i switches) ; inode number (format "%6d " (nth 10 file-attr))) @@ -325,7 +328,7 @@ It is a function which takes two arguments, the directory and its parent." "\n"))) (defun find-lisp-time-index (switches) - ;; Return index into file-attributes according to ls SWITCHES. + "Return index into file-attributes according to ls SWITCHES." (cond ((memq ?c switches) 6) ; last mode change ((memq ?u switches) 4) ; last access @@ -333,10 +336,11 @@ It is a function which takes two arguments, the directory and its parent." (t 5))) (defun find-lisp-format-time (file-attr switches now) - ;; Format time string for file with attributes FILE-ATTR according - ;; to SWITCHES (a list of ls option letters of which c and u are recognized). - ;; Use the same method as `ls' to decide whether to show time-of-day or year, - ;; depending on distance between file date and NOW. + "Format time string for file. +This is done with attributes FILE-ATTR according to SWITCHES (a +list of ls option letters of which c and u are recognized). Use +the same method as \"ls\" to decide whether to show time-of-day or +year, depending on distance between file date and NOW." (let* ((time (nth (find-lisp-time-index switches) file-attr)) (diff16 (- (car time) (car now))) (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now))))) diff --git a/lisp/follow.el b/lisp/follow.el index 5801f79341e..c510e5a848b 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -399,11 +399,11 @@ virtual window. This is accomplished by two main techniques: makes it possible to walk between windows using normal cursor movement commands. -Follow mode comes to its prime when used on a large screen and two -side-by-side windows are used. The user can, with the help of Follow -mode, use two full-height windows as though they would have been -one. Imagine yourself editing a large function, or section of text, -and being able to use 144 lines instead of the normal 72... (your +Follow mode comes to its prime when used on a large screen and two or +more side-by-side windows are used. The user can, with the help of +Follow mode, use these full-height windows as though they were one. +Imagine yourself editing a large function, or section of text, and +being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands @@ -532,6 +532,80 @@ Return the new position." ;; position... (This would also be corrected if we would have had a ;; good redisplay abstraction.) +(defun follow-scroll-up-arg (arg) + "Scroll the text in a follow mode window chain up by ARG lines. +If ARG is nil, scroll the size of the current window. + +This is an internal function for `follow-scroll-up' and +`follow-scroll-up-window'." + (let ((opoint (point)) (owin (selected-window))) + (while + ;; If we are too near EOB, try scrolling the previous window. + (condition-case nil (progn (scroll-up arg) nil) + (end-of-buffer + (condition-case nil (progn (follow-previous-window) t) + (error + (select-window owin) + (goto-char opoint) + (signal 'end-of-buffer nil)))))) + (unless (and scroll-preserve-screen-position + (get this-command 'scroll-command)) + (goto-char opoint)) + (setq follow-fixed-window t))) + +(defun follow-scroll-down-arg (arg) + "Scroll the text in a follow mode window chain down by ARG lines. +If ARG is nil, scroll the size of the current window. + +This is an internal function for `follow-scroll-down' and +`follow-scroll-down-window'." + (let ((opoint (point))) + (scroll-down arg) + (unless (and scroll-preserve-screen-position + (get this-command 'scroll-command)) + (goto-char opoint)) + (setq follow-fixed-window t))) + +;;;###autoload +(defun follow-scroll-up-window (&optional arg) + "Scroll text in a Follow mode window up by that window's size. +The other windows in the window chain will scroll synchronously. + +If called with no ARG, the `next-screen-context-lines' last lines of +the window will be visible after the scroll. + +If called with an argument, scroll ARG lines up. +Negative ARG means scroll downward. + +Works like `scroll-up' when not in Follow mode." + (interactive "P") + (cond ((not follow-mode) + (scroll-up arg)) + ((eq arg '-) + (follow-scroll-down-window)) + (t (follow-scroll-up-arg arg)))) +(put 'follow-scroll-up-window 'scroll-command t) + +;;;###autoload +(defun follow-scroll-down-window (&optional arg) + "Scroll text in a Follow mode window down by that window's size. +The other windows in the window chain will scroll synchronously. + +If called with no ARG, the `next-screen-context-lines' top lines of +the window in the chain will be visible after the scroll. + +If called with an argument, scroll ARG lines down. +Negative ARG means scroll upward. + +Works like `scroll-down' when not in Follow mode." + (interactive "P") + (cond ((not follow-mode) + (scroll-down arg)) + ((eq arg '-) + (follow-scroll-up-window)) + (t (follow-scroll-down-arg arg)))) +(put 'follow-scroll-down-window 'scroll-command t) + ;;;###autoload (defun follow-scroll-up (&optional arg) "Scroll text in a Follow mode window chain up. @@ -546,23 +620,18 @@ Works like `scroll-up' when not in Follow mode." (interactive "P") (cond ((not follow-mode) (scroll-up arg)) - ((eq arg '-) - (follow-scroll-down)) - (t - (let ((opoint (point)) (owin (selected-window))) - (while - ;; If we are too near EOB, try scrolling the previous window. - (condition-case nil (progn (scroll-up arg) nil) - (end-of-buffer - (condition-case nil (progn (follow-previous-window) t) - (error - (select-window owin) - (goto-char opoint) - (signal 'end-of-buffer nil)))))) - (unless (and scroll-preserve-screen-position - (get this-command 'scroll-command)) - (goto-char opoint)) - (setq follow-fixed-window t))))) + (arg (follow-scroll-up-arg arg)) + (t + (let* ((windows (follow-all-followers)) + (end (window-end (car (reverse windows))))) + (if (eq end (point-max)) + (signal 'end-of-buffer nil) + (select-window (car windows)) + ;; `window-end' might return nil. + (if end + (goto-char end)) + (vertical-motion (- next-screen-context-lines)) + (set-window-start (car windows) (point))))))) (put 'follow-scroll-up 'scroll-command t) ;;;###autoload @@ -579,15 +648,22 @@ Works like `scroll-down' when not in Follow mode." (interactive "P") (cond ((not follow-mode) (scroll-down arg)) - ((eq arg '-) - (follow-scroll-up)) - (t - (let ((opoint (point))) - (scroll-down arg) - (unless (and scroll-preserve-screen-position - (get this-command 'scroll-command)) - (goto-char opoint)) - (setq follow-fixed-window t))))) + (arg (follow-scroll-down-arg arg)) + (t + (let* ((windows (follow-all-followers)) + (win (car (reverse windows))) + (start (window-start (car windows)))) + (if (eq start (point-min)) + (signal 'beginning-of-buffer nil) + (select-window win) + (goto-char start) + (vertical-motion (- (- (window-height win) + (if header-line-format 2 1) + next-screen-context-lines))) + (set-window-start win (point)) + (goto-char start) + (vertical-motion (- next-screen-context-lines 1)) + (setq follow-internal-force-redisplay t)))))) (put 'follow-scroll-down 'scroll-command t) (declare-function comint-adjust-point "comint" (window)) diff --git a/lisp/font-core.el b/lisp/font-core.el index a0971a17f5f..b3da8970500 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -86,46 +86,50 @@ When Font Lock mode is enabled, text is fontified as you type it: - Comments are displayed in `font-lock-comment-face'; - Strings are displayed in `font-lock-string-face'; - - Certain other expressions are displayed in other faces according to the - value of the variable `font-lock-keywords'. + - Certain other expressions are displayed in other faces + according to the value of the variable `font-lock-keywords'. To customize the faces (colors, fonts, etc.) used by Font Lock for fontifying different parts of buffer text, use \\[customize-face]. -You can enable Font Lock mode in any major mode automatically by turning on in -the major mode's hook. For example, put in your ~/.emacs: +You can enable Font Lock mode in any major mode automatically by +turning on in the major mode's hook. For example, put in your +~/.emacs: (add-hook \\='c-mode-hook \\='turn-on-font-lock) -Alternatively, you can use Global Font Lock mode to automagically turn on Font -Lock mode in buffers whose major mode supports it and whose major mode is one -of `font-lock-global-modes'. For example, put in your ~/.emacs: +Alternatively, you can use Global Font Lock mode to automagically +turn on Font Lock mode in buffers whose major mode supports it +and whose major mode is one of `font-lock-global-modes'. For +example, put in your ~/.emacs: (global-font-lock-mode t) -Where major modes support different levels of fontification, you can use -the variable `font-lock-maximum-decoration' to specify which level you -generally prefer. When you turn Font Lock mode on/off the buffer is -fontified/defontified, though fontification occurs only if the buffer is -less than `font-lock-maximum-size'. +Where major modes support different levels of fontification, you +can use the variable `font-lock-maximum-decoration' to specify +which level you generally prefer. When you turn Font Lock mode +on/off the buffer is fontified/defontified, though fontification +occurs only if the buffer is less than `font-lock-maximum-size'. -To add your own highlighting for some major mode, and modify the highlighting -selected automatically via the variable `font-lock-maximum-decoration', you can -use `font-lock-add-keywords'. +To add your own highlighting for some major mode, and modify the +highlighting selected automatically via the variable +`font-lock-maximum-decoration', you can use +`font-lock-add-keywords'. -To fontify a buffer, without turning on Font Lock mode and regardless of buffer -size, you can use \\[font-lock-fontify-buffer]. +To fontify a buffer, without turning on Font Lock mode and +regardless of buffer size, you can use \\[font-lock-fontify-buffer]. -To fontify a block (the function or paragraph containing point, or a number of -lines around point), perhaps because modification on the current line caused -syntactic change on other lines, you can use \\[font-lock-fontify-block]. +To fontify a block (the function or paragraph containing point, +or a number of lines around point), perhaps because modification +on the current line caused syntactic change on other lines, you +can use \\[font-lock-fontify-block]. You can set your own default settings for some mode, by setting a buffer local value for `font-lock-defaults', via its mode hook. -The above is the default behavior of `font-lock-mode'; you may specify -your own function which is called when `font-lock-mode' is toggled via -`font-lock-function'. " +The above is the default behavior of `font-lock-mode'; you may +specify your own function which is called when `font-lock-mode' +is toggled via `font-lock-function'. " nil nil nil :after-hook (font-lock-initial-fontify) ;; Don't turn on Font Lock mode if we don't have a display (we're running a diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 471db6b148f..b5ff5cfd0af 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -364,105 +364,125 @@ Each element in a user-level keywords list should have one of these forms: (MATCHER HIGHLIGHT ...) (eval . FORM) -where MATCHER can be either the regexp to search for, or the function name to -call to make the search (called with one argument, the limit of the search; -it should return non-nil, move point, and set `match-data' appropriately if -it succeeds; like `re-search-forward' would). -MATCHER regexps can be generated via the function `regexp-opt'. - -FORM is an expression, whose value should be a keyword element, evaluated when -the keyword is (first) used in a buffer. This feature can be used to provide a -keyword that can only be generated when Font Lock mode is actually turned on. +where MATCHER can be either the regexp to search for, or the +function name to call to make the search (called with one +argument, the limit of the search; it should return non-nil, move +point, and set `match-data' appropriately if it succeeds; like +`re-search-forward' would). MATCHER regexps can be generated via +the function `regexp-opt'. + +FORM is an expression, whose value should be a keyword element, +evaluated when the keyword is (first) used in a buffer. This +feature can be used to provide a keyword that can only be +generated when Font Lock mode is actually turned on. HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. -For highlighting single items, for example each instance of the word \"foo\", -typically only MATCH-HIGHLIGHT is required. -However, if an item or (typically) items are to be highlighted following the -instance of another item (the anchor), for example each instance of the -word \"bar\" following the word \"anchor\" then MATCH-ANCHORED may be required. +For highlighting single items, for example each instance of the +word \"foo\", typically only MATCH-HIGHLIGHT is required. +However, if an item or (typically) items are to be highlighted +following the instance of another item (the anchor), for example +each instance of the word \"bar\" following the word \"anchor\" +then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: (SUBEXP FACENAME [OVERRIDE [LAXMATCH]]) -SUBEXP is the number of the subexpression of MATCHER to be highlighted. +SUBEXP is the number of the subexpression of MATCHER to be +highlighted. FACENAME is an expression whose value is the face name to use. -Instead of a face, FACENAME can evaluate to a property list -of the form (face FACE PROP1 VAL1 PROP2 VAL2 ...) -in which case all the listed text-properties will be set rather than -just FACE. In such a case, you will most likely want to put those -properties in `font-lock-extra-managed-props' or to override +Instead of a face, FACENAME can evaluate to a property list of +the form (face FACE PROP1 VAL1 PROP2 VAL2 ...) in which case all +the listed text-properties will be set rather than just FACE. In +such a case, you will most likely want to put those properties in +`font-lock-extra-managed-props' or to override `font-lock-unfontify-region-function'. -OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification can -be overwritten. If `keep', only parts not already fontified are highlighted. -If `prepend' or `append', existing fontification is merged with the new, in -which the new or existing fontification, respectively, takes precedence. -If LAXMATCH is non-nil, that means don't signal an error if there is +OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing +fontification can be overwritten. If `keep', only parts not +already fontified are highlighted. If `prepend' or `append', +existing fontification is merged with the new, in which the new +or existing fontification, respectively, takes precedence. If +LAXMATCH is non-nil, that means don't signal an error if there is no match for SUBEXP in MATCHER. -For example, an element of the form highlights (if not already highlighted): +For example, an element of the form highlights (if not already +highlighted): + + \"\\\\\\=<foo\\\\\\=>\" + Discrete occurrences of \"foo\" in the value of the variable + `font-lock-keyword-face'. + + (\"fu\\\\(bar\\\\)\" . 1) + Substring \"bar\" within all occurrences of \"fubar\" in the + value of `font-lock-keyword-face'. + + (\"fubar\" . fubar-face) + Occurrences of \"fubar\" in the value of `fubar-face'. - \"\\\\\\=<foo\\\\\\=>\" discrete occurrences of \"foo\" in the value of the - variable `font-lock-keyword-face'. - (\"fu\\\\(bar\\\\)\" . 1) substring \"bar\" within all occurrences of \"fubar\" in - the value of `font-lock-keyword-face'. - (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. (\"foo\\\\|bar\" 0 foo-bar-face t) - occurrences of either \"foo\" or \"bar\" in the value - of `foo-bar-face', even if already highlighted. + Occurrences of either \"foo\" or \"bar\" in the value of + `foo-bar-face', even if already highlighted. + (fubar-match 1 fubar-face) - the first subexpression within all occurrences of - whatever the function `fubar-match' finds and matches - in the value of `fubar-face'. + The first subexpression within all occurrences of whatever the + function `fubar-match' finds and matches in the value of + `fubar-face'. MATCH-ANCHORED should be of the form: (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) -where MATCHER is a regexp to search for or the function name to call to make -the search, as for MATCH-HIGHLIGHT above, but with one exception; see below. -PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after -the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be -used to initialize before, and cleanup after, MATCHER is used. Typically, -PRE-MATCH-FORM is used to move to some position relative to the original -MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might -be used to move back, before resuming with MATCH-ANCHORED's parent's MATCHER. - -For example, an element of the form highlights (if not already highlighted): - - (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face))) - - discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent - discrete occurrences of \"item\" (on the same line) in the value of `item-face'. - (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is - initially searched for starting from the end of the match of \"anchor\", and - searching for subsequent instances of \"anchor\" resumes from where searching - for \"item\" concluded.) - -The above-mentioned exception is as follows. The limit of the MATCHER search -defaults to the end of the line after PRE-MATCH-FORM is evaluated. -However, if PRE-MATCH-FORM returns a position greater than the position after -PRE-MATCH-FORM is evaluated, that position is used as the limit of the search. -It is generally a bad idea to return a position greater than the end of the -line, i.e., cause the MATCHER search to span lines. - -These regular expressions can match text which spans lines, although -it is better to avoid it if possible since updating them while editing -text is slower, and it is not guaranteed to be always correct when using -support modes like jit-lock or lazy-lock. - -This variable is set by major modes via the variable `font-lock-defaults'. -Be careful when composing regexps for this list; a poorly written pattern can -dramatically slow things down! - -A compiled keywords list starts with t. It is produced internally -by `font-lock-compile-keywords' from a user-level keywords list. -Its second element is the user-level keywords list that was -compiled. The remaining elements have the same form as -user-level keywords, but normally their values have been +where MATCHER is a regexp to search for or the function name to +call to make the search, as for MATCH-HIGHLIGHT above, but with +one exception; see below. PRE-MATCH-FORM and POST-MATCH-FORM are +evaluated before the first, and after the last, instance +MATCH-ANCHORED's MATCHER is used. Therefore they can be used to +initialize before, and cleanup after, MATCHER is used. +Typically, PRE-MATCH-FORM is used to move to some position +relative to the original MATCHER, before starting with +MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might be used to move +back, before resuming with MATCH-ANCHORED's parent's MATCHER. + +For example, an element of the form highlights (if not already +highlighted): + + (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) + (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face))) + + Discrete occurrences of \"anchor\" in the value of + `anchor-face', and subsequent discrete occurrences of + \"item\" (on the same line) in the value of `item-face'. + (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore + \"item\" is initially searched for starting from the end of the + match of \"anchor\", and searching for subsequent instances of + \"anchor\" resumes from where searching for \"item\" concluded.) + +The above-mentioned exception is as follows. The limit of the +MATCHER search defaults to the end of the line after +PRE-MATCH-FORM is evaluated. However, if PRE-MATCH-FORM returns +a position greater than the position after PRE-MATCH-FORM is +evaluated, that position is used as the limit of the search. It +is generally a bad idea to return a position greater than the end +of the line, i.e., cause the MATCHER search to span lines. + +These regular expressions can match text which spans lines, +although it is better to avoid it if possible since updating them +while editing text is slower, and it is not guaranteed to be +always correct when using support modes like jit-lock or +lazy-lock. + +This variable is set by major modes via the variable +`font-lock-defaults'. Be careful when composing regexps for this +list; a poorly written pattern can dramatically slow things down! + +A compiled keywords list starts with t. It is produced +internally by `font-lock-compile-keywords' from a user-level +keywords list. Its second element is the user-level keywords +list that was compiled. The remaining elements have the same +form as user-level keywords, but normally their values have been optimized.") (defvar font-lock-keywords-alist nil @@ -785,8 +805,11 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', (defun font-lock-remove-keywords (mode keywords) "Remove highlighting KEYWORDS for MODE. -MODE should be a symbol, the major mode command name, such as `c-mode' -or nil. If nil, highlighting keywords are removed for the current buffer. +MODE should be a symbol, the major mode command name, such as +`c-mode' or nil. If nil, highlighting keywords are removed for +the current buffer. + +For a description of KEYWORDS, see `font-lock-add-keywords'. To make the removal apply to modes derived from MODE as well, pass nil for MODE and add the call to MODE-hook. This may fail diff --git a/lisp/forms.el b/lisp/forms.el index c141188788b..b068352e6eb 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -589,7 +589,14 @@ Commands: Equivalent keys in read-only mode: (make-local-variable 'forms--dynamic-text) ;; Prevent accidental overwrite of the control file and auto-save. - (set-visited-file-name nil) + ;; We bind change-major-mode-with-file-name to nil to prevent + ;; set-visited-file-name from calling set-auto-mode, which + ;; might kill all local variables and set forms-file nil, + ;; which will then barf in find-file-noselect below. This can + ;; happen when the user sets the default major mode that is + ;; different from the Fundamental mode. + (let (change-major-mode-with-file-name) + (set-visited-file-name nil)) ;; Prepare this buffer for further processing. (setq buffer-read-only nil) diff --git a/lisp/frame.el b/lisp/frame.el index 09738d1e2ed..1dffc6ca753 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1874,30 +1874,29 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to the opposite frame edge from the edge indicated in the input spec." (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame))) - (defun delete-other-frames (&optional frame) - "Delete all frames on the current terminal, except FRAME. + "Delete all frames on FRAME's terminal, except FRAME. If FRAME uses another frame's minibuffer, the minibuffer frame is -left untouched. FRAME nil or omitted means use the selected frame." +left untouched. FRAME must be a live frame and defaults to the +selected one." (interactive) - (unless frame - (setq frame (selected-frame))) - (let* ((mini-frame (window-frame (minibuffer-window frame))) - (frames (delq mini-frame (delq frame (frame-list))))) - ;; Only consider frames on the same terminal. - (dolist (frame (prog1 frames (setq frames nil))) - (if (eq (frame-terminal) (frame-terminal frame)) - (push frame frames))) - ;; Delete mon-minibuffer-only frames first, because `delete-frame' - ;; signals an error when trying to delete a mini-frame that's - ;; still in use by another frame. - (dolist (frame frames) - (unless (eq (frame-parameter frame 'minibuffer) 'only) - (delete-frame frame))) - ;; Delete minibuffer-only frames. - (dolist (frame frames) - (when (eq (frame-parameter frame 'minibuffer) 'only) - (delete-frame frame))))) + (setq frame (window-normalize-frame frame)) + (let ((minibuffer-frame (window-frame (minibuffer-window frame))) + (this (next-frame frame t)) + next) + ;; In a first round consider minibuffer-less frames only. + (while (not (eq this frame)) + (setq next (next-frame this t)) + (unless (eq (window-frame (minibuffer-window this)) this) + (delete-frame this)) + (setq this next)) + ;; In a second round consider all remaining frames. + (setq this (next-frame frame t)) + (while (not (eq this frame)) + (setq next (next-frame this t)) + (unless (eq this minibuffer-frame) + (delete-frame this)) + (setq this next)))) ;; miscellaneous obsolescence declarations (define-obsolete-variable-alias 'delete-frame-hook @@ -2022,20 +2021,36 @@ widths." ;; Blinking cursor +(defvar blink-cursor-idle-timer nil + "Timer started after `blink-cursor-delay' seconds of Emacs idle time. +The function `blink-cursor-start' is called when the timer fires.") + +(defvar blink-cursor-timer nil + "Timer started from `blink-cursor-start'. +This timer calls `blink-cursor-timer-function' every +`blink-cursor-interval' seconds.") + (defgroup cursor nil "Displaying text cursors." :version "21.1" :group 'frames) (defcustom blink-cursor-delay 0.5 - "Seconds of idle time after which cursor starts to blink." + "Seconds of idle time before the first blink of the cursor. +Values smaller than 0.2 sec are treated as 0.2 sec." :type 'number - :group 'cursor) + :group 'cursor + :set (lambda (symbol value) + (set-default symbol value) + (when blink-cursor-idle-timer (blink-cursor--start-idle-timer)))) (defcustom blink-cursor-interval 0.5 "Length of cursor blink interval in seconds." :type 'number - :group 'cursor) + :group 'cursor + :set (lambda (symbol value) + (set-default symbol value) + (when blink-cursor-timer (blink-cursor--start-timer)))) (defcustom blink-cursor-blinks 10 "How many times to blink before using a solid cursor on NS, X, and MS-Windows. @@ -2047,14 +2062,23 @@ Use 0 or negative value to blink forever." (defvar blink-cursor-blinks-done 1 "Number of blinks done since we started blinking on NS, X, and MS-Windows.") -(defvar blink-cursor-idle-timer nil - "Timer started after `blink-cursor-delay' seconds of Emacs idle time. -The function `blink-cursor-start' is called when the timer fires.") - -(defvar blink-cursor-timer nil - "Timer started from `blink-cursor-start'. -This timer calls `blink-cursor-timer-function' every -`blink-cursor-interval' seconds.") +(defun blink-cursor--start-idle-timer () + "Start the `blink-cursor-idle-timer'." + (when blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer)) + (setq blink-cursor-idle-timer + ;; The 0.2 sec limitation from below is to avoid erratic + ;; behavior (or downright failure to display the cursor + ;; during command execution) if they set blink-cursor-delay + ;; to a very small or even zero value. + (run-with-idle-timer (max 0.2 blink-cursor-delay) + :repeat #'blink-cursor-start))) + +(defun blink-cursor--start-timer () + "Start the `blink-cursor-timer'." + (when blink-cursor-timer (cancel-timer blink-cursor-timer)) + (setq blink-cursor-timer + (run-with-timer blink-cursor-interval blink-cursor-interval + #'blink-cursor-timer-function))) (defun blink-cursor-start () "Timer function called from the timer `blink-cursor-idle-timer'. @@ -2065,9 +2089,7 @@ command starts, by installing a pre-command hook." ;; Set up the timer first, so that if this signals an error, ;; blink-cursor-end is not added to pre-command-hook. (setq blink-cursor-blinks-done 1) - (setq blink-cursor-timer - (run-with-timer blink-cursor-interval blink-cursor-interval - 'blink-cursor-timer-function)) + (blink-cursor--start-timer) (add-hook 'pre-command-hook 'blink-cursor-end) (internal-show-cursor nil nil))) @@ -2114,10 +2136,7 @@ This is done when a frame gets focus. Blink timers may be stopped by (when (and blink-cursor-mode (not blink-cursor-idle-timer)) (remove-hook 'post-command-hook 'blink-cursor-check) - (setq blink-cursor-idle-timer - (run-with-idle-timer blink-cursor-delay - blink-cursor-delay - 'blink-cursor-start)))) + (blink-cursor--start-idle-timer))) (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") @@ -2148,10 +2167,8 @@ terminals, cursor blinking is controlled by the terminal." (when blink-cursor-mode (add-hook 'focus-in-hook #'blink-cursor-check) (add-hook 'focus-out-hook #'blink-cursor-suspend) - (setq blink-cursor-idle-timer - (run-with-idle-timer blink-cursor-delay - blink-cursor-delay - #'blink-cursor-start)))) + (blink-cursor--start-idle-timer))) + ;; Frame maximization/fullscreen @@ -2232,9 +2249,8 @@ See also `toggle-frame-maximized'." 'window-system-version "it does not give useful information." "24.3") ;; Variables which should trigger redisplay of the current buffer. -(setq redisplay--variables (make-hash-table :test 'eq :size 10)) (mapc (lambda (var) - (puthash var 1 redisplay--variables)) + (add-variable-watcher var (symbol-function 'set-buffer-redisplay))) '(line-spacing overline-margin line-prefix diff --git a/lisp/frameset.el b/lisp/frameset.el index 2453f57e228..9a7a8bcf8b0 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -572,7 +572,7 @@ see `frameset-filter-alist'." (defun frameset-filter-minibuffer (current filtered _parameters saving) "Force the minibuffer parameter to have a sensible value. -When saving, convert (minibuffer . #<window>) to (minibuffer . t). +When saving, convert (minibuffer . #<window>) to (minibuffer . nil). When restoring, if there are two copies, keep the one pointing to a live window. @@ -580,7 +580,12 @@ For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING, see `frameset-filter-alist'." (let ((value (cdr current)) mini) (cond (saving - (if (windowp value) '(minibuffer . t) t)) + ;; "Fix semantics of 'minibuffer' frame parameter" change: + ;; When the cdr of the parameter is a minibuffer window, save + ;; (minibuffer . nil) instead of (minibuffer . t). + (if (windowp value) + '(minibuffer . nil) + t)) ((setq mini (assq 'minibuffer filtered)) (when (windowp value) (setcdr mini value)) nil) @@ -906,12 +911,12 @@ is the parameter alist of the frame being restored. Internal use only." ;; If it has not been loaded, and it is not a minibuffer-only frame, ;; let's look for an existing non-minibuffer-only frame to reuse. (unless (or frame (eq (cdr (assq 'minibuffer parameters)) 'only)) + ;; "Fix semantics of 'minibuffer' frame parameter" change: + ;; The 'minibuffer' frame parameter of a non-minibuffer-only + ;; frame is t instead of that frame's minibuffer window. (setq frame (frameset--find-frame-if (lambda (f) - (let ((w (frame-parameter f 'minibuffer))) - (and (window-live-p w) - (window-minibuffer-p w) - (eq (window-frame w) f)))) + (eq (frame-parameter f 'minibuffer) t)) display)))) (mini ;; For minibufferless frames, check whether they already exist, @@ -1027,8 +1032,11 @@ For the meaning of FORCE-DISPLAY, see `frameset-restore'." (t (not force-display)))) (defun frameset-minibufferless-first-p (frame1 _frame2) - "Predicate to sort minibufferless frames before other frames." - (not (frame-parameter frame1 'minibuffer))) + "Predicate to sort minibuffer-less frames before other frames." + ;; "Fix semantics of 'minibuffer' frame parameter" change: The + ;; 'minibuffer' frame parameter of a minibuffer-less frame is that + ;; frame's minibuffer window instead of nil. + (windowp (frame-parameter frame1 'minibuffer))) ;;;###autoload (cl-defun frameset-restore (frameset diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 71ba1f7d002..1e3a6e183b4 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -215,6 +215,7 @@ This hook will be installed if the variable (defconst generic-unix-modes '(alias-generic-mode + ansible-inventory-generic-mode etc-fstab-generic-mode etc-modules-conf-generic-mode etc-passwd-generic-mode @@ -646,6 +647,30 @@ like an INI file. You can add this hook to `find-file-hook'." '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))) "Generic mode for C Shell alias files.")) +;; Ansible inventory files +(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list) + +(define-generic-mode ansible-inventory-generic-mode + '(?#) + nil + '(("^\\s-*\\(\\[.*\\]\\)" 1 font-lock-constant-face) + ("^\\s-*\\([^ \n\r]*\\)" 1 font-lock-function-name-face) + ;; Variable assignments must be x=y, so highlight as warning if + ;; the value is missing. + ("\\s-\\([^ =\n\r]+\\)[\n\r ]" 1 font-lock-warning-face) + ;; Variable assignments: x=y + ("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)" + (1 font-lock-variable-name-face) + (2 font-lock-keyword-face))) + '("inventory") + (list + (function + (lambda () + (setq imenu-generic-expression + '((nil "^\\s-*\\[\\(.*\\)\\]" 1) + ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))) + "Generic mode for Ansible inventory files.")) + ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) (when (memq 'rc-generic-mode generic-extras-enable-list) diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index 47eb34ee691..475af051a61 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -3230,7 +3230,7 @@ * gnus-picon.el (gnus-picons-display-pairs): Don't add two bars. (gnus-picons-try-face): Set the foreground color on the bar. - (gnus-picons-group-exluded-groups): New variable. + (gnus-picons-group-excluded-groups): New variable. (gnus-group-display-picons): Use it. 1997-10-13 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 73f5f099658..ed0e81f0ebf 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -4705,7 +4705,7 @@ illegible and invisible text. * gnus-util.el (gnus-multiple-choice): Separate choices with - ", ". Suggested by Dan Jacobson <jidanni@dman.ddts.net>. + ", ". Suggested by Dan Jacobson <jidanni@dman.ddts.net>. 2003-02-18 Jesper Harder <harder@ifa.au.dk> diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index e6cbe0458b4..f734e6e6976 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -9090,7 +9090,7 @@ (shr-kinsoku-shorten): New internal variable. (shr-find-fill-point): Make kinsoku shorten text line if shr-kinsoku-shorten is bound to non-nil. - (shr-tag-table): Bild shr-kinsoku-shorten to t; refer to + (shr-tag-table): Bind shr-kinsoku-shorten to t; refer to shr-indentation too when testing if table is wider than frame width. (shr-insert-table): Use `string-width' instead of `length' to measure text width. diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 785a286c915..61ef001beb9 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -256,37 +256,8 @@ If mode is nil, use `major-mode' of the current buffer." (string-match "^\\(.+\\)-mode$" mode) (match-string 1 mode)))))) -(defun gmm-format-time-string (format-string &optional time tz) - "Use FORMAT-STRING to format the time TIME, or now if omitted. -The optional TZ specifies the time zone in a number of seconds; any -other non-nil value will be treated as 0. Note that both the format -specifiers `%Z' and `%z' will be replaced with a numeric form. " -;; FIXME: is there a smart way to replace %Z with a time zone name? - (if (and (numberp tz) (not (zerop tz))) - (let ((st 0) - (case-fold-search t) - ls nd rest) - (setq time (if time - (copy-sequence time) - (current-time))) - (if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0) - (setcar (cdr time) ls) - (setcar (cdr time) (+ ls 65536)) - (setcar time (1- (car time)))) - (setq tz (format "%s%02d%02d" - (if (>= tz 0) "+" "-") - (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60))) - (while (string-match "%+z" format-string st) - (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2)) - (progn - (push (substring format-string st (- nd 2)) rest) - (push tz rest)) - (push (substring format-string st nd) rest)) - (setq st nd)) - (push (substring format-string st) rest) - (format-time-string (apply 'concat (nreverse rest)) time)) - (format-time-string format-string time tz))) +(define-obsolete-function-alias 'gmm-format-time-string 'format-time-string + "26.1") (provide 'gmm-utils) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 6c1915ba909..e6356b1d122 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -161,7 +161,7 @@ enable expiration per categories, topics, and groups." (const :format "Disable " DISABLE))) (defcustom gnus-agent-expire-unagentized-dirs t - "*Whether expiration should expire in unagentized directories. + "Whether expiration should expire in unagentized directories. Have gnus-agent-expire scan the directories under \(gnus-agent-directory) for groups that are no longer agentized. When found, offer to remove them." @@ -2633,8 +2633,10 @@ General format specifiers can also be used. See Info node "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) -(defvar gnus-category-menu-hook nil - "*Hook run after the creation of the menu.") +(defcustom gnus-category-menu-hook nil + "Hook run after the creation of the menu." + :group 'gnus-agent + :type 'hook) (defun gnus-category-make-menu-bar () (gnus-turn-off-edit-menu 'category) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 4d8cb802b48..0080b419f52 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -158,7 +158,7 @@ "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane" "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At" "Envelope-Sender" "Envelope-Recipients")) - "*All headers that start with this regexp will be hidden. + "All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." :type '(choice regexp @@ -167,7 +167,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." (defcustom gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:" - "*All headers that do not match this regexp will be hidden. + "All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." :type '(choice @@ -184,7 +184,7 @@ If this variable is non-nil, `gnus-ignored-headers' will be ignored." (defcustom gnus-sorted-header-list '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:") - "*This variable is a list of regular expressions. + "This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list." @@ -271,7 +271,7 @@ This can also be a list of the above values." "{ echo \ '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\ ; uncompface; } | icontopbm | display -") - "*String or function to be executed to display an X-Face header. + "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." :type `(choice string @@ -389,7 +389,7 @@ advertisements. For example: ;; 2 3 gnus-emphasis-strikethru) ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" 2 3 gnus-emphasis-underline)))) - "*Alist that says how to fontify certain phrases. + "Alist that says how to fontify certain phrases. Each item looks like this: (\"_\\\\(\\\\w+\\\\)_\" 0 1 \\='underline) @@ -498,7 +498,7 @@ be fed to `format-time-string'." :group 'gnus-article-washing) (defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving. + "If non-nil, don't remove any headers before saving. This will be overridden by the `:headers' property that the symbol of the saver function, which is specified by `gnus-default-article-saver', might have." @@ -506,7 +506,7 @@ might have." :type 'boolean) (defcustom gnus-prompt-before-saving 'always - "*This variable says how much prompting is to be done when saving articles. + "This variable says how much prompting is to be done when saving articles. If it is nil, no prompting will be done, and the articles will be saved to the default files. If this variable is `always', each and every article that is saved will be preceded by a prompt, even when @@ -653,7 +653,7 @@ LAST-FILE." (defcustom gnus-split-methods '((gnus-article-archive-name) (gnus-article-nndoc-name)) - "*Variable used to suggest where articles are to be saved. + "Variable used to suggest where articles are to be saved. For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", you could set this variable to something like: @@ -679,14 +679,14 @@ used as possible file names." (sexp :value nil)))) (defcustom gnus-page-delimiter "^\^L" - "*Regexp describing what to use as article page delimiters. + "Regexp describing what to use as article page delimiters. The default value is \"^\^L\", which is a form linefeed at the beginning of a line." :type 'regexp :group 'gnus-article-various) (defcustom gnus-article-mode-line-format "Gnus: %g %S%m" - "*The format specification for the article mode line. + "The format specification for the article mode line. See `gnus-summary-mode-line-format' for a closer description. The following additional specs are available: @@ -698,17 +698,17 @@ The following additional specs are available: :group 'gnus-article-various) (defcustom gnus-article-mode-hook nil - "*A hook for Gnus article mode." + "A hook for Gnus article mode." :type 'hook :group 'gnus-article-various) (defcustom gnus-article-menu-hook nil - "*Hook run after the creation of the article mode menu." + "Hook run after the creation of the article mode menu." :type 'hook :group 'gnus-article-various) (defcustom gnus-article-prepare-hook nil - "*A hook called after an article has been prepared in the article buffer." + "A hook called after an article has been prepared in the article buffer." :type 'hook :group 'gnus-article-various) @@ -846,7 +846,7 @@ articles." ("Subject" nil gnus-header-subject) ("Newsgroups:.*," nil gnus-header-newsgroups) ("" gnus-header-name gnus-header-content)) - "*Controls highlighting of article headers. + "Controls highlighting of article headers. An alist of the form (HEADER NAME CONTENT). @@ -892,7 +892,7 @@ images in Emacs." (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-encoded-words article-decode-group-name article-decode-idna-rhs) - "*Hook run to decode charsets in articles." + "Hook run to decode charsets in articles." :group 'gnus-article-headers :type 'hook) @@ -1009,7 +1009,7 @@ on parts -- for instance, adding Vcard info to a database." (defcustom gnus-article-date-headers '(combined-lapsed) "A list of Date header formats to display. -Valid formats are `ut' (universal time), `local' (local time +Valid formats are `ut' (Universal Time), `local' (local time zone), `english' (readable English), `lapsed' (elapsed time), `combined-lapsed' (both the original date and the elapsed time), `original' (the original date header), `iso8601' (ISO8601 @@ -1393,7 +1393,7 @@ predicate. See Info node `(gnus)Customizing Articles'." :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) -(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t) +(defcustom gnus-treat-ansi-sequences t "Treat ANSI SGR control sequences. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -1610,18 +1610,9 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) -(defvar idna-program) - -(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8) - (condition-case nil - (require 'idna) - (file-error) - (invalid-operation)) - idna-program - (executable-find idna-program)) - "Whether IDNA decoding of headers is used when viewing messages. -This requires GNU Libidn, and by default only enabled if it is found." - :version "22.1" +(defcustom gnus-use-idna t + "Whether IDNA decoding of headers is used when viewing messages." + :version "26.1" :group 'gnus-article-headers :type 'boolean) @@ -2591,8 +2582,6 @@ If PROMPT (the prefix), prompt for a coding system to use." t t nil 1)) (goto-char (point-min))))))) -(autoload 'idna-to-unicode "idna") - (defun article-decode-idna-rhs () "Decode IDNA strings in RHS in various headers in current buffer. The following headers are decoded: From:, To:, Cc:, Reply-To:, @@ -2610,7 +2599,7 @@ Mail-Reply-To: and Mail-Followup-To:." (save-excursion (and (re-search-backward "^[^ \t]" nil t) (looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To"))) - (setq unicode (idna-to-unicode ace)))) + (setq unicode (puny-decode-domain ace)))) (unless (string= ace unicode) (replace-match unicode nil nil nil 1))))))))) @@ -3607,7 +3596,7 @@ possible values." ;; If the date is seriously mangled, the timezone functions are ;; liable to bug out, so we ignore all errors. (let* ((now (current-time)) - (real-time (subtract-time now time)) + (real-time (time-subtract now time)) (real-sec (and real-time (+ (* (float (car real-time)) 65536) (cadr real-time)))) @@ -4409,7 +4398,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defvar gnus-article-send-map) (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) "W" gnus-article-wide-reply-with-original - [t] 'gnus-article-read-summary-send-keys) + [t] gnus-article-read-summary-send-keys) (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) @@ -7379,7 +7368,7 @@ groups." (defcustom gnus-button-valid-fqdn-regexp "\\([-A-Za-z0-9]+\\.\\)+[A-Za-z]+" "Regular expression that matches a valid FQDN." - :version "25.2" + :version "26.1" :group 'gnus-article-buttons :type 'regexp) @@ -7650,11 +7639,11 @@ Calls `describe-variable' or `describe-function'." (let* ((lib (locate-library url)) (file (replace-regexp-in-string "\\.elc" ".el" (or lib "")))) (if (not lib) - (gnus-message 1 "Cannot locale library `%s'." url) + (gnus-message 1 "Cannot locate library `%s'." url) (find-file-read-only file)))) (defcustom gnus-button-man-level 5 - "*Integer that says how many man-related buttons Gnus will show. + "Integer that says how many man-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to specific groups. Setting it higher in Unix groups is probably a good idea. @@ -7666,7 +7655,7 @@ how to set variables in specific groups." :type 'integer) (defcustom gnus-button-emacs-level 5 - "*Integer that says how many emacs-related buttons Gnus will show. + "Integer that says how many emacs-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to specific groups. Setting it higher in Emacs or Gnus related groups is @@ -7678,7 +7667,7 @@ probably a good idea. See Info node `(gnus)Group Parameters' and the variable :type 'integer) (defcustom gnus-button-message-level 5 - "*Integer that says how many buttons for news or mail messages will appear. + "Integer that says how many buttons for news or mail messages will appear. The higher the number, the more buttons will appear and the more false positives are possible." ;; mail addresses, MIDs, URLs for news, ... @@ -7687,7 +7676,7 @@ positives are possible." :type 'integer) (defcustom gnus-button-browse-level 5 - "*Integer that says how many buttons for browsing will appear. + "Integer that says how many buttons for browsing will appear. The higher the number, the more buttons will appear and the more false positives are possible." ;; stuff handled by `browse-url' or `gnus-button-embedded-url' @@ -7808,7 +7797,7 @@ positives are possible." ;; so that non-ambiguous entries (see above) match first. (gnus-button-mid-or-mail-regexp 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1)) - "*Alist of regexps matching buttons in article bodies. + "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string (case insensitive) matching text around the button (can @@ -7850,7 +7839,7 @@ variable it the real callback function." 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) - "*Alist of headers and regexps to match buttons in article heads. + "Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each alist has an additional HEADER element first in each entry: diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index ba72d820431..19867d83ae7 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -35,7 +35,7 @@ :group 'gnus) (defcustom gnus-use-article-prefetch 30 - "*If non-nil, prefetch articles in groups that allow this. + "If non-nil, prefetch articles in groups that allow this. If a number, prefetch only that many articles forward; if t, prefetch as many articles as possible." :group 'gnus-asynchronous @@ -44,7 +44,7 @@ if t, prefetch as many articles as possible." (integer :tag "some" 0))) (defcustom gnus-asynchronous nil - "*If nil, inhibit all Gnus asynchronicity. + "If nil, inhibit all Gnus asynchronicity. If non-nil, let the other asynch variables be heeded." :group 'gnus-asynchronous :type 'boolean) @@ -59,7 +59,7 @@ from that group." :type '(set (const read) (const exit))) (defcustom gnus-use-header-prefetch nil - "*If non-nil, prefetch the headers to the next group." + "If non-nil, prefetch the headers to the next group." :group 'gnus-asynchronous :type 'boolean) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 050e8cd7895..aa2d0185c26 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -35,7 +35,7 @@ (defcustom gnus-cache-active-file (expand-file-name "active" gnus-cache-directory) - "*The cache active file." + "The cache active file." :group 'gnus-cache :type 'file) @@ -50,7 +50,7 @@ :type '(set (const ticked) (const dormant) (const unread) (const read))) (defcustom gnus-cacheable-groups nil - "*Groups that match this regexp will be cached. + "Groups that match this regexp will be cached. If you only want to cache your nntp groups, you could set this variable to \"^nntp\". @@ -62,7 +62,7 @@ it's not cached." regexp)) (defcustom gnus-uncacheable-groups nil - "*Groups that match this regexp will not be cached. + "Groups that match this regexp will not be cached. If you want to avoid caching your nnml groups, you could set this variable to \"^nnml\". diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 4f05d2ee9d5..03ed71d50c6 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -72,7 +72,7 @@ Set it to nil to parse all articles." (defcustom gnus-supercite-regexp (concat "^\\(" message-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") - "*Regexp matching normal Supercite attribution lines. + "Regexp matching normal Supercite attribution lines. The first grouping must match prefixes added by other packages." :group 'gnus-cite :type 'regexp) @@ -107,13 +107,13 @@ The first regexp group should match the Supercite attribution." (defcustom gnus-cite-attribution-prefix "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" - "*Regexp matching the beginning of an attribution line." + "Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" - "*Regexp matching the end of an attribution line. + "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite :type 'regexp) @@ -304,7 +304,7 @@ It is merged with the face for the cited text belonging to the attribution." (defcustom gnus-cite-face-list '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11) - "*List of faces used for highlighting citations. + "List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index a6a0f64603d..14af4b2a840 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -28,6 +28,12 @@ (require 'parse-time) (require 'nnimap) +(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' +(autoload 'epg-make-context "epg") +(autoload 'epg-context-set-passphrase-callback "epg") +(autoload 'epg-decrypt-string "epg") +(autoload 'epg-encrypt-string "epg") + (defgroup gnus-cloud nil "Syncing Gnus data via IMAP." :version "25.1" @@ -43,18 +49,36 @@ ;; FIXME this type does not match the default. Nor does the documentation. :type '(repeat regexp)) -(defvar gnus-cloud-group-name "*Emacs Cloud*") +(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) + "Storage method for cloud data, defaults to EPG if that's available." + :group 'gnus-cloud + :type '(radio (const :tag "No encoding" nil) + (const :tag "Base64" base64) + (const :tag "Base64+gzip" base64-gzip) + (const :tag "EPG" epg))) + +(defcustom gnus-cloud-interactive t + "Whether Gnus Cloud changes should be confirmed." + :group 'gnus-cloud + :type 'boolean) + +(defvar gnus-cloud-group-name "Emacs-Cloud") (defvar gnus-cloud-covered-servers nil) (defvar gnus-cloud-version 1) (defvar gnus-cloud-sequence 1) -(defvar gnus-cloud-method nil - "The IMAP select method used to store the cloud data.") +(defcustom gnus-cloud-method nil + "The IMAP select method used to store the cloud data. +See also `gnus-server-toggle-cloud-method-server' for an +easy interactive way to set this from the Server buffer." + :group 'gnus-cloud + :type '(radio (const :tag "Not set" nil) + (string :tag "A Gnus server name as a string"))) (defun gnus-cloud-make-chunk (elems) (with-temp-buffer - (insert (format "Version %s\n" gnus-cloud-version)) + (insert (format "Gnus-Cloud-Version %s\n" gnus-cloud-version)) (insert (gnus-cloud-insert-data elems)) (buffer-string))) @@ -63,106 +87,189 @@ (dolist (elem elems) (cond ((eq (plist-get elem :type) :file) - (let (length data) - (mm-with-unibyte-buffer - (insert-file-contents-literally (plist-get elem :file-name)) - (setq length (buffer-size) - data (buffer-string))) - (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n" - (plist-get elem :file-name) - (plist-get elem :timestamp) - length)) - (insert data) - (insert "\n"))) - ((eq (plist-get elem :type) :data) - (insert (format "(:type :data :name %S :length %d)\n" - (plist-get elem :name) - (with-current-buffer (plist-get elem :buffer) - (buffer-size)))) - (insert-buffer-substring (plist-get elem :buffer)) - (insert "\n")) + (let (length data) + (mm-with-unibyte-buffer + (insert-file-contents-literally (plist-get elem :file-name)) + (setq length (buffer-size) + data (buffer-string))) + (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n" + (plist-get elem :file-name) + (plist-get elem :timestamp) + length)) + (insert data) + (insert "\n"))) + ((eq (plist-get elem :type) :newsrc-data) + (let ((print-level nil) + (print-length nil)) + (print elem (current-buffer))) + (insert "\n")) ((eq (plist-get elem :type) :delete) - (insert (format "(:type :delete :file-name %S)\n" - (plist-get elem :file-name)))))) + (insert (format "(:type :delete :file-name %S)\n" + (plist-get elem :file-name)))))) (gnus-cloud-encode-data) (buffer-string))) (defun gnus-cloud-encode-data () - (call-process-region (point-min) (point-max) "gzip" - t (current-buffer) nil - "-c") - (base64-encode-region (point-min) (point-max))) + (cond + ((eq gnus-cloud-storage-method 'base64-gzip) + (progn + (call-process-region (point-min) (point-max) "gzip" + t (current-buffer) nil + "-c") + (base64-encode-region (point-min) (point-max)))) + + ((eq gnus-cloud-storage-method 'base64) + (base64-encode-region (point-min) (point-max))) + + ((eq gnus-cloud-storage-method 'epg) + (let ((context (epg-make-context 'OpenPGP)) + cipher) + (setf (epg-context-armor context) t) + (setf (epg-context-textmode context) t) + (let ((data (epg-encrypt-string context + (buffer-substring-no-properties + (point-min) + (point-max)) + nil))) + (delete-region (point-min) (point-max)) + (insert data)))) + + ((null gnus-cloud-storage-method) + (gnus-message 5 "Leaving cloud data plaintext")) + (t (gnus-error 1 "Invalid cloud storage method %S" + gnus-cloud-storage-method)))) (defun gnus-cloud-decode-data () - (base64-decode-region (point-min) (point-max)) - (call-process-region (point-min) (point-max) "gunzip" - t (current-buffer) nil - "-c")) + (cond + ((memq gnus-cloud-storage-method '(base64 base64-gzip)) + (base64-decode-region (point-min) (point-max))) + + ((eq gnus-cloud-storage-method 'base64-gzip) + (call-process-region (point-min) (point-max) "gunzip" + t (current-buffer) nil + "-c")) + + ((eq gnus-cloud-storage-method 'epg) + (let* ((context (epg-make-context 'OpenPGP)) + (data (epg-decrypt-string context (buffer-substring-no-properties + (point-min) + (point-max))))) + (delete-region (point-min) (point-max)) + (insert data))) + + ((null gnus-cloud-storage-method) + (gnus-message 5 "Reading cloud data as plaintext")) + + (t (gnus-error 1 "Invalid cloud storage method %S" + gnus-cloud-storage-method)))) (defun gnus-cloud-parse-chunk () (save-excursion - (goto-char (point-min)) - (unless (looking-at "Version \\([0-9]+\\)") + (unless (looking-at "Gnus-Cloud-Version \\([0-9]+\\)") (error "Not a valid Cloud chunk in the current buffer")) (forward-line 1) (let ((version (string-to-number (match-string 1))) - (data (buffer-substring (point) (point-max)))) + (data (buffer-substring (point) (point-max)))) (mm-with-unibyte-buffer - (insert data) - (cond - ((= version 1) - (gnus-cloud-decode-data) - (goto-char (point-min)) - (gnus-cloud-parse-version-1)) - (t - (error "Unsupported Cloud chunk version %s" version))))))) + (insert data) + (cond + ((= version 1) + (gnus-cloud-decode-data) + (goto-char (point-min)) + (gnus-cloud-parse-version-1)) + (t + (error "Unsupported Cloud chunk version %s" version))))))) (defun gnus-cloud-parse-version-1 () (let ((elems nil)) (while (not (eobp)) (while (and (not (eobp)) - (not (looking-at "(:type"))) - (forward-line 1)) + (not (looking-at "(:type"))) + (forward-line 1)) (unless (eobp) - (let ((spec (ignore-errors (read (current-buffer)))) - length) - (when (and (consp spec) - (memq (plist-get spec :type) '(:file :data :delete))) - (setq length (plist-get spec :length)) - (push (append spec - (list - :contents (buffer-substring (1+ (point)) - (+ (point) 1 length)))) - elems) - (goto-char (+ (point) 1 length)))))) + (let ((spec (ignore-errors (read (current-buffer)))) + length) + (when (consp spec) + (cond + ((memq (plist-get spec :type) '(:file :delete)) + (setq length (plist-get spec :length)) + (push (append spec + (list + :contents (buffer-substring (1+ (point)) + (+ (point) 1 length)))) + elems) + (goto-char (+ (point) 1 length))) + ((memq (plist-get spec :type) '(:newsrc-data)) + (push spec elems))))))) (nreverse elems))) -(defun gnus-cloud-update-data (elems) +(defun gnus-cloud-update-all (elems) (dolist (elem elems) (let ((type (plist-get elem :type))) (cond - ((eq type :data) - ) - ((eq type :delete) - (gnus-cloud-delete-file (plist-get elem :file-name)) - ) - ((eq type :file) - (gnus-cloud-update-file elem)) + ((eq type :newsrc-data) + (gnus-cloud-update-newsrc-data (plist-get elem :name) elem)) + ((memq type '(:delete :file)) + (gnus-cloud-update-file elem type)) (t - (message "Unknown type %s; ignoring" type)))))) - -(defun gnus-cloud-update-file (elem) - (let ((file-name (plist-get elem :file-name)) - (date (plist-get elem :timestamp)) - (contents (plist-get elem :contents))) - (unless (gnus-cloud-file-covered-p file-name) - (message "%s isn't covered by the cloud; ignoring" file-name)) - (when (or (not (file-exists-p file-name)) - (and (file-exists-p file-name) - (mm-with-unibyte-buffer - (insert-file-contents-literally file-name) - (not (equal (buffer-string) contents))))) - (gnus-cloud-replace-file file-name date contents)))) + (gnus-message 1 "Unknown type %s; ignoring" type)))))) + +(defun gnus-cloud-update-newsrc-data (group elem &optional force-older) + "Update the newsrc data for GROUP from ELEM. +Use old data if FORCE-OLDER is not nil." + (let* ((contents (plist-get elem :contents)) + (date (or (plist-get elem :timestamp) "0")) + (now (gnus-cloud-timestamp (current-time))) + (newer (string-lessp date now)) + (group-info (gnus-get-info group))) + (if (and contents + (stringp (nth 0 contents)) + (integerp (nth 1 contents))) + (if group-info + (if (equal (format "%S" group-info) + (format "%S" contents)) + (gnus-message 3 "Skipping cloud update of group %s, the info is the same" group) + (if (and newer (not force-older)) + (gnus-message 3 "Skipping outdated cloud info for group %s, the info is from %s (now is %s)" group date now) + (when (or (not gnus-cloud-interactive) + (gnus-y-or-n-p + (format "%s has older different info in the cloud as of %s, update it here? " + group date)))) + (gnus-message 2 "Installing cloud update of group %s" group) + (gnus-set-info group contents) + (gnus-group-update-group group))) + (gnus-error 1 "Sorry, group %s is not subscribed" group)) + (gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)" + group elem)))) + +(defun gnus-cloud-update-file (elem op) + "Apply Gnus Cloud data ELEM and operation OP to a file." + (let* ((file-name (plist-get elem :file-name)) + (date (plist-get elem :timestamp)) + (contents (plist-get elem :contents)) + (exists (file-exists-p file-name))) + (if (gnus-cloud-file-covered-p file-name) + (cond + ((eq op :delete) + (if (and exists + ;; prompt only if the file exists already + (or (not gnus-cloud-interactive) + (gnus-y-or-n-p (format "%s has been deleted as of %s, delete it locally? " + file-name date)))) + (rename-file file-name (car (find-backup-file-name file-name))) + (gnus-message 3 "%s was already deleted before the cloud got it" file-name))) + ((eq op :file) + (when (or (not exists) + (and exists + (mm-with-unibyte-buffer + (insert-file-contents-literally file-name) + (not (equal (buffer-string) contents))) + ;; prompt only if the file exists already + (or (not gnus-cloud-interactive) + (gnus-y-or-n-p (format "%s has updated contents as of %s, update it? " + file-name date))))) + (gnus-cloud-replace-file file-name date contents)))) + (gnus-message 2 "%s isn't covered by the cloud; ignoring" file-name)))) (defun gnus-cloud-replace-file (file-name date new-contents) (mm-with-unibyte-buffer @@ -172,25 +279,19 @@ (write-region (point-min) (point-max) file-name) (set-file-times file-name (parse-iso8601-time-string date)))) -(defun gnus-cloud-delete-file (file-name) - (unless (gnus-cloud-file-covered-p file-name) - (message "%s isn't covered by the cloud; ignoring" file-name)) - (when (file-exists-p file-name) - (rename-file file-name (car (find-backup-file-name file-name))))) - (defun gnus-cloud-file-covered-p (file-name) (let ((matched nil)) (dolist (elem gnus-cloud-synced-files) (cond ((stringp elem) - (when (equal elem file-name) - (setq matched t))) + (when (equal elem file-name) + (setq matched t))) ((consp elem) - (when (and (equal (directory-file-name (plist-get elem :directory)) - (directory-file-name (file-name-directory file-name))) - (string-match (plist-get elem :match) - (file-name-nondirectory file-name))) - (setq matched t))))) + (when (and (equal (directory-file-name (plist-get elem :directory)) + (directory-file-name (file-name-directory file-name))) + (string-match (plist-get elem :match) + (file-name-nondirectory file-name))) + (setq matched t))))) matched)) (defun gnus-cloud-all-files () @@ -198,106 +299,126 @@ (dolist (elem gnus-cloud-synced-files) (cond ((stringp elem) - (push elem files)) + (push elem files)) ((consp elem) - (dolist (file (directory-files (plist-get elem :directory) - nil - (plist-get elem :match))) - (push (format "%s/%s" - (directory-file-name (plist-get elem :directory)) - file) - files))))) + (dolist (file (directory-files (plist-get elem :directory) + nil + (plist-get elem :match))) + (push (format "%s/%s" + (directory-file-name (plist-get elem :directory)) + file) + files))))) (nreverse files))) (defvar gnus-cloud-file-timestamps nil) (defun gnus-cloud-files-to-upload (&optional full) (let ((files nil) - timestamp) + timestamp) (dolist (file (gnus-cloud-all-files)) (if (file-exists-p file) - (when (setq timestamp (gnus-cloud-file-new-p file full)) - (push `(:type :file :file-name ,file :timestamp ,timestamp) files)) - (when (assoc file gnus-cloud-file-timestamps) - (push `(:type :delete :file-name ,file) files)))) + (when (setq timestamp (gnus-cloud-file-new-p file full)) + (push `(:type :file :file-name ,file :timestamp ,timestamp) files)) + (when (assoc file gnus-cloud-file-timestamps) + (push `(:type :delete :file-name ,file) files)))) (nreverse files))) +(defun gnus-cloud-timestamp (time) + "Return a general timestamp string for TIME." + (format-time-string "%FT%T%z" time)) + (defun gnus-cloud-file-new-p (file full) - (let ((timestamp (format-time-string - "%FT%T%z" (nth 5 (file-attributes file)))) - (old (cadr (assoc file gnus-cloud-file-timestamps)))) + (let ((timestamp (gnus-cloud-timestamp (nth 5 (file-attributes file)))) + (old (cadr (assoc file gnus-cloud-file-timestamps)))) (when (or full - (null old) - (string< old timestamp)) + (null old) + (string< old timestamp)) timestamp))) (declare-function gnus-activate-group "gnus-start" - (group &optional scan dont-check method dont-sub-check)) + (group &optional scan dont-check method dont-sub-check)) (declare-function gnus-subscribe-group "gnus-start" - (group &optional previous method)) + (group &optional previous method)) (defun gnus-cloud-ensure-cloud-group () (let ((method (if (stringp gnus-cloud-method) - (gnus-server-to-method gnus-cloud-method) - gnus-cloud-method))) + (gnus-server-to-method gnus-cloud-method) + gnus-cloud-method))) (unless (or (gnus-active gnus-cloud-group-name) - (gnus-activate-group gnus-cloud-group-name nil nil - gnus-cloud-method)) + (gnus-activate-group gnus-cloud-group-name nil nil + gnus-cloud-method)) (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method) - (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) - (gnus-subscribe-group gnus-cloud-group-name))))) + (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) + (gnus-subscribe-group gnus-cloud-group-name))))) + +(defun gnus-cloud-upload-all-data () + "Upload all data (newsrc and files) to the Gnus Cloud." + (interactive) + (gnus-cloud-upload-data t)) (defun gnus-cloud-upload-data (&optional full) + "Upload data (newsrc and files) to the Gnus Cloud. +When FULL is t, upload everything, not just a difference from the last full." + (interactive) (gnus-cloud-ensure-cloud-group) (with-temp-buffer - (let ((elems (gnus-cloud-files-to-upload full))) - (insert (format "Subject: (sequence: %d type: %s)\n" - gnus-cloud-sequence - (if full :full :partial))) - (insert "From: nobody@invalid.com\n") + (let ((elems (append + (gnus-cloud-files-to-upload full) + (gnus-cloud-collect-full-newsrc))) + (group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))) + (insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n" + (or gnus-cloud-sequence "UNKNOWN") + (if full :full :partial) + gnus-cloud-storage-method)) + (insert "From: nobody@gnus.cloud.invalid\n") (insert "\n") (insert (gnus-cloud-make-chunk elems)) - (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method - t t) - (setq gnus-cloud-sequence (1+ gnus-cloud-sequence)) - (gnus-cloud-add-timestamps elems))))) + (if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method + t t) + (progn + (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0))) + (gnus-cloud-add-timestamps elems) + (gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" group) + (gnus-group-refresh-group group)) + (gnus-error 2 "Failed to upload Gnus Cloud data to %s" group))))) (defun gnus-cloud-add-timestamps (elems) (dolist (elem elems) (let* ((file-name (plist-get elem :file-name)) - (old (assoc file-name gnus-cloud-file-timestamps))) + (old (assoc file-name gnus-cloud-file-timestamps))) (when old - (setq gnus-cloud-file-timestamps - (delq old gnus-cloud-file-timestamps))) + (setq gnus-cloud-file-timestamps + (delq old gnus-cloud-file-timestamps))) (push (list file-name (plist-get elem :timestamp)) - gnus-cloud-file-timestamps)))) + gnus-cloud-file-timestamps)))) (defun gnus-cloud-available-chunks () (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) - (active (gnus-active group)) - headers head) + (active (gnus-active group)) + headers head) (when (gnus-retrieve-headers (gnus-uncompress-range active) group) (with-current-buffer nntp-server-buffer - (goto-char (point-min)) - (while (and (not (eobp)) - (setq head (nnheader-parse-head))) - (push head headers)))) + (goto-char (point-min)) + (while (and (not (eobp)) + (setq head (nnheader-parse-head))) + (push head headers)))) (sort (nreverse headers) - (lambda (h1 h2) - (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) - (gnus-cloud-chunk-sequence (mail-header-subject h2))))))) + (lambda (h1 h2) + (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) + (gnus-cloud-chunk-sequence (mail-header-subject h2))))))) (defun gnus-cloud-chunk-sequence (string) (if (string-match "sequence: \\([0-9]+\\)" string) (string-to-number (match-string 1 string)) 0)) +;; TODO: use this (defun gnus-cloud-prune-old-chunks (headers) (let ((headers (reverse headers)) - (found nil)) + (found nil)) (while (and headers - (not found)) + (not found)) (when (string-match "type: :full" (mail-header-subject (car headers))) (setq found t)) (pop headers)) @@ -306,37 +427,68 @@ (when headers (gnus-request-expire-articles (mapcar (lambda (h) - (mail-header-number h)) - (nreverse headers)) + (mail-header-number h)) + (nreverse headers)) (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))))) -(defun gnus-cloud-download-data () +(defun gnus-cloud-download-all-data () + "Download the Gnus Cloud data and install it. +Starts at `gnus-cloud-sequence' in the sequence." + (interactive) + (gnus-cloud-download-data t)) + +(defun gnus-cloud-download-data (&optional update sequence-override) + "Download the Gnus Cloud data and install it if UPDATE is t. +When SEQUENCE-OVERRIDE is given, start at that sequence number +instead of `gnus-cloud-sequence'. + +When UPDATE is t, returns the result of calling `gnus-cloud-update-all'. +Otherwise, returns the Gnus Cloud data chunks." (let ((articles nil) - chunks) + chunks) (dolist (header (gnus-cloud-available-chunks)) (when (> (gnus-cloud-chunk-sequence (mail-header-subject header)) - gnus-cloud-sequence) - (push (mail-header-number header) articles))) + (or sequence-override gnus-cloud-sequence -1)) + + (if (string-match (format "storage-method: %s" gnus-cloud-storage-method) + (mail-header-subject header)) + (push (mail-header-number header) articles) + (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s" + (mail-header-number header) + gnus-cloud-storage-method + (mail-header-subject header))))) (when articles (nnimap-request-articles (nreverse articles) gnus-cloud-group-name) (with-current-buffer nntp-server-buffer - (goto-char (point-min)) - (while (re-search-forward "^Version " nil t) - (beginning-of-line) - (push (gnus-cloud-parse-chunk) chunks) - (forward-line 1)))))) + (goto-char (point-min)) + (while (re-search-forward "^Gnus-Cloud-Version " nil t) + (beginning-of-line) + (push (gnus-cloud-parse-chunk) chunks) + (forward-line 1)))) + (if update + (mapcar #'gnus-cloud-update-all chunks) + chunks))) (defun gnus-cloud-server-p (server) (member server gnus-cloud-covered-servers)) +(defun gnus-cloud-host-server-p (server) + (equal gnus-cloud-method server)) + +(defun gnus-cloud-host-acceptable-method-p (server) + (eq (car-safe (gnus-server-to-method server)) 'nnimap)) + (defun gnus-cloud-collect-full-newsrc () + "Collect all the Gnus newsrc data in a portable format." (let ((infos nil)) (dolist (info (cdr gnus-newsrc-alist)) (when (gnus-cloud-server-p - (gnus-method-to-server - (gnus-find-method-for-group (gnus-info-group info)))) - (push info infos))) - )) + (gnus-method-to-server + (gnus-find-method-for-group (gnus-info-group info)))) + + (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp (current-time))) + infos))) + infos)) (provide 'gnus-cloud) diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 2f387fc336b..37e8cdc7ecd 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -53,12 +53,12 @@ :group 'gnus-delay) (defcustom gnus-delay-default-delay "3d" - "*Default length of delay." + "Default length of delay." :type 'string :group 'gnus-delay) (defcustom gnus-delay-default-hour 8 - "*If deadline is given as date, then assume this time of day." + "If deadline is given as date, then assume this time of day." :version "22.1" :type 'integer :group 'gnus-delay) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index af278b4427d..4dc4f7a022b 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -50,19 +50,19 @@ :group 'gnus) (defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" - "*Summary line format for nndiary groups." + "Summary line format for nndiary groups." :type 'string :group 'gnus-diary :group 'gnus-summary-format) (defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M" - "*Time format to display appointments in nndiary summary buffers. + "Time format to display appointments in nndiary summary buffers. Please refer to `format-time-string' for information on possible values." :type 'string :group 'gnus-diary) (defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english - "*Function called to format a diary delay string. + "Function called to format a diary delay string. It is passed two arguments. The first one is non-nil if the delay is in the past. The second one is of the form ((NUM . UNIT) ...) where NUM is an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute. @@ -161,7 +161,7 @@ There are currently two built-in format functions: (sched (gnus-diary-header-schedule extras)) (occur (nndiary-next-occurence sched (current-time))) (now (current-time)) - (real-time (subtract-time occur now))) + (real-time (time-subtract occur now))) (if (null real-time) "?????" (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time))) diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index bc11ba18519..4492c9aa635 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -39,19 +39,19 @@ :group 'gnus) (defcustom gnus-save-duplicate-list nil - "*If non-nil, save the duplicate list when shutting down Gnus. + "If non-nil, save the duplicate list when shutting down Gnus. If nil, duplicate suppression will only work on duplicates seen in the same session." :group 'gnus-duplicate :type 'boolean) (defcustom gnus-duplicate-list-length 10000 - "*The number of Message-IDs to keep in the duplicate suppression list." + "The number of Message-IDs to keep in the duplicate suppression list." :group 'gnus-duplicate :type 'integer) (defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression") - "*The name of the file to store the duplicate suppression list." + "The name of the file to store the duplicate suppression list." :group 'gnus-duplicate :type 'file) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index c1dd333ee50..0ffd243de0e 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -34,7 +34,7 @@ (defvar gnus-face-properties-alist) (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory) - "*Directory where X-Face PBM files are stored." + "Directory where X-Face PBM files are stored." :version "22.1" :group 'gnus-fun :type 'directory) @@ -46,7 +46,7 @@ :type '(choice (const nil) string)) (defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) - "*Directory where Face PNG files are stored." + "Directory where Face PNG files are stored." :version "25.1" :group 'gnus-fun :type 'directory) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 3de26094572..828805384ca 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -51,13 +51,16 @@ (autoload 'gnus-group-make-nnir-group "nnir") +(autoload 'gnus-cloud-upload-all-data "gnus-cloud") +(autoload 'gnus-cloud-download-all-data "gnus-cloud") + (defcustom gnus-no-groups-message "No news is good news" - "*Message displayed by Gnus when no groups are available." + "Message displayed by Gnus when no groups are available." :group 'gnus-start :type 'string) (defcustom gnus-keep-same-level nil - "*Non-nil means that the next newsgroup after the current will be on the same level. + "Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group @@ -74,19 +77,19 @@ with the best level." (sexp :tag "other" t))) (defcustom gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group." + "If non-nil, movement commands will go to the next unread and subscribed group." :link '(custom-manual "(gnus)Group Maneuvering") :group 'gnus-group-various :type 'boolean) (defcustom gnus-goto-next-group-when-activating t - "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group." + "If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group." :link '(custom-manual "(gnus)Scanning New Messages") :group 'gnus-group-various :type 'boolean) (defcustom gnus-permanently-visible-groups nil - "*Regexp to match groups that should always be listed in the group buffer. + "Regexp to match groups that should always be listed in the group buffer. This means that they will still be listed even when there are no unread articles in the groups. @@ -107,7 +110,7 @@ effective only when emacs-w3m renders html articles, i.e., in the case (const nil))) (defcustom gnus-list-groups-with-ticked-articles t - "*If non-nil, list groups that have only ticked articles. + "If non-nil, list groups that have only ticked articles. If nil, only list groups that have unread articles." :group 'gnus-group-listing :type 'boolean) @@ -120,13 +123,13 @@ Ignored if `gnus-group-use-permanent-levels' is non-nil." (function :tag "Function returning level"))) (defcustom gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed." + "If non-nil, inactive groups will be listed." :group 'gnus-group-listing :group 'gnus-group-levels :type 'boolean) (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet - "*Function used for sorting the group buffer. + "Function used for sorting the group buffer. This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', @@ -155,7 +158,7 @@ list." (function :tag "other" nil)))) (defcustom gnus-group-line-format "%M\ %S\ %p\ %P\ %5y:%B%(%g%)\n" - "*Format of group lines. + "Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -213,7 +216,7 @@ See Info node `(gnus)Formatting Variables'." :type 'string) (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\ %:%S}" - "*The format specification for the group mode line. + "The format specification for the group mode line. It works along the same lines as a normal formatting string, with some simple extensions: @@ -240,7 +243,7 @@ with some simple extensions: :type 'hook) (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat - "*A function that is called to generate the group buffer. + "A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, if the second is non-nil, empty groups should also be displayed. If @@ -297,7 +300,7 @@ If you want to modify the group buffer, you can use this hook." (unless file (error "Couldn't find doc group")) file)))))) - "*Alist of useful group-server pairs." + "Alist of useful group-server pairs." :group 'gnus-group-listing :type '(repeat (list (string :tag "Description") (string :tag "Name") @@ -350,7 +353,7 @@ If you want to modify the group buffer, you can use this hook." gnus-group-news-low-empty) (t . gnus-group-news-low)) - "*Controls the highlighting of group buffer lines. + "Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a particular group line should be displayed, each form is @@ -385,7 +388,7 @@ ticked: The number of ticked articles." (defcustom gnus-group-icon-list nil - "*Controls the insertion of icons into group buffer lines. + "Controls the insertion of icons into group buffer lines. Below is a list of `Form'/`File' pairs. When deciding how a particular group line should be displayed, each form is evaluated. @@ -448,10 +451,12 @@ used when no prefix argument is given to `gnus-group-jump-to-group'." (repeat (cons (integer :tag "Argument") (string :tag "Prompt string"))))) -(defvar gnus-group-listing-limit 1000 - "*A limit of the number of groups when listing. +(defcustom gnus-group-listing-limit 1000 + "A limit of the number of groups when listing. If the number of groups is larger than the limit, list them in a -simple manner.") +simple manner." + :group 'gnus-group-listing + :type 'integer) ;;; Internal variables @@ -634,6 +639,12 @@ simple manner.") "#" gnus-group-mark-group "\M-#" gnus-group-unmark-group) +(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map) + "u" gnus-cloud-upload-all-data + "~" gnus-cloud-upload-all-data + "d" gnus-cloud-download-all-data + "\r" gnus-cloud-download-all-data) + (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) "m" gnus-group-mark-group "u" gnus-group-unmark-group @@ -4530,7 +4541,7 @@ or `gnus-group-catchup-group-hook'." "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." (let* ((time (or (gnus-group-timestamp group) (list 0 0))) - (delta (subtract-time (current-time) time))) + (delta (time-subtract (current-time) time))) (+ (* (nth 0 delta) 65536.0) (nth 1 delta)))) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 059a5cdf27d..e65d46b733d 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -37,13 +37,13 @@ :type 'hook) (defcustom gnus-kill-expiry-days 7 - "*Number of days before expiring unused kill file entries." + "Number of days before expiring unused kill file entries." :group 'gnus-score-kill :group 'gnus-score-expire :type 'integer) (defcustom gnus-kill-save-kill-file nil - "*If non-nil, will save kill files after processing them." + "If non-nil, will save kill files after processing them." :group 'gnus-score-kill :type 'boolean) @@ -52,7 +52,7 @@ I don't know, Per.") (defcustom gnus-kill-killed t - "*If non-nil, Gnus will apply kill files to already killed articles. + "If non-nil, Gnus will apply kill files to already killed articles. If it is nil, Gnus will never apply kill files to articles that have already been through the scoring process, which might very well save lots of time." @@ -118,7 +118,7 @@ the header field or an empty string. If FIELD is an empty string, the entire article body is searched for. REGEXP is a string which is compared with FIELD value. COMMAND is a string representing a valid key sequence in Summary mode or Lisp expression. COMMAND defaults to -'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is +\(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is executed in the Summary buffer. If the second optional argument ALL is non-nil, the COMMAND is applied to articles which are already marked as read or unread. Articles which are marked are skipped over diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index f01811b1ac6..b33402f2ad7 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -40,6 +40,13 @@ (defvar mh-lib-progs) +(defcustom gnus-rcvstore-options nil + "Options that are passed to rcvstore, or nil. +These are used when saving articles to an MH folder." + :version "26.1" + :group 'gnus-article + :type '(repeat string)) + (defun gnus-summary-save-article-folder (&optional arg) "Append the current article to an mh folder. If N is a positive number, save the N next articles. @@ -77,8 +84,10 @@ Optional argument FOLDER specifies folder name." (save-restriction (widen) (unwind-protect - (call-process-region - (point-min) (point-max) "rcvstore" nil errbuf nil folder) + (apply + #'call-process-region + (point-min) (point-max) "rcvstore" nil errbuf nil folder + gnus-rcvstore-options) (set-buffer errbuf) (if (zerop (buffer-size)) (message "Article saved in folder: %s" folder) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 8cabe01168b..10927cd5260 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -33,7 +33,7 @@ (require 'gnus-util) (defcustom gnus-post-method 'current - "*Preferred method for posting USENET news. + "Preferred method for posting USENET news. If this variable is `current' (which is the default), Gnus will use the \"current\" select method when posting. If it is `native', Gnus @@ -71,7 +71,7 @@ of names)." (make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1") (defcustom gnus-mailing-list-groups nil - "*If non-nil a regexp matching groups that are really mailing lists. + "If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been gatewayed to a newsgroup, and you want to followup to an article in the group." @@ -80,7 +80,7 @@ the group." (const nil))) (defcustom gnus-add-to-list nil - "*If non-nil, add a `to-list' parameter automatically." + "If non-nil, add a `to-list' parameter automatically." :group 'gnus-message :type 'boolean) @@ -111,12 +111,12 @@ the second with the current group name." :type 'hook) (defcustom gnus-bug-create-help-buffer t - "*Should we create the *Gnus Help Bug* buffer?" + "Should we create the *Gnus Help Bug* buffer?" :group 'gnus-message :type 'boolean) (defcustom gnus-posting-styles nil - "*Alist of styles to use when posting. + "Alist of styles to use when posting. See Info node `(gnus)Posting Styles'." :group 'gnus-message :link '(custom-manual "(gnus)Posting Styles") diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 1b0acd24030..8b2088be06e 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -45,17 +45,17 @@ ;;; User variables: (defcustom gnus-picon-news-directories '("news") - "*List of directories to search for newsgroups faces." + "List of directories to search for newsgroups faces." :type '(repeat string) :group 'gnus-picon) (defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc") - "*List of directories to search for user faces." + "List of directories to search for user faces." :type '(repeat string) :group 'gnus-picon) (defcustom gnus-picon-domain-directories '("domains") - "*List of directories to search for domain faces. + "List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) :group 'gnus-picon) @@ -67,7 +67,7 @@ Some people may want to add \"unknown\" to this list." (when (gnus-image-type-available-p 'xpm) (push "xpm" types)) types) - "*List of suffixes on picon file names to try." + "List of suffixes on picon file names to try." :type '(repeat string) :group 'gnus-picon) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index c636c7eb32b..37d5b5b91ad 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -826,8 +826,7 @@ Addresses without a name will say \"noname\"." (defun gnus-registry-sort-addresses (&rest addresses) "Return a normalized and sorted list of ADDRESSES." - (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses)) - 'string-lessp)) + (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp)) (defun gnus-registry-simplify-subject (subject) (if (stringp subject) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index fc85bd69baf..2c3aff54898 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -35,7 +35,7 @@ ;;; (defcustom gnus-pick-display-summary nil - "*Display summary while reading." + "Display summary while reading." :type 'boolean :group 'gnus-summary-pick) @@ -45,7 +45,7 @@ :group 'gnus-summary-pick) (defcustom gnus-mark-unpicked-articles-as-read nil - "*If non-nil, mark all unpicked articles as read." + "If non-nil, mark all unpicked articles as read." :type 'boolean :group 'gnus-summary-pick) @@ -57,7 +57,7 @@ (defcustom gnus-summary-pick-line-format "%-5P %U\ %R\ %z\ %I\ %(%[%4L: %-23,23n%]%) %s\n" - "*The format specification of the lines in pick buffers. + "The format specification of the lines in pick buffers. It accepts the same format specs that `gnus-summary-line-format' does." :type 'string :group 'gnus-summary-pick) @@ -373,7 +373,7 @@ lines." :group 'gnus-summary-tree) (defcustom gnus-selected-tree-face 'mode-line - "*Face used for highlighting selected articles in the thread tree." + "Face used for highlighting selected articles in the thread tree." :type 'face :group 'gnus-summary-tree) @@ -385,12 +385,12 @@ lines." "Characters used to connect parents with children.") (defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line." + "The format specification for the tree mode line." :type 'string :group 'gnus-summary-tree) (defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree - "*Function for generating a thread tree. + "Function for generating a thread tree. Two predefined functions are available: `gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." :type '(radio (function-item gnus-generate-vertical-tree) @@ -399,7 +399,7 @@ Two predefined functions are available: :group 'gnus-summary-tree) (defcustom gnus-tree-mode-hook nil - "*Hook run in tree mode buffers." + "Hook run in tree mode buffers." :type 'hook :group 'gnus-summary-tree) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 14059ac566b..b7360a0f22c 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -47,7 +47,7 @@ Say you want to use the single score file score files in the \"/ftp.some-where:/pub/score\" directory. (setq gnus-global-score-files - '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" + \\='(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" \"/ftp.some-where:/pub/score\"))" :group 'gnus-score-files :type '(repeat file)) @@ -127,26 +127,26 @@ the `a' symbolic prefix to the score commands will always use (function :tag "Other" :value 'ignore))) (defcustom gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default." + "Scoring commands will raise/lower the score with this number as the default." :group 'gnus-score-default :type 'integer) (defcustom gnus-score-expiry-days 7 - "*Number of days before unused score file entries are expired. + "Number of days before unused score file entries are expired. If this variable is nil, no score file entries will be expired." :group 'gnus-score-expire :type '(choice (const :tag "never" nil) number)) (defcustom gnus-update-score-entry-dates t - "*If non-nil, update matching score entry dates. + "If non-nil, update matching score entry dates. If this variable is nil, then score entries that provide matches will be expired along with non-matching score entries." :group 'gnus-score-expire :type 'boolean) (defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores. + "If non-nil, decay non-permanent scores. If it is a regexp, only decay score files matching regexp." :group 'gnus-score-decay @@ -157,19 +157,19 @@ If it is a regexp, only decay score files matching regexp." (regexp))) (defcustom gnus-decay-score-function 'gnus-decay-score - "*Function called to decay a score. + "Function called to decay a score. It is called with one parameter -- the score to be decayed." :group 'gnus-score-decay :type '(radio (function-item gnus-decay-score) (function :tag "Other"))) (defcustom gnus-score-decay-constant 3 - "*Decay all \"small\" scores with this amount." + "Decay all \"small\" scores with this amount." :group 'gnus-score-decay :type 'integer) (defcustom gnus-score-decay-scale .05 - "*Decay all \"big\" scores with this factor." + "Decay all \"big\" scores with this factor." :group 'gnus-score-decay :type 'number) @@ -249,7 +249,7 @@ If you use score decays, you might want to set values higher than (integer :tag "Score")))))) (defcustom gnus-adaptive-word-length-limit nil - "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." + "Words of a length lesser than this limit will be ignored when doing adaptive scoring." :version "22.1" :group 'gnus-score-adapt :type '(radio (const :format "Unlimited " nil) @@ -275,7 +275,7 @@ If you use score decays, you might want to set values higher than "being" "current" "back" "still" "go" "point" "value" "each" "did" "both" "true" "off" "say" "another" "state" "might" "under" "start" "try" "re") - "*Default list of words to be ignored when doing adaptive word scoring." + "Default list of words to be ignored when doing adaptive word scoring." :group 'gnus-score-adapt :type '(repeat string)) @@ -284,7 +284,7 @@ If you use score decays, you might want to set values higher than (,gnus-catchup-mark . -10) (,gnus-killed-mark . -20) (,gnus-del-mark . -15)) - "*Alist of marks and scores." + "Alist of marks and scores." :group 'gnus-score-adapt :type '(repeat (cons (character :tag "Mark") (integer :tag "Score")))) @@ -300,12 +300,12 @@ If you use score decays, you might want to set values higher than :type 'boolean) (defcustom gnus-score-mimic-keymap nil - "*Have the score entry functions pretend that they are a keymap." + "Have the score entry functions pretend that they are a keymap." :group 'gnus-score-default :type 'boolean) (defcustom gnus-score-exact-adapt-limit 10 - "*Number that says how long a match has to be before using substring matching. + "Number that says how long a match has to be before using substring matching. When doing adaptive scoring, one normally uses fuzzy or substring matching. However, if the header one matches is short, the possibility for false positives is great, so if the length of the match is less diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 30c7debc8e5..6dbb54efb4a 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -32,6 +32,7 @@ (require 'gnus-group) (require 'gnus-int) (require 'gnus-range) +(require 'gnus-cloud) (autoload 'gnus-group-make-nnir-group "nnir") @@ -109,8 +110,10 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-mode-map) -(defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") +(defcustom gnus-server-menu-hook nil + "Hook run after the creation of the server mode menu." + :type 'hook + :group 'gnus-server) (defun gnus-server-make-menu-bar () (gnus-turn-off-edit-menu 'server) @@ -138,7 +141,8 @@ If nil, a faster, but more primitive, buffer is used instead." ["Close" gnus-server-close-server t] ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] - ["Toggle Cloud" gnus-server-toggle-cloud-server t] + ["Toggle Cloud Sync for this server" gnus-server-toggle-cloud-server t] + ["Toggle Cloud Sync Host" gnus-server-toggle-cloud-method-server t] "---" ["Open All" gnus-server-open-all-servers t] ["Close All" gnus-server-close-all-servers t] @@ -185,6 +189,7 @@ If nil, a faster, but more primitive, buffer is used instead." "z" gnus-server-compact-server "i" gnus-server-toggle-cloud-server + "I" gnus-server-toggle-cloud-method-server "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) @@ -203,7 +208,14 @@ If nil, a faster, but more primitive, buffer is used instead." '((((class color) (background light)) (:foreground "ForestGreen" :bold t)) (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) (t (:bold t))) - "Face used for displaying AGENTIZED servers" + "Face used for displaying Cloud-synced servers" + :group 'gnus-server-visual) + +(defface gnus-server-cloud-host + '((((class color) (background light)) (:foreground "ForestGreen" :inverse-video t :italic t)) + (((class color) (background dark)) (:foreground "PaleGreen" :inverse-video t :italic t)) + (t (:inverse-video t :italic t))) + "Face used for displaying the Cloud Host" :group 'gnus-server-visual) (defface gnus-server-opened @@ -249,7 +261,8 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-font-lock-keywords '(("(\\(agent\\))" 1 'gnus-server-agent) - ("(\\(cloud\\))" 1 'gnus-server-cloud) + ("(\\(cloud[-]sync\\))" 1 'gnus-server-cloud) + ("(\\(CLOUD[-]HOST\\))" 1 'gnus-server-cloud-host) ("(\\(opened\\))" 1 'gnus-server-opened) ("(\\(closed\\))" 1 'gnus-server-closed) ("(\\(offline\\))" 1 'gnus-server-offline) @@ -304,9 +317,13 @@ The following commands are available: (gnus-agent-method-p method)) " (agent)" "")) - (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name) - " (cloud)" - ""))) + (gnus-tmp-cloud (concat + (if (gnus-cloud-host-server-p gnus-tmp-name) + " (CLOUD-HOST)" + "") + (if (gnus-cloud-server-p gnus-tmp-name) + " (cloud-sync)" + "")))) (beginning-of-line) (add-text-properties (point) @@ -684,8 +701,10 @@ The following commands are available: ;;; Browse Server Mode ;;; -(defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") +(defcustom gnus-browse-menu-hook nil + "Hook run after the creation of the browse mode menu." + :group 'gnus-server + :type 'hook) (defcustom gnus-browse-subscribe-newsgroup-method 'gnus-subscribe-alphabetically @@ -1128,6 +1147,25 @@ Requesting compaction of %s... (this may take a long time)" "Replication of %s in the cloud will stop") server))) +(defun gnus-server-toggle-cloud-method-server () + "Set the server under point to host the Emacs Cloud." + (interactive) + (let ((server (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + (unless (gnus-cloud-host-acceptable-method-p server) + (error "The server under point can't host the Emacs Cloud")) + + (when (not (string-equal gnus-cloud-method server)) + (custom-set-variables '(gnus-cloud-method server)) + ;; Note we can't use `Custom-save' here. + (when (gnus-yes-or-no-p + (format "The new cloud host server is %S now. Save it? " server)) + (customize-save-variable 'gnus-cloud-method server))) + (when (gnus-yes-or-no-p (format "Upload Cloud data to %S now? " server)) + (gnus-message 1 "Uploading all data to Emacs Cloud server %S" server) + (gnus-cloud-upload-data t)))) + (provide 'gnus-srvr) ;;; gnus-srvr.el ends here diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index a57797260ad..10e4dbcc77e 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -87,21 +87,21 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead." :type '(choice file (const nil))) (defcustom gnus-use-dribble-file t - "*Non-nil means that Gnus will use a dribble file to store user updates. + "Non-nil means that Gnus will use a dribble file to store user updates. If Emacs should crash without saving the .newsrc files, complete information can be restored from the dribble file." :group 'gnus-dribble-file :type 'boolean) (defcustom gnus-dribble-directory nil - "*The directory where dribble files will be saved. + "The directory where dribble files will be saved. If this variable is nil, the directory where the .newsrc files are saved will be used." :group 'gnus-dribble-file :type '(choice directory (const nil))) (defcustom gnus-check-new-newsgroups 'ask-server - "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup. + "Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup. This normally finds new newsgroups by comparing the active groups the servers have already reported with those Gnus already knows, either alive or killed. @@ -138,14 +138,14 @@ check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups (sexp :format "%v")))) (defcustom gnus-check-bogus-newsgroups nil - "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. + "Non-nil means that Gnus will check and remove bogus newsgroup at startup. If this variable is nil, then you have to tell Gnus explicitly to check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]." :group 'gnus-start-server :type 'boolean) (defcustom gnus-read-active-file 'some - "*Non-nil means that Gnus will read the entire active file at startup. + "Non-nil means that Gnus will read the entire active file at startup. If this variable is nil, Gnus will only know about the groups in your `.newsrc' file. @@ -183,24 +183,24 @@ Levels' for details.") "Groups with this level are killed.") (defcustom gnus-level-default-subscribed 3 - "*New subscribed groups will be subscribed at this level." + "New subscribed groups will be subscribed at this level." :group 'gnus-group-levels :type 'integer) (defcustom gnus-level-default-unsubscribed 6 - "*New unsubscribed groups will be unsubscribed at this level." + "New unsubscribed groups will be unsubscribed at this level." :group 'gnus-group-levels :type 'integer) (defcustom gnus-activate-level (1+ gnus-level-subscribed) - "*Groups higher than this level won't be activated on startup. + "Groups higher than this level won't be activated on startup. Setting this variable to something low might save lots of time when you have many groups that you aren't interested in." :group 'gnus-group-levels :type 'integer) (defcustom gnus-activate-foreign-newsgroups 4 - "*If nil, Gnus will not check foreign newsgroups at startup. + "If nil, Gnus will not check foreign newsgroups at startup. If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be activated on startup. For instance, if you want to active all @@ -216,7 +216,7 @@ groups." (const :tag "none" nil))) (defcustom gnus-read-newsrc-file t - "*Non-nil means that Gnus will read the `.newsrc' file. + "Non-nil means that Gnus will read the `.newsrc' file. Gnus always reads its own startup file, which is called \".newsrc.eld\". The file called \".newsrc\" is in a format that can be readily understood by other newsreaders. If you don't plan on @@ -227,7 +227,7 @@ entry." :type 'boolean) (defcustom gnus-save-newsrc-file t - "*Non-nil means that Gnus will save the `.newsrc' file. + "Non-nil means that Gnus will save the `.newsrc' file. Gnus always saves its own startup file, which is called \".newsrc.eld\". The file called \".newsrc\" is in a format that can be readily understood by other newsreaders. If you don't plan on @@ -237,7 +237,7 @@ exit." :type 'boolean) (defcustom gnus-save-killed-list t - "*If non-nil, save the list of killed groups to the startup file. + "If non-nil, save the list of killed groups to the startup file. If you set this variable to nil, you'll save both time (when starting and quitting) and space (both memory and disk), but it will also mean that Gnus has no record of which groups are new and which are old, so @@ -263,7 +263,7 @@ not match this regexp will be removed before saving the list." "^[\"][\"#'()]" ; bogus characters ) "\\|") - "*A regexp to match uninteresting newsgroups in the active file. + "A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, thus making them effectively non-existent." @@ -271,7 +271,7 @@ thus making them effectively non-existent." :type 'regexp) (defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function(s) called with a group name when new group is detected. + "Function(s) called with a group name when new group is detected. A few pre-made functions are supplied: `gnus-subscribe-randomly' inserts new groups at the beginning of the list of groups; `gnus-subscribe-alphabetically' inserts new groups in strict @@ -295,7 +295,7 @@ claim them." (define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks 'gnus-subscribe-newsgroup-functions "24.3") (defcustom gnus-subscribe-newsgroup-functions nil - "*Hooks run after you subscribe to a new group. + "Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." :version "22.1" :group 'gnus-group-new @@ -303,7 +303,7 @@ The hooks will be called with new group's name as argument." (defcustom gnus-subscribe-options-newsgroup-method 'gnus-subscribe-alphabetically - "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines. + "Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines. If, for instance, you want to subscribe to all newsgroups in the \"no\" and \"alt\" hierarchies, you'd put the following in your .newsrc file: @@ -324,7 +324,7 @@ with the subscription method in this variable." (repeat function))) (defcustom gnus-subscribe-hierarchical-interactive nil - "*If non-nil, Gnus will offer to subscribe hierarchically. + "If non-nil, Gnus will offer to subscribe hierarchically. When a new hierarchy appears, Gnus will ask the user: 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): @@ -336,7 +336,7 @@ hierarchy in its entirety." :type 'boolean) (defcustom gnus-auto-subscribed-categories '(mail post-mail) - "*New groups from methods of these categories will be subscribed automatically. + "New groups from methods of these categories will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. The default is to automatically subscribe all groups from mail-like backends." @@ -346,7 +346,7 @@ subscribe all groups from mail-like backends." (defcustom gnus-auto-subscribed-groups "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir\\|^nnimap" - "*All new groups that match this regexp will be subscribed automatically. + "All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. @@ -357,7 +357,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." :type 'regexp) (defcustom gnus-options-subscribe nil - "*All new groups matching this regexp will be subscribed unconditionally. + "All new groups matching this regexp will be subscribed unconditionally. Note that this variable deals only with new newsgroups. This variable does not affect old newsgroups. @@ -369,7 +369,7 @@ be subscribed using `gnus-subscribe-options-newsgroup-method'." (const :tag "none" nil))) (defcustom gnus-options-not-subscribe nil - "*All new groups matching this regexp will be ignored. + "All new groups matching this regexp will be ignored. Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups." :group 'gnus-group-new @@ -377,7 +377,7 @@ does not affect old (already subscribed) newsgroups." (const :tag "none" nil))) (defcustom gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. + "Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc." :group 'gnus-newsrc @@ -432,7 +432,7 @@ See also `gnus-before-startup-hook'." (defcustom gnus-after-getting-new-news-hook '(gnus-display-time-event-handler) - "*A hook run after Gnus checks for new news when Gnus is already running." + "A hook run after Gnus checks for new news when Gnus is already running." :version "24.1" :group 'gnus-group-new :type 'hook) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 6b3add2cddf..b6023c2c931 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -56,7 +56,7 @@ (autoload 'nnir-article-group "nnir" nil nil 'macro) (defcustom gnus-kill-summary-on-exit t - "*If non-nil, kill the summary buffer when you exit from it. + "If non-nil, kill the summary buffer when you exit from it. If nil, the summary will become a \"*Dead Summary*\" buffer, and it will be killed sometime later." :group 'gnus-summary-exit @@ -78,7 +78,7 @@ See `gnus-group-goto-unread'." :type 'boolean) (defcustom gnus-fetch-old-headers nil - "*Non-nil means that Gnus will try to build threads by grabbing old headers. + "Non-nil means that Gnus will try to build threads by grabbing old headers. If an unread article in the group refers to an older, already read (or just marked as read) article, the old article will not normally be displayed in the Summary buffer. If this variable is @@ -105,14 +105,14 @@ leads to very slow summary generation." (sexp :menu-tag "other" t))) (defcustom gnus-refer-thread-limit 500 - "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread]. + "The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread]. If t, fetch all the available old headers." :group 'gnus-thread :type '(choice number (sexp :menu-tag "other" t))) (defcustom gnus-refer-thread-use-nnir nil - "*Use nnir to search an entire server when referring threads. A + "Use nnir to search an entire server when referring threads. A nil value will only search for thread-related articles in the current group." :version "24.1" @@ -120,7 +120,7 @@ current group." :type 'boolean) (defcustom gnus-summary-make-false-root 'adopt - "*nil means that Gnus won't gather loose threads. + "nil means that Gnus won't gather loose threads. If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been lost. Instead of having many small sub-threads from this original thread @@ -155,7 +155,7 @@ given by the `gnus-summary-same-subject' variable.)" :type 'boolean) (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" - "*A regexp to match subjects to be excluded from loose thread gathering. + "A regexp to match subjects to be excluded from loose thread gathering. As loose thread gathering is done on subjects only, that means that there can be many false gatherings performed. By rooting out certain common subjects, gathering might become saner." @@ -163,7 +163,7 @@ common subjects, gathering might become saner." :type 'regexp) (defcustom gnus-summary-gather-subject-limit nil - "*Maximum length of subject comparisons when gathering loose threads. + "Maximum length of subject comparisons when gathering loose threads. Use nil to compare full subjects. Setting this variable to a low number will help gather threads that have been corrupted by newsreaders chopping off subject lines, but it might also mean that @@ -188,13 +188,13 @@ Useful functions to put in this list include: :type '(repeat function)) (defcustom gnus-simplify-ignored-prefixes nil - "*Remove matches for this regexp from subject lines when simplifying fuzzily." + "Remove matches for this regexp from subject lines when simplifying fuzzily." :group 'gnus-thread :type '(choice (const :tag "off" nil) regexp)) (defcustom gnus-build-sparse-threads nil - "*If non-nil, fill in the gaps in threads. + "If non-nil, fill in the gaps in threads. If `some', only fill in the gaps that are needed to tie loose threads together. If `more', fill in all leaf nodes that Gnus can find. If non-nil and non-`some', fill in all gaps that Gnus manages to guess." @@ -206,7 +206,7 @@ non-nil and non-`some', fill in all gaps that Gnus manages to guess." (defcustom gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject - "*Function used for gathering loose threads. + "Function used for gathering loose threads. There are two pre-defined functions: `gnus-gather-threads-by-subject', which only takes Subjects into consideration; and `gnus-gather-threads-by-references', which compared the References @@ -217,14 +217,14 @@ headers of the articles to find matches." (function :tag "other"))) (defcustom gnus-summary-same-subject "" - "*String indicating that the current article has the same subject as the previous. + "String indicating that the current article has the same subject as the previous. This variable will only be used if the value of `gnus-summary-make-false-root' is `empty'." :group 'gnus-summary-format :type 'string) (defcustom gnus-summary-goto-unread nil - "*If t, many commands will go to the next unread article. + "If t, many commands will go to the next unread article. This applies to marking commands as well as other commands that \"naturally\" select the next article, like, for instance, `SPC' at the end of an article. @@ -241,7 +241,7 @@ whether it is read or not." (sexp :menu-tag "on" t))) (defcustom gnus-summary-default-score 0 - "*Default article score level. + "Default article score level. All scores generated by the score files will be added to this score. If this variable is nil, scoring will be disabled." :group 'gnus-score-default @@ -249,7 +249,7 @@ If this variable is nil, scoring will be disabled." integer)) (defcustom gnus-summary-default-high-score 0 - "*Default threshold for a high scored article. + "Default threshold for a high scored article. An article will be highlighted as high scored if its score is greater than this score." :version "22.1" @@ -257,7 +257,7 @@ than this score." :type 'integer) (defcustom gnus-summary-default-low-score 0 - "*Default threshold for a low scored article. + "Default threshold for a low scored article. An article will be highlighted as low scored if its score is smaller than this score." :version "22.1" @@ -265,14 +265,14 @@ than this score." :type 'integer) (defcustom gnus-summary-zcore-fuzz 0 - "*Fuzziness factor for the zcore in the summary buffer. + "Fuzziness factor for the zcore in the summary buffer. Articles with scores closer than this to `gnus-summary-default-score' will not be marked." :group 'gnus-summary-format :type 'integer) (defcustom gnus-simplify-subject-fuzzy-regexp nil - "*Strings to be removed when doing fuzzy matches. + "Strings to be removed when doing fuzzy matches. This can either be a regular expression or list of regular expressions that will be removed from subject strings if fuzzy subject simplification is selected." @@ -280,12 +280,12 @@ simplification is selected." :type '(repeat regexp)) (defcustom gnus-show-threads t - "*If non-nil, display threads in summary mode." + "If non-nil, display threads in summary mode." :group 'gnus-thread :type 'boolean) (defcustom gnus-thread-hide-subtree nil - "*If non-nil, hide all threads initially. + "If non-nil, hide all threads initially. This can be a predicate specifier which says which threads to hide. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or select an article." @@ -298,19 +298,19 @@ If threads are hidden, you have to run the command (sexp :tag "Predicate specifier"))) (defcustom gnus-thread-hide-killed t - "*If non-nil, hide killed threads automatically." + "If non-nil, hide killed threads automatically." :group 'gnus-thread :type 'boolean) (defcustom gnus-thread-ignore-subject t - "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. + "If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. If nil, articles that have different subjects from their parents will start separate threads." :group 'gnus-thread :type 'boolean) (defcustom gnus-thread-operation-ignore-subject t - "*If non-nil, subjects will be ignored when doing thread commands. + "If non-nil, subjects will be ignored when doing thread commands. This affects commands like `gnus-summary-kill-thread' and `gnus-summary-lower-thread'. @@ -324,12 +324,12 @@ equal will be included." (sexp :tag "on" t))) (defcustom gnus-thread-indent-level 4 - "*Number that says how much each sub-thread should be indented." + "Number that says how much each sub-thread should be indented." :group 'gnus-thread :type 'integer) (defcustom gnus-auto-extend-newsgroup t - "*If non-nil, extend newsgroup forward and backward when requested." + "If non-nil, extend newsgroup forward and backward when requested." :group 'gnus-summary-choose :type 'boolean) @@ -353,7 +353,7 @@ newsgroups, set the variable to nil in `gnus-select-group-hook'." (sexp :menu-tag "first" t))) (defcustom gnus-auto-select-subject 'unseen-or-unread - "*Says what subject to place under point when entering a group. + "Says what subject to place under point when entering a group. This variable can either be the symbols `first' (place point on the first subject), `unread' (place point on the subject line of the first @@ -373,7 +373,7 @@ place point on some subject line." (function :tag "Function to call"))) (defcustom gnus-auto-select-next t - "*If non-nil, offer to go to the next group from the end of the previous. + "If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit summary mode and go back to group mode. If the value is neither nil nor t, Gnus will select the following unread newsgroup. In @@ -391,7 +391,7 @@ will go to the next group without confirmation." (sexp :menu-tag "on" t))) (defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject. + "If non-nil, select the next article with the same subject. If there are no more articles with the same subject, go to the first unread article." :group 'gnus-summary-maneuvering @@ -420,7 +420,7 @@ article selected before entering to the ephemeral group will appear." (sexp :tag "other" :value nil))) (defcustom gnus-auto-goto-ignores 'unfetched - "*Says how to handle unfetched articles when maneuvering. + "Says how to handle unfetched articles when maneuvering. This variable can either be the symbols nil (maneuver to any article), `undownloaded' (maneuvering while unplugged ignores articles @@ -438,7 +438,7 @@ and, when unplugged, a subset of the undownloaded article list." (const :tag "Unfetched" unfetched))) (defcustom gnus-summary-check-current nil - "*If non-nil, consider the current article when moving. + "If non-nil, consider the current article when moving. The \"unread\" movement commands will stay on the same line if the current article is unread." :group 'gnus-summary-maneuvering @@ -446,7 +446,7 @@ current article is unread." (defcustom gnus-auto-center-summary (max (or (bound-and-true-p scroll-margin) 0) 2) - "*If non-nil, always center the current summary buffer. + "If non-nil, always center the current summary buffer. In particular, if `vertical' do only vertical recentering. If non-nil and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-summary-maneuvering @@ -461,18 +461,18 @@ and non-`vertical', do both horizontal and vertical recentering." :type 'boolean) (defcustom gnus-show-all-headers nil - "*If non-nil, don't hide any headers." + "If non-nil, don't hide any headers." :group 'gnus-article-hiding :group 'gnus-article-headers :type 'boolean) (defcustom gnus-summary-ignore-duplicates nil - "*If non-nil, ignore articles with identical Message-ID headers." + "If non-nil, ignore articles with identical Message-ID headers." :group 'gnus-summary :type 'boolean) (defcustom gnus-single-article-buffer nil - "*If non-nil, display all articles in the same buffer. + "If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." :version "24.1" :group 'gnus-article-various @@ -485,14 +485,14 @@ If nil, each group will get its own article buffer." :type 'boolean) (defcustom gnus-break-pages t - "*If non-nil, do page breaking on articles. + "If non-nil, do page breaking on articles. The page delimiter is specified by the `gnus-page-delimiter' variable." :group 'gnus-article-various :type 'boolean) (defcustom gnus-move-split-methods nil - "*Variable used to suggest where articles are to be moved to. + "Variable used to suggest where articles are to be moved to. It uses the same syntax as the `gnus-split-methods' variable. However, whereas `gnus-split-methods' specifies file names as targets, this variable specifies group names." @@ -512,163 +512,163 @@ string with the suggested prefix." ;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs (defcustom gnus-unread-mark ? ;Whitespace - "*Mark used for unread articles." + "Mark used for unread articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-ticked-mark ?! - "*Mark used for ticked articles." + "Mark used for ticked articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-dormant-mark ?? - "*Mark used for dormant articles." + "Mark used for dormant articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-del-mark ?r - "*Mark used for del'd articles." + "Mark used for del'd articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-read-mark ?R - "*Mark used for read articles." + "Mark used for read articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-expirable-mark ?E - "*Mark used for expirable articles." + "Mark used for expirable articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-killed-mark ?K - "*Mark used for killed articles." + "Mark used for killed articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-spam-mark ?$ - "*Mark used for spam articles." + "Mark used for spam articles." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-kill-file-mark ?X - "*Mark used for articles killed by kill files." + "Mark used for articles killed by kill files." :group 'gnus-summary-marks :type 'character) (defcustom gnus-low-score-mark ?Y - "*Mark used for articles with a low score." + "Mark used for articles with a low score." :group 'gnus-summary-marks :type 'character) (defcustom gnus-catchup-mark ?C - "*Mark used for articles that are caught up." + "Mark used for articles that are caught up." :group 'gnus-summary-marks :type 'character) (defcustom gnus-replied-mark ?A - "*Mark used for articles that have been replied to." + "Mark used for articles that have been replied to." :group 'gnus-summary-marks :type 'character) (defcustom gnus-forwarded-mark ?F - "*Mark used for articles that have been forwarded." + "Mark used for articles that have been forwarded." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-recent-mark ?N - "*Mark used for articles that are recent." + "Mark used for articles that are recent." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-cached-mark ?* - "*Mark used for articles that are in the cache." + "Mark used for articles that are in the cache." :group 'gnus-summary-marks :type 'character) (defcustom gnus-saved-mark ?S - "*Mark used for articles that have been saved." + "Mark used for articles that have been saved." :group 'gnus-summary-marks :type 'character) (defcustom gnus-unseen-mark ?. - "*Mark used for articles that haven't been seen." + "Mark used for articles that haven't been seen." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-no-mark ? ;Whitespace - "*Mark used for articles that have no other secondary mark." + "Mark used for articles that have no other secondary mark." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-ancient-mark ?O - "*Mark used for ancient articles." + "Mark used for ancient articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-sparse-mark ?Q - "*Mark used for sparsely reffed articles." + "Mark used for sparsely reffed articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-canceled-mark ?G - "*Mark used for canceled articles." + "Mark used for canceled articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-duplicate-mark ?M - "*Mark used for duplicate articles." + "Mark used for duplicate articles." :group 'gnus-summary-marks :type 'character) (defcustom gnus-undownloaded-mark ?- - "*Mark used for articles that weren't downloaded." + "Mark used for articles that weren't downloaded." :version "22.1" :group 'gnus-summary-marks :type 'character) (defcustom gnus-downloaded-mark ?+ - "*Mark used for articles that were downloaded." + "Mark used for articles that were downloaded." :group 'gnus-summary-marks :type 'character) (defcustom gnus-downloadable-mark ?% - "*Mark used for articles that are to be downloaded." + "Mark used for articles that are to be downloaded." :group 'gnus-summary-marks :type 'character) (defcustom gnus-unsendable-mark ?= - "*Mark used for articles that won't be sent." + "Mark used for articles that won't be sent." :group 'gnus-summary-marks :type 'character) (defcustom gnus-score-over-mark ?+ - "*Score mark used for articles with high scores." + "Score mark used for articles with high scores." :group 'gnus-summary-marks :type 'character) (defcustom gnus-score-below-mark ?- - "*Score mark used for articles with low scores." + "Score mark used for articles with low scores." :group 'gnus-summary-marks :type 'character) (defcustom gnus-empty-thread-mark ? ;Whitespace - "*There is no thread under the article." + "There is no thread under the article." :group 'gnus-summary-marks :type 'character) (defcustom gnus-not-empty-thread-mark ?= - "*There is a thread under the article." + "There is a thread under the article." :group 'gnus-summary-marks :type 'character) (defcustom gnus-view-pseudo-asynchronously nil - "*If non-nil, Gnus will view pseudo-articles asynchronously." + "If non-nil, Gnus will view pseudo-articles asynchronously." :group 'gnus-extract-view :type 'boolean) @@ -676,13 +676,13 @@ string with the suggested prefix." (list gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-duplicate-mark) - "*The list of marks converted into expiration if a group is auto-expirable." + "The list of marks converted into expiration if a group is auto-expirable." :version "24.1" :group 'gnus-summary :type '(repeat character)) (defcustom gnus-inhibit-user-auto-expire t - "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." + "If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." :version "21.1" :group 'gnus-summary :type 'boolean) @@ -699,7 +699,7 @@ which auto-expire is turned on." :group 'gnus-summary-marks) (defcustom gnus-view-pseudos nil - "*If `automatic', pseudo-articles will be viewed automatically. + "If `automatic', pseudo-articles will be viewed automatically. If `not-confirm', pseudos will be viewed automatically, and the user will not be asked to confirm the command." :group 'gnus-extract-view @@ -708,20 +708,20 @@ will not be asked to confirm the command." (const not-confirm))) (defcustom gnus-view-pseudos-separately t - "*If non-nil, one pseudo-article will be created for each file to be viewed. + "If non-nil, one pseudo-article will be created for each file to be viewed. If nil, all files that use the same viewing command will be given as a list of parameters to that command." :group 'gnus-extract-view :type 'boolean) (defcustom gnus-insert-pseudo-articles t - "*If non-nil, insert pseudo-articles when decoding articles." + "If non-nil, insert pseudo-articles when decoding articles." :group 'gnus-extract-view :type 'boolean) (defcustom gnus-summary-dummy-line-format " %(: :%) %S\n" - "*The format specification for the dummy roots in the summary buffer. + "The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. @@ -734,7 +734,7 @@ See `(gnus)Formatting Variables'." :type 'string) (defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" - "*The format specification for the summary mode line. + "The format specification for the summary mode line. It works along the same lines as a normal formatting string, with some simple extensions: @@ -767,7 +767,7 @@ This can also be a list of regexps." (repeat :value (".*") regexp))) (defcustom gnus-summary-mark-below 0 - "*Mark all articles with a score below this variable as read. + "Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the score file." :group 'gnus-score-default @@ -808,7 +808,7 @@ VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom. :value-to-external 'gnus-widget-reversible-to-external) (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) - "*List of functions used for sorting articles in the summary buffer. + "List of functions used for sorting articles in the summary buffer. Each function takes two articles and returns non-nil if the first article should be sorted before the other. If you use more than one @@ -841,7 +841,7 @@ controls how articles are sorted." (boolean :tag "Reverse order")))) (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) - "*List of functions used for sorting threads in the summary buffer. + "List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. Each function takes two threads and returns non-nil if the first @@ -887,7 +887,7 @@ subthreads, customize `gnus-subthread-sort-functions'." (boolean :tag "Reverse order")))) (defcustom gnus-subthread-sort-functions 'gnus-thread-sort-functions - "*List of functions used for sorting subthreads in the summary buffer. + "List of functions used for sorting subthreads in the summary buffer. By default, subthreads are sorted the same as threads, i.e., according to the value of `gnus-thread-sort-functions'." :version "24.4" @@ -910,7 +910,7 @@ according to the value of `gnus-thread-sort-functions'." (boolean :tag "Reverse order"))))) (defcustom gnus-thread-score-function '+ - "*Function used for calculating the total score of a thread. + "Function used for calculating the total score of a thread. The function is called with the scores of the article and each subthread and should then return the score of the thread. @@ -938,43 +938,43 @@ This variable is local to the summary buffers." integer)) (defcustom gnus-summary-mode-hook nil - "*A hook for Gnus summary mode. + "A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer." :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode) :group 'gnus-summary-various :type 'hook) (defcustom gnus-summary-menu-hook nil - "*Hook run after the creation of the summary mode menu." + "Hook run after the creation of the summary mode menu." :group 'gnus-summary-visual :type 'hook) (defcustom gnus-summary-exit-hook nil - "*A hook called on exit from the summary buffer. + "A hook called on exit from the summary buffer. It will be called with point in the group buffer." :group 'gnus-summary-exit :type 'hook) (defcustom gnus-summary-prepare-hook nil - "*A hook called after the summary buffer has been generated. + "A hook called after the summary buffer has been generated. If you want to modify the summary buffer, you can use this hook." :group 'gnus-summary-various :type 'hook) (defcustom gnus-summary-prepared-hook nil - "*A hook called as the last thing after the summary buffer has been generated." + "A hook called as the last thing after the summary buffer has been generated." :group 'gnus-summary-various :type 'hook) (defcustom gnus-summary-generate-hook nil - "*A hook run just before generating the summary buffer. + "A hook run just before generating the summary buffer. This hook is commonly used to customize threading variables and the like." :group 'gnus-summary-various :type 'hook) (defcustom gnus-select-group-hook nil - "*A hook called when a newsgroup is selected. + "A hook called when a newsgroup is selected. If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the @@ -992,32 +992,32 @@ following hook: :type 'hook) (defcustom gnus-select-article-hook nil - "*A hook called when an article is selected." + "A hook called when an article is selected." :group 'gnus-summary-choose :options '(gnus-agent-fetch-selected-article) :type 'hook) (defcustom gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) - "*Hook run after selecting an article in the summary buffer. + "Hook run after selecting an article in the summary buffer. It is meant to be used for highlighting the article in some way. It is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) (defcustom gnus-parse-headers-hook nil - "*A hook called before parsing the headers." + "A hook called before parsing the headers." :group 'gnus-various :type 'hook) (defcustom gnus-exit-group-hook nil - "*A hook called when exiting summary mode. + "A hook called when exiting summary mode. This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) (defcustom gnus-summary-update-hook nil - "*A hook called when a summary line is changed. + "A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. The default function `gnus-summary-highlight-line' will @@ -1027,42 +1027,42 @@ variable." :type 'hook) (defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) - "*A hook called when an article is selected for the first time. + "A hook called when an article is selected for the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected." :group 'gnus-summary-choose :type 'hook) (defcustom gnus-group-no-more-groups-hook nil - "*A hook run when returning to group mode having no more (unread) groups." + "A hook run when returning to group mode having no more (unread) groups." :group 'gnus-group-select :type 'hook) (defcustom gnus-ps-print-hook nil - "*A hook run before ps-printing something from Gnus." + "A hook run before ps-printing something from Gnus." :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-move-hook nil - "*A hook called after an article is moved, copied, respooled, or crossposted." + "A hook called after an article is moved, copied, respooled, or crossposted." :version "22.1" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-delete-hook nil - "*A hook called after an article is deleted." + "A hook called after an article is deleted." :version "22.1" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-expire-hook nil - "*A hook called after an article is expired." + "A hook called after an article is expired." :version "22.1" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-display-arrow (display-graphic-p) - "*If non-nil, display an arrow highlighting the current article." + "If non-nil, display an arrow highlighting the current article." :version "22.1" :group 'gnus-summary :type 'boolean) @@ -1112,7 +1112,7 @@ automatically when it is selected." . gnus-summary-low-read) (t . gnus-summary-normal-read)) - "*Controls the highlighting of summary buffer lines. + "Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a particular summary line should be displayed, each form is evaluated. The content @@ -1148,7 +1148,7 @@ which it may alter in any way." "Function used to decode addresses with encoded words.") (defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) - "*Extra headers to parse." + "Extra headers to parse." :version "25.1" :group 'gnus-summary :type '(repeat symbol)) @@ -1157,7 +1157,7 @@ which it may alter in any way." (and user-mail-address (not (string= user-mail-address "")) (regexp-quote user-mail-address)) - "*From headers that may be suppressed in favor of To headers. + "From headers that may be suppressed in favor of To headers. This can be a regexp, a list of regexps or a function. If a function, an email string is passed as the argument." @@ -1173,14 +1173,14 @@ If a function, an email string is passed as the argument." (t (gmm-regexp-concat gnus-ignored-from-addresses)))) (defcustom gnus-summary-to-prefix "-> " - "*String prefixed to the To field in the summary line when + "String prefixed to the To field in the summary line when using `gnus-ignored-from-addresses'." :version "22.1" :group 'gnus-summary :type 'string) (defcustom gnus-summary-newsgroup-prefix "=> " - "*String prefixed to the Newsgroup field in the summary + "String prefixed to the Newsgroup field in the summary line when using the option `gnus-ignored-from-addresses'." :version "22.1" :group 'gnus-summary @@ -1264,13 +1264,13 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :group 'gnus-summary) (defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." + "All orphans get this score added. Set in the score file." :group 'gnus-score-default :type '(choice (const nil) integer)) (defcustom gnus-summary-save-parts-default-mime "image/.*" - "*A regexp to match MIME parts when saving multiple parts of a + "A regexp to match MIME parts when saving multiple parts of a message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]). This regexp will be used by default when prompting the user for which type of files to save." @@ -1888,7 +1888,7 @@ increase the score of each group you read." "&" gnus-summary-execute-command "c" gnus-summary-catchup-and-exit "\C-w" gnus-summary-mark-region-as-read - "\C-t" gnus-summary-toggle-truncation + "\C-t" toggle-truncate-lines "?" gnus-summary-mark-as-dormant "\C-c\M-\C-s" gnus-summary-limit-include-expunged "\C-c\C-s\C-n" gnus-summary-sort-by-number @@ -2768,7 +2768,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Run command on articles..." gnus-summary-universal-argument t] ["Search articles forward..." gnus-summary-search-article-forward t] ["Search articles backward..." gnus-summary-search-article-backward t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] + ["Toggle line truncation" toggle-truncate-lines t] ["Expand window" gnus-summary-expand-window t] ["Expire expirable articles" gnus-summary-expire-articles (gnus-check-backend-function @@ -4749,7 +4749,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (defun gnus-articles-in-thread (thread) "Return the list of articles in THREAD." (cons (mail-header-number (car thread)) - (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread))))) + (mapcan 'gnus-articles-in-thread (cdr thread)))) (defun gnus-remove-thread (id &optional dont-remove) "Remove the thread that has ID in it." @@ -7059,14 +7059,8 @@ buffer." (gnus-summary-remove-process-mark article))))) (gnus-summary-position-point)) -(defun gnus-summary-toggle-truncation (&optional arg) - "Toggle truncation of summary lines. -With ARG, turn line truncation on if ARG is positive." - (interactive "P") - (setq truncate-lines - (if (null arg) (not truncate-lines) - (> (prefix-numeric-value arg) 0))) - (redraw-display)) +(define-obsolete-function-alias + 'gnus-summary-toggle-truncation 'toggle-truncate-lines "26.1") (defun gnus-summary-find-for-reselect () "Return the number of an article to stay on across a reselect. @@ -9807,8 +9801,6 @@ prefix specifies how many places to rotate each letter forward." ;; Create buttons and stuff... (gnus-treat-article nil)) -(declare-function idna-to-unicode "ext:idna" (str)) - (defun gnus-summary-idna-message (&optional arg) "Decode IDNA encoded domain names in the current articles. IDNA encoded domain names looks like `xn--bar'. If a string @@ -9818,25 +9810,16 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") - (if (not (and (mm-coding-system-p 'utf-8) - (condition-case nil - (require 'idna) - (file-error) - (invalid-operation)) - (symbol-value 'idna-program) - (executable-find (symbol-value 'idna-program)))) - (gnus-message - 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)") - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t) - (replace-match (idna-to-unicode (match-string 1)))) - (set-window-start (get-buffer-window (current-buffer)) start))))))) + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (let ((start (window-start)) + buffer-read-only) + (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t) + (replace-match (puny-decode-domain (match-string 1)))) + (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-summary-morse-message (&optional arg) "Morse decode the current article." diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el deleted file mode 100644 index 249eb087b0b..00000000000 --- a/lisp/gnus/gnus-sync.el +++ /dev/null @@ -1,896 +0,0 @@ -;;; gnus-sync.el --- synchronization facility for Gnus - -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. - -;; Author: Ted Zlatanov <tzz@lifelogs.com> -;; Keywords: news synchronization nntp nnrss - -;; This file is part of GNU Emacs. - -;; 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This is the gnus-sync.el package. - -;; Put this in your startup file (~/.gnus.el for instance) - -;; possibilities for gnus-sync-backend: -;; Tramp over SSH: /ssh:user@host:/path/to/filename -;; ...or any other file Tramp and Emacs can handle... - -;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded -;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date) -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) -;; gnus-sync-newsrc-offsets '(2 3)) -;; against a LeSync server (beware the vampire LeSync, who knows your newsrc) - -;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz") -;; gnus-sync-newsrc-groups '("nntp" "nnrss")) - -;; What's a LeSync server? - -;; 1. install CouchDB, set up a real server admin user, and create a -;; database, e.g. "tzz" and save the URL, -;; e.g. http://lesync.info:5984/tzz - -;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)' - -;; (If you run it more than once, you have to remove the entry from -;; _users yourself. This is intentional. This sets up a database -;; admin for the "tzz" database, distinct from the server admin -;; user in (1) above.) - -;; That's it, you can start using http://lesync.info:5984/tzz in your -;; gnus-sync-backend as a LeSync backend. Fan fiction about the -;; vampire LeSync is welcome. - -;; You may not want to expose a CouchDB install to the Big Bad -;; Internet, especially if your love of all things furry would be thus -;; revealed. Make sure it's not accessible by unauthorized users and -;; guests, at least. - -;; If you want to try it out, I will create a test DB for you under -;; http://lesync.info:5984/yourfavoritedbname - -;; TODO: - -;; - after gnus-sync-read, the message counts look wrong until you do -;; `g'. So it's not run automatically, you have to call it with M-x -;; gnus-sync-read - -;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to -;; catch the mark updates - -;; - repositioning of groups within topic after a LeSync sync is a -;; weird sort of bubble sort ("buttle" sort: the old entry ends up -;; at the rear of the list); you will eventually end up with the -;; right order after calling `gnus-sync-read' a bunch of times. - -;; - installing topics and groups is inefficient and annoying, lots of -;; prompts could be avoided - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'json) -(require 'gnus) -(require 'gnus-start) -(require 'gnus-util) - -(defvar gnus-topic-alist) ;; gnus-group.el -(autoload 'gnus-group-topic "gnus-topic") - -(defgroup gnus-sync nil - "The Gnus synchronization facility." - :version "24.1" - :group 'gnus) - -(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss") - "List of groups to be synchronized in the gnus-newsrc-alist. -The group names are matched, they don't have to be fully -qualified. Typically you would choose all of these. That's the -default because there is no active sync backend by default, so -this setting is harmless until the user chooses a sync backend." - :group 'gnus-sync - :type '(repeat regexp)) - -(defcustom gnus-sync-newsrc-offsets '(2 3) - "List of per-group data to be synchronized." - :group 'gnus-sync - :version "24.4" - :type '(set (const :tag "Read ranges" 2) - (const :tag "Marks" 3))) - -(defcustom gnus-sync-global-vars nil - "List of global variables to be synchronized. -You may want to sync `gnus-newsrc-last-checked-date' but pretty -much any symbol is fair game. You could additionally sync -`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', -and `gnus-topic-alist'. Also see `gnus-variable-list'." - :group 'gnus-sync - :type '(repeat (choice (variable :tag "A known variable") - (symbol :tag "Any symbol")))) - -(defcustom gnus-sync-backend nil - "The synchronization backend." - :group 'gnus-sync - :type '(radio (const :format "None" nil) - (list :tag "Sync server" - (const :format "LeSync Server API" lesync) - (string :tag "URL of a CouchDB database for API access")) - (string :tag "Sync to a file"))) - -(defvar gnus-sync-newsrc-loader nil - "Carrier for newsrc data") - -(defcustom gnus-sync-file-encrypt-to nil - "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file." - :version "24.4" - :type '(choice string (repeat string)) - :group 'gnus-sync) - -(defcustom gnus-sync-lesync-name (system-name) - "The LeSync name for this machine." - :group 'gnus-sync - :version "24.3" - :type 'string) - -(defcustom gnus-sync-lesync-install-topics 'ask - "Should LeSync install the recorded topics?" - :group 'gnus-sync - :version "24.3" - :type '(choice (const :tag "Never Install" nil) - (const :tag "Always Install" t) - (const :tag "Ask Me Once" ask))) - -(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal) - "LeSync props, keyed by group name") - -(defvar gnus-sync-lesync-design-prefix "/_design/lesync" - "The LeSync design prefix for CouchDB") - -(defvar gnus-sync-lesync-security-object "/_security" - "The LeSync security object for CouchDB") - -(defun gnus-sync-lesync-parse () - "Parse the result of a LeSync request." - (goto-char (point-min)) - (condition-case nil - (when (search-forward-regexp "^$" nil t) - (json-read)) - (error - (gnus-message - 1 - "gnus-sync-lesync-parse: Could not read the LeSync response!") - nil))) - -(defun gnus-sync-lesync-call (url method headers &optional kvdata) - "Make an access request to URL using KVDATA and METHOD. -KVDATA must be an alist." - (let ((url-request-method method) - (url-request-extra-headers headers) - (url-request-data (if kvdata (json-encode kvdata) nil))) - (with-current-buffer (url-retrieve-synchronously url) - (let ((data (gnus-sync-lesync-parse))) - (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" - method url `((headers . ,headers) (data ,kvdata)) data) - (kill-buffer (current-buffer)) - data)))) - -(defun gnus-sync-lesync-PUT (url headers &optional data) - (gnus-sync-lesync-call url "PUT" headers data)) - -(defun gnus-sync-lesync-POST (url headers &optional data) - (gnus-sync-lesync-call url "POST" headers data)) - -(defun gnus-sync-lesync-GET (url headers &optional data) - (gnus-sync-lesync-call url "GET" headers data)) - -(defun gnus-sync-lesync-DELETE (url headers &optional data) - (gnus-sync-lesync-call url "DELETE" headers data)) - -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t) -; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz") - -(defun gnus-sync-lesync-setup (url &optional user password salt reader admin) - (interactive "sEnter URL to set up: ") - "Set up the LeSync database at URL. -Install USER as a READER and/or an ADMIN in the security object -under \"_security\", and in the CouchDB \"_users\" table using -PASSWORD and SALT. Only one USER is thus supported for now. -When SALT is nil, a random one will be generated using `random'." - (let* ((design-url (concat url gnus-sync-lesync-design-prefix)) - (security-object (concat url "/_security")) - (user-record `((names . [,user]) (roles . []))) - (couch-user-name (format "org.couchdb.user:%s" user)) - (salt (or salt (sha1 (format "%s" (random))))) - (couch-user-record - `((_id . ,couch-user-name) - (type . user) - (name . ,(format "%s" user)) - (roles . []) - (salt . ,salt) - (password_sha . ,(when password - (sha1 - (format "%s%s" password salt)))))) - (rev (progn - (gnus-sync-lesync-find-prop 'rev design-url design-url) - (gnus-sync-lesync-get-prop 'rev design-url))) - (latest-func "function(head,req) -{ - var tosend = []; - var row; - var ftime = (req.query['ftime'] || 0); - while (row = getRow()) - { - if (row.value['float-time'] > ftime) - { - var s = row.value['_id']; - if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"'); - } - } - send('['+tosend.join(',') + ']'); -}") -;; <key>read</key> -;; <dict> -;; <key>de.alt.fan.ipod</key> -;; <array> -;; <integer>1</integer> -;; <integer>2</integer> -;; <dict> -;; <key>start</key> -;; <integer>100</integer> -;; <key>length</key> -;; <integer>100</integer> -;; </dict> -;; </array> -;; </dict> - (xmlplistread-func "function(head, req) { - var row; - start({ 'headers': { 'Content-Type': 'text/xml' } }); - - send('<dict>'); - send('<key>read</key>'); - send('<dict>'); - while(row = getRow()) - { - var read = row.value.read; - if (read && read[0] && read[0] == 'invlist') - { - send('<key>'+row.key+'</key>'); - //send('<invlist>'+read+'</invlist>'); - send('<array>'); - - var from = 0; - var flip = false; - - for (var i = 1; i < read.length && read[i]; i++) - { - var cur = read[i]; - if (flip) - { - if (from == cur-1) - { - send('<integer>'+read[i]+'</integer>'); - } - else - { - send('<dict>'); - send('<key>start</key>'); - send('<integer>'+from+'</integer>'); - send('<key>end</key>'); - send('<integer>'+(cur-1)+'</integer>'); - send('</dict>'); - } - - } - flip = ! flip; - from = cur; - } - send('</array>'); - } - } - - send('</dict>'); - send('</dict>'); -} -") - (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}") - (revs-func "function(doc){emit(doc._id, doc._rev);}") - (bytimesubs-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc._rev);}") - (bytime-func "function(doc) -{emit([(doc['float-time']||0), doc._id], doc);}") - (groups-func "function(doc){emit(doc._id, doc);}")) - (and (if user - (and (assq 'ok (gnus-sync-lesync-PUT - security-object - nil - (append (and reader - (list `(readers . ,user-record))) - (and admin - (list `(admins . ,user-record)))))) - (assq 'ok (gnus-sync-lesync-PUT - (concat (file-name-directory url) - "_users/" - couch-user-name) - nil - couch-user-record))) - t) - (assq 'ok (gnus-sync-lesync-PUT - design-url - nil - `(,@(when rev (list (cons '_rev rev))) - (lists . ((latest . ,latest-func) - (xmlplistread . ,xmlplistread-func))) - (views . ((subs . ((map . ,subs-func))) - (revs . ((map . ,revs-func))) - (bytimesubs . ((map . ,bytimesubs-func))) - (bytime . ((map . ,bytime-func))) - (groups . ((map . ,groups-func))))))))))) - -(defun gnus-sync-lesync-find-prop (prop url key) - "Retrieve a PROPerty of a document KEY at URL. -Calls `gnus-sync-lesync-set-prop'. -For the 'rev PROP, uses '_rev against the document." - (gnus-sync-lesync-set-prop - prop key (cdr (assq (if (eq prop 'rev) '_rev prop) - (gnus-sync-lesync-GET url nil))))) - -(defun gnus-sync-lesync-set-prop (prop key val) - "Update the PROPerty of document KEY at URL to VAL. -Updates `gnus-sync-lesync-props-hash'." - (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash)) - -(defun gnus-sync-lesync-get-prop (prop key) - "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'." - (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash)) - -(defun gnus-sync-deep-print (data) - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t)) - (format "%S" data))) - -(defun gnus-sync-newsrc-loader-builder (&optional only-modified) - (let* ((entries (cdr gnus-newsrc-alist)) - entry name ret) - (while entries - (setq entry (pop entries) - name (car entry)) - (when (gnus-grep-in-list name gnus-sync-newsrc-groups) - (if only-modified - (when (not (equal (gnus-sync-deep-print entry) - (gnus-sync-lesync-get-prop 'checksum name))) - (gnus-message 9 "%s: add %s, it's modified" - "gnus-sync-newsrc-loader-builder" name) - (push entry ret)) - (push entry ret)))) - ret)) - -; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502))) -(defun gnus-sync-range2invlist (ranges) - (append '(invlist) - (let ((ranges (delq nil ranges)) - ret range from to) - (while ranges - (setq range (pop ranges)) - (if (atom range) - (setq from range - to range) - (setq from (car range) - to (cdr range))) - (push from ret) - (push (1+ to) ret)) - (reverse ret)))) - -; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j)) -(defun gnus-sync-invlist2range (inv) - (setq inv (append inv nil)) - (if (equal (format "%s" (car inv)) "invlist") - (let ((i (cdr inv)) - (start 0) - ret cur top flip) - (while i - (setq cur (pop i)) - (when flip - (setq top (1- cur)) - (if (= start top) - (push start ret) - (push (cons start top) ret))) - (setq flip (not flip)) - (setq start cur)) - (reverse ret)) - inv)) - -(defun gnus-sync-position (search list &optional test) - "Find the position of SEARCH in LIST using TEST, defaulting to `eq'." - (let ((pos 0) - (test (or test 'eq))) - (while (and list (not (funcall test (car list) search))) - (pop list) - (incf pos)) - (if (funcall test (car list) search) pos nil))) - -(defun gnus-sync-topic-group-position (group topic-name) - (gnus-sync-position - group (cdr (assoc topic-name gnus-topic-alist)) 'equal)) - -(defun gnus-sync-fix-topic-group-position (group topic-name position) - (unless (equal position (gnus-sync-topic-group-position group topic-name)) - (let* ((loc "gnus-sync-fix-topic-group-position") - (groups (delete group (cdr (assoc topic-name gnus-topic-alist)))) - (position (min position (1- (length groups)))) - (old (nth position groups))) - (when (and old (not (equal old group))) - (setf (nth position groups) group) - (setcdr (assoc topic-name gnus-topic-alist) - (append groups (list old))) - (gnus-message 9 "%s: %s moved to %d, swap with %s" - loc group position old))))) - -(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props) - (let* ((loc "gnus-sync-lesync-save-group-entry") - (k (car nentry)) - (revision (gnus-sync-lesync-get-prop 'rev k)) - (sname gnus-sync-lesync-name) - (topic (gnus-group-topic k)) - (topic-offset (gnus-sync-topic-group-position k topic)) - (sources (gnus-sync-lesync-get-prop 'source k))) - ;; set the revision so we don't have a conflict - `(,@(when revision - (list (cons '_rev revision))) - (_id . ,k) - ;; the time we saved - ,@passed-props - ;; add our name to the sources list for this key - (source ,@(if (member gnus-sync-lesync-name sources) - sources - (cons gnus-sync-lesync-name sources))) - ,(cons 'level (nth 1 nentry)) - ,@(if topic (list (cons 'topic topic)) nil) - ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil) - ;; the read marks - ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry))) - ;; the other marks - ,@(delq nil (mapcar (lambda (mark-entry) - (gnus-message 12 "%s: prep param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - (if (listp (cdr mark-entry)) - (cons (car mark-entry) - (gnus-sync-range2invlist - (cdr mark-entry))) - (progn ; else this is not a list - (gnus-message 9 "%s: non-list param %s in %s" - loc - (car mark-entry) - (nth 3 nentry)) - nil))) - (nth 3 nentry)))))) - -(defun gnus-sync-lesync-post-save-group-entry (url entry) - (let* ((loc "gnus-sync-lesync-post-save-group-entry") - (k (cdr (assq 'id entry)))) - (cond - ;; success! - ((and (assq 'rev entry) (assq 'id entry)) - (progn - (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry))) - (gnus-sync-lesync-set-prop 'checksum - k - (gnus-sync-deep-print - (assoc k gnus-newsrc-alist))) - (gnus-message 9 "%s: successfully synced %s to %s" - loc k url))) - ;; specifically check for document conflicts - ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry)))) - (gnus-error - 1 - "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s" - loc "gnus-sync-read" k url (cdr (assq 'reason entry)))) - ;; generic errors - ((assq 'error entry) - (gnus-error 1 "%s: got error while synchronizing %s to %s: %s" - loc k url (cdr (assq 'reason entry)))) - - (t - (gnus-message 2 "%s: unknown sync status after %s to %s: %S" - loc k url entry))) - (assoc 'error entry))) - -(defun gnus-sync-lesync-groups-builder (url) - (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups"))) - (cdr (assq 'rows (gnus-sync-lesync-GET u nil))))) - -(defun gnus-sync-subscribe-group (name) - "Subscribe to group NAME. Returns NAME on success, nil otherwise." - (gnus-subscribe-newsgroup name)) - -(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props) - "Read ENTRY information for NAME. Returns NAME if successful. -Skips entries whose sources don't contain -`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a -`subscribe-all' element that evaluates to true, we attempt to -subscribe to unknown groups. The user is also allowed to delete -unwanted groups via the LeSync URL." - (let* ((loc "gnus-sync-lesync-read-group-entry") - (entry (gnus-sync-lesync-normalize-group-entry entry passed-props)) - (subscribe-all (cdr (assq 'subscribe-all passed-props))) - (sources (cdr (assq 'source entry))) - (rev (cdr (assq 'rev entry))) - (in-sources (member gnus-sync-lesync-name sources)) - (known (assoc name gnus-newsrc-alist)) - cell) - (unless known - (if (and subscribe-all - (y-or-n-p (format "Subscribe to group %s?" name))) - (setq known (gnus-sync-subscribe-group name) - in-sources t) - ;; else... - (when (y-or-n-p (format "Delete group %s from server?" name)) - (if (equal name (gnus-sync-lesync-delete-group url name)) - (gnus-message 1 "%s: removed group %s from server %s" - loc name url) - (gnus-error 1 "%s: could not remove group %s from server %s" - loc name url))))) - (when known - (unless in-sources - (setq in-sources - (y-or-n-p - (format "Read group %s even though %s is not in sources %S?" - name gnus-sync-lesync-name (or sources "")))))) - (when rev - (gnus-sync-lesync-set-prop 'rev name rev)) - - ;; if the source matches AND we have this group - (if (and known in-sources) - (progn - (gnus-message 10 "%s: reading LeSync entry %s, sources %S" - loc name sources) - (while entry - (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (gnus-sync-lesync-set-prop k name val))) - name) - ;; else... - (unless known - (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s" - loc name "Call `gnus-sync-read' with C-u to force it.")) - (unless in-sources - (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S" - loc name gnus-sync-lesync-name (or sources ""))) - nil))) - -(declare-function gnus-topic-create-topic "gnus-topic" - (topic parent &optional previous full-topic)) -(declare-function gnus-topic-enter-dribble "gnus-topic" ()) - -(defun gnus-sync-lesync-install-group-entry (name) - (let* ((master (assoc name gnus-newsrc-alist)) - (old-topic-name (gnus-group-topic name)) - (old-topic (assoc old-topic-name gnus-topic-alist)) - (target-topic-name (gnus-sync-lesync-get-prop 'topic name)) - (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name)) - (target-topic (assoc target-topic-name gnus-topic-alist)) - (loc "gnus-sync-lesync-install-group-entry")) - (if master - (progn - (when (eq 'ask gnus-sync-lesync-install-topics) - (setq gnus-sync-lesync-install-topics - (y-or-n-p "Install topics from LeSync?"))) - (when (and (eq t gnus-sync-lesync-install-topics) - target-topic-name) - (if (equal old-topic-name target-topic-name) - (gnus-message 12 "%s: %s is already in topic %s" - loc name target-topic-name) - ;; see `gnus-topic-move-group' - (when (and old-topic target-topic) - (setcdr old-topic (gnus-delete-first name (cdr old-topic))) - (gnus-message 5 "%s: removing %s from topic %s" - loc name old-topic-name)) - (unless target-topic - (when (y-or-n-p (format "Create missing topic %s?" - target-topic-name)) - (gnus-topic-create-topic target-topic-name nil) - (setq target-topic (assoc target-topic-name - gnus-topic-alist)))) - (if target-topic - (prog1 - (nconc target-topic (list name)) - (gnus-message 5 "%s: adding %s to topic %s" - loc name (car target-topic)) - (gnus-topic-enter-dribble)) - (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s" - loc name target-topic-name))) - (when (and target-topic-offset target-topic) - (gnus-sync-fix-topic-group-position - name target-topic-name target-topic-offset))) - ;; install the subscription level - (when (gnus-sync-lesync-get-prop 'level name) - (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name))) - ;; install the read and other marks - (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name)) - (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name)) - (gnus-sync-lesync-set-prop 'checksum - name - (gnus-sync-deep-print master)) - nil) - (gnus-error 1 "%s: invalid LeSync group %s" loc name) - 'invalid-name))) - -; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot") - -(defun gnus-sync-lesync-delete-group (url name) - "Returns NAME if successful deleting it from URL, an error otherwise." - (interactive "sEnter URL to set up: \rsEnter group name: ") - (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name))) - (del (gnus-sync-lesync-DELETE - u - `(,@(when (gnus-sync-lesync-get-prop 'rev name) - (list (cons "If-Match" - (gnus-sync-lesync-get-prop 'rev name)))))))) - (or (cdr (assq 'id del)) del))) - -;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil))) - -(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props) - (let (ret - marks - cell) - (setq entry (append passed-props entry)) - (while (setq cell (pop entry)) - (let ((k (car cell)) - (val (cdr cell))) - (cond - ((eq k 'read) - (push (cons k (gnus-sync-invlist2range val)) ret)) - ;; we ignore these parameters - ((member k '(_id subscribe-all _deleted_conflicts)) - nil) - ((eq k '_rev) - (push (cons 'rev val) ret)) - ((eq k 'source) - (push (cons 'source (append val nil)) ret)) - ((or (eq k 'float-time) - (eq k 'level) - (eq k 'topic) - (eq k 'topic-offset) - (eq k 'read-time)) - (push (cons k val) ret)) -;;; "How often have I said to you that when you have eliminated the -;;; impossible, whatever remains, however improbable, must be the -;;; truth?" --Sherlock Holmes - ;; everything remaining must be a mark - (t (push (cons k (gnus-sync-invlist2range val)) marks))))) - (cons (cons 'marks marks) ret))) - -(defun gnus-sync-save (&optional force) -"Save the Gnus sync data to the backend. -With a prefix, FORCE is set and all groups will be saved." - (interactive "P") - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - - ;; refresh the revisions if we're forcing the save - (when force - (mapc (lambda (entry) - (when (and (assq 'key entry) - (assq 'value entry)) - (gnus-sync-lesync-set-prop - 'rev - (cdr (assq 'key entry)) - (cdr (assq 'value entry))))) - ;; the revs view is key = name, value = rev - (cdr (assq 'rows (gnus-sync-lesync-GET - (concat (nth 1 gnus-sync-backend) - gnus-sync-lesync-design-prefix - "/_view/revs") - nil))))) - - (let* ((ftime (float-time)) - (url (nth 1 gnus-sync-backend)) - (entries - (mapcar (lambda (entry) - (gnus-sync-lesync-pre-save-group-entry - (cadr gnus-sync-backend) - entry - (cons 'float-time ftime))) - (gnus-sync-newsrc-loader-builder (not force)))) - ;; when there are no entries, there's nothing to save - (sync (if entries - (gnus-sync-lesync-POST - (concat url "/_bulk_docs") - '(("Content-Type" . "application/json")) - `((docs . ,(vconcat entries nil)))) - (gnus-message - 2 "gnus-sync-save: nothing to save to the LeSync backend") - nil))) - (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e)) - sync))) - ((stringp gnus-sync-backend) - (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend) - ;; populate gnus-sync-newsrc-loader from all but the first dummy - ;; entry in gnus-newsrc-alist whose group matches any of the - ;; gnus-sync-newsrc-groups - ;; TODO: keep the old contents for groups we don't have! - (let ((gnus-sync-newsrc-loader - (loop for entry in (cdr gnus-newsrc-alist) - when (gnus-grep-in-list - (car entry) ;the group name - gnus-sync-newsrc-groups) - collect (cons (car entry) - (mapcar (lambda (offset) - (cons offset (nth offset entry))) - gnus-sync-newsrc-offsets))))) - (with-temp-file gnus-sync-backend - (progn - (let ((coding-system-for-write gnus-ding-file-coding-system) - (standard-output (current-buffer))) - (when gnus-sync-file-encrypt-to - (set (make-local-variable 'epa-file-encrypt-to) - gnus-sync-file-encrypt-to)) - (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" - gnus-ding-file-coding-system)) - (princ ";; Gnus sync data v. 0.0.1\n") - ;; TODO: replace with `gnus-sync-deep-print' - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t) - (variables (cons 'gnus-sync-newsrc-loader - gnus-sync-global-vars)) - variable) - (while variables - (if (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (progn - (princ "\n(setq ") - (princ (symbol-name variable)) - (princ " '") - (prin1 (symbol-value variable)) - (princ ")\n")) - (princ "\n;;; skipping empty variable ") - (princ (symbol-name variable))))) - (gnus-message - 7 - "gnus-sync-save: stored variables %s and %d groups in %s" - gnus-sync-global-vars - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - - ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> - ;; Save the .eld file with extra line breaks. - (gnus-message 8 "gnus-sync-save: adding whitespace to %s" - gnus-sync-backend) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^(\\|(\\\"" nil t) - (replace-match "\n\\&" t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)))))))) - ;; the pass-through case: gnus-sync-backend is not a known choice - (nil))) - -(defun gnus-sync-read (&optional subscribe-all) - "Load the Gnus sync data from the backend. -With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." - (interactive "P") - (when gnus-sync-backend - (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend) - (cond - ((and (listp gnus-sync-backend) - (eq (nth 0 gnus-sync-backend) 'lesync) - (stringp (nth 1 gnus-sync-backend))) - (let ((errored nil) - name ftime) - (mapc (lambda (entry) - (setq name (cdr (assq 'id entry))) - ;; set ftime the FIRST time through this loop, that - ;; way it reflects the time we FINISHED reading - (unless ftime (setq ftime (float-time))) - - (unless errored - (setq errored - (when (equal name - (gnus-sync-lesync-read-group-entry - (nth 1 gnus-sync-backend) - name - (cdr (assq 'value entry)) - `(read-time ,ftime) - `(subscribe-all ,subscribe-all))) - (gnus-sync-lesync-install-group-entry - (cdr (assq 'id entry))))))) - (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) - - ((stringp gnus-sync-backend) - ;; read data here... - (if (or debug-on-error debug-on-quit) - (load gnus-sync-backend nil t) - (condition-case var - (load gnus-sync-backend nil t) - (error - (error "Error in %s: %s" gnus-sync-backend (cadr var))))) - (let ((valid-count 0) - invalid-groups) - (dolist (node gnus-sync-newsrc-loader) - (if (gnus-gethash (car node) gnus-newsrc-hashtb) - (progn - (incf valid-count) - (loop for store in (cdr node) - do (setf (nth (car store) - (assoc (car node) gnus-newsrc-alist)) - (cdr store)))) - (push (car node) invalid-groups))) - (gnus-message - 7 - "gnus-sync-read: loaded %d groups (out of %d) from %s" - valid-count (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (when invalid-groups - (gnus-message - 7 - "gnus-sync-read: skipped %d groups (out of %d) from %s" - (length invalid-groups) - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (gnus-message 9 "gnus-sync-read: skipped groups: %s" - (mapconcat 'identity invalid-groups ", "))))) - (nil)) - - (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable") - (gnus-make-hashtable-from-newsrc-alist))) - -;;;###autoload -(defun gnus-sync-initialize () -"Initialize the Gnus sync facility." - (interactive) - (gnus-message 5 "Initializing the sync facility") - (gnus-sync-install-hooks)) - -;;;###autoload -(defun gnus-sync-install-hooks () - "Install the sync hooks." - (interactive) - ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) - ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read) - (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(defun gnus-sync-unload-hook () - "Uninstall the sync hooks." - (interactive) - (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) - -(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) - -(when gnus-sync-backend (gnus-sync-initialize)) - -(provide 'gnus-sync) - -;;; gnus-sync.el ends here diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 39236594eb7..809caee64a0 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -63,12 +63,12 @@ See Info node `(gnus)Formatting Variables'." :group 'gnus-topic) (defcustom gnus-topic-indent-level 2 - "*How much each subtopic should be indented." + "How much each subtopic should be indented." :type 'integer :group 'gnus-topic) (defcustom gnus-topic-display-empty-topics t - "*If non-nil, display the topic lines even of topics that have no unread articles." + "If non-nil, display the topic lines even of topics that have no unread articles." :type 'boolean :group 'gnus-topic) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 7d3c7089225..7eb44629076 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -81,7 +81,7 @@ If LITERAL is non-nil, insert NEWTEXT literally. Return a new string containing the replacements. This is a compatibility function for different Emacsen." - (declare (obsolete replace-regexp-in-string "25.2")) + (declare (obsolete replace-regexp-in-string "26.1")) (replace-regexp-in-string regexp newtext string nil literal)) (defun gnus-boundp (variable) @@ -417,7 +417,7 @@ Cache the result as a text property stored in DATE." i)) (defcustom gnus-verbose 6 - "*Integer that says how verbose Gnus should be. + "Integer that says how verbose Gnus should be. The higher the number, the more messages Gnus will flash to say what it's doing. At zero, Gnus will be totally mute; at five, Gnus will display most important messages; and at ten, Gnus will keep on @@ -1599,7 +1599,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp heads)) nil)) (setq ,result-tail (cdr ,result-tail) - ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads)))) + ,@(mapcan (lambda (h) (list h (list 'cdr h))) heads))) (cdr ,result))) `(mapcar ,function ,seq1))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index f199d1659d9..d09210da085 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -73,7 +73,7 @@ ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) - "*Default actions to be taken when the user asks to view a file. + "Default actions to be taken when the user asks to view a file. To change the behavior, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. @@ -113,7 +113,7 @@ details." (defcustom gnus-uu-user-view-rules-end '(("" "file")) - "*What actions are to be taken if no rule matched the file name. + "What actions are to be taken if no rule matched the file name. See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view @@ -131,7 +131,7 @@ details." ("\\.Z$" "uncompress") ("\\.gz$" "gunzip") ("\\.arc$" "arc -x")) - "*See `gnus-uu-user-archive-rules'." + "See `gnus-uu-user-archive-rules'." :group 'gnus-extract-archive :type '(repeat (group regexp (string :tag "Command")))) @@ -149,7 +149,7 @@ unpack zip files, say the following: :type '(repeat (group regexp (string :tag "Command")))) (defcustom gnus-uu-ignore-files-by-name nil - "*A regular expression saying what files should not be viewed based on name. + "A regular expression saying what files should not be viewed based on name. If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like @@ -162,7 +162,7 @@ Note that this variable can be used in conjunction with the (regexp :format "%v"))) (defcustom gnus-uu-ignore-files-by-type nil - "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. + "A regular expression saying what files that shouldn't be viewed, based on MIME file type. If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like @@ -224,13 +224,13 @@ Default is \"/tmp/\"." :type 'directory) (defcustom gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. + "Non-nil means that gnus-uu won't peek inside archives looking for files to display. Default is nil." :group 'gnus-extract-archive :type 'boolean) (defcustom gnus-uu-ignore-default-view-rules nil - "*Non-nil means that gnus-uu will ignore the default viewing rules. + "Non-nil means that gnus-uu will ignore the default viewing rules. Only the user viewing rules will be consulted. Default is nil." :group 'gnus-extract-view :type 'boolean) @@ -245,19 +245,19 @@ and `gnus-uu-grab-move'." :type 'hook) (defcustom gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. + "Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil." :group 'gnus-extract-archive :type 'boolean) (defcustom gnus-uu-kill-carriage-return t - "*Non-nil means that gnus-uu will strip all carriage returns from articles. + "Non-nil means that gnus-uu will strip all carriage returns from articles. Default is t." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-view-with-metamail nil - "*Non-nil means that files will be viewed with metamail. + "Non-nil means that files will be viewed with metamail. The gnus-uu viewing functions will be ignored and gnus-uu will try to guess at a content-type based on file name suffixes. Default it nil." @@ -265,19 +265,19 @@ it nil." :type 'boolean) (defcustom gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. + "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. + "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-save-in-digest nil - "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. + "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - no easy way to specify any meaningful volume and issue numbers were found, @@ -295,19 +295,19 @@ so I simply dropped them." "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" "^Content-ID:") - "*List of regexps to match headers included in digested messages. + "List of regexps to match headers included in digested messages. The headers will be included in the sequence they are matched. If nil include all headers." :group 'gnus-extract :type '(repeat regexp)) (defcustom gnus-uu-save-separate-articles nil - "*Non-nil means that gnus-uu will save articles in separate files." + "Non-nil means that gnus-uu will save articles in separate files." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-be-dangerous 'ask - "*Specifies what to do if unusual situations arise during decoding. + "Specifies what to do if unusual situations arise during decoding. If nil, be as conservative as possible. If t, ignore things that didn't work, and overwrite existing files. Otherwise, ask each time." :group 'gnus-extract diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 9c950a9e3e9..6fc3bc45a90 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -34,27 +34,27 @@ :group 'gnus) (defcustom gnus-use-full-window t - "*If non-nil, use the entire Emacs screen." + "If non-nil, use the entire Emacs screen." :group 'gnus-windows :type 'boolean) (defcustom gnus-window-min-width 2 - "*Minimum width of Gnus buffers." + "Minimum width of Gnus buffers." :group 'gnus-windows :type 'integer) (defcustom gnus-window-min-height 1 - "*Minimum height of Gnus buffers." + "Minimum height of Gnus buffers." :group 'gnus-windows :type 'integer) (defcustom gnus-always-force-window-configuration nil - "*If non-nil, always force the Gnus window configurations." + "If non-nil, always force the Gnus window configurations." :group 'gnus-windows :type 'boolean) (defcustom gnus-use-frames-on-any-display nil - "*If non-nil, frames on all displays will be considered usable by Gnus. + "If non-nil, frames on all displays will be considered usable by Gnus. When nil, only frames on the same display as the selected frame will be used to display Gnus windows." :version "22.1" @@ -195,7 +195,7 @@ See the Gnus manual for an explanation of the syntax used.") "Mapping from short symbols to buffer names or buffer variables.") (defcustom gnus-configure-windows-hook nil - "*A hook called when configuring windows." + "A hook called when configuring windows." :version "22.1" :group 'gnus-windows :type 'hook) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index edf46f173b1..943ba0889b6 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -997,7 +997,7 @@ be set in `.emacs' instead." "Color alist used for the Gnus logo.") (defcustom gnus-logo-color-style 'ma - "*Color styles used for the Gnus logo." + "Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) :group 'gnus-xmas) @@ -1240,7 +1240,7 @@ in `.gnus.el'. Set this variable in `.emacs' instead." (defcustom gnus-directory (or (getenv "SAVEDIR") (nnheader-concat gnus-home-directory "News/")) - "*Directory variable from which all other Gnus file variables are derived. + "Directory variable from which all other Gnus file variables are derived. Note that Gnus is mostly loaded when the `.gnus.el' file is read. This means that other directory variables that are initialized from @@ -1250,7 +1250,7 @@ Set this variable in `.emacs' instead." :type 'directory) (defcustom gnus-default-directory nil - "*Default directory for all Gnus buffers." + "Default directory for all Gnus buffers." :group 'gnus-files :type '(choice (const :tag "current" nil) directory)) @@ -1321,7 +1321,7 @@ see the manual for details." :type 'gnus-select-method) (defcustom gnus-message-archive-method "archive" - "*Method used for archiving messages you've sent. + "Method used for archiving messages you've sent. This should be a mail method. See also `gnus-update-message-archive-method'." @@ -1347,7 +1347,7 @@ saved \"archive\" method to be updated whenever you change the value of :type 'boolean) (defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m")) - "*Name of the group in which to save the messages you've written. + "Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list of strings). The functions are called with the name of the current @@ -1433,7 +1433,7 @@ list, Gnus will try all the methods in the list until it finds a match." gnus-select-method)))) (defcustom gnus-use-cross-reference t - "*Non-nil means that cross referenced articles will be marked as read. + "Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in subscribed newsgroups. If neither t nor nil, mark as read in all newsgroups." @@ -1444,13 +1444,13 @@ newsgroups." :value always))) (defcustom gnus-process-mark ?# - "*Process mark." + "Process mark." :group 'gnus-group-visual :group 'gnus-summary-marks :type 'character) (defcustom gnus-large-newsgroup 200 - "*The number of articles which indicates a large newsgroup. + "The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, confirmation is required for selecting the newsgroup. If it is nil, no confirmation is required. @@ -1484,24 +1484,24 @@ on all other systems it defaults to t." (const not-kill)))) (defcustom gnus-kill-files-directory gnus-directory - "*Name of the directory where kill files will be stored (default \"~/News\")." + "Name of the directory where kill files will be stored (default \"~/News\")." :group 'gnus-score-files :group 'gnus-score-kill :type 'directory) (defcustom gnus-save-score nil - "*If non-nil, save group scoring info." + "If non-nil, save group scoring info." :group 'gnus-score-various :group 'gnus-start :type 'boolean) (defcustom gnus-use-undo t - "*If non-nil, allow undoing in Gnus group mode buffers." + "If non-nil, allow undoing in Gnus group mode buffers." :group 'gnus-meta :type 'boolean) (defcustom gnus-use-adaptive-scoring nil - "*If non-nil, use some adaptive scoring scheme. + "If non-nil, use some adaptive scoring scheme. If a list, then the values `word' and `line' are meaningful. The former will perform adaption on individual words in the subject header while `line' will perform adaption on several headers." @@ -1510,7 +1510,7 @@ header while `line' will perform adaption on several headers." :type '(set (const word) (const line))) (defcustom gnus-use-cache 'passive - "*If nil, Gnus will ignore the article cache. + "If nil, Gnus will ignore the article cache. If `passive', it will allow entering (and reading) articles explicitly entered into the cache. If anything else, use the cache to the full extent of the law." @@ -1521,12 +1521,12 @@ cache to the full extent of the law." (const :tag "active" t))) (defcustom gnus-use-trees nil - "*If non-nil, display a thread tree buffer." + "If non-nil, display a thread tree buffer." :group 'gnus-meta :type 'boolean) (defcustom gnus-keep-backlog 20 - "*If non-nil, Gnus will keep read articles for later re-retrieval. + "If non-nil, Gnus will keep read articles for later re-retrieval. If it is a number N, then Gnus will only keep the last N articles read. If it is neither nil nor a number, Gnus will keep all read articles. This is not a good idea." @@ -1537,43 +1537,43 @@ articles. This is not a good idea." :value t))) (defcustom gnus-suppress-duplicates nil - "*If non-nil, Gnus will mark duplicate copies of the same article as read." + "If non-nil, Gnus will mark duplicate copies of the same article as read." :group 'gnus-meta :type 'boolean) (defcustom gnus-use-scoring t - "*If non-nil, enable scoring." + "If non-nil, enable scoring." :group 'gnus-meta :type 'boolean) (defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) - "*A hook called when preparing to exit from the summary buffer. + "A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default." :group 'gnus-summary-exit :type 'hook) (defcustom gnus-novice-user t - "*Non-nil means that you are a Usenet novice. + "Non-nil means that you are a Usenet novice. If non-nil, verbose messages may be displayed and confirmations may be required." :group 'gnus-meta :type 'boolean) (defcustom gnus-expert-user nil - "*Non-nil means that you will never be asked for confirmation about anything. + "Non-nil means that you will never be asked for confirmation about anything. That doesn't mean *anything* anything; particularly destructive commands will still require prompting." :group 'gnus-meta :type 'boolean) (defcustom gnus-interactive-catchup t - "*If non-nil, require your confirmation when catching up a group." + "If non-nil, require your confirmation when catching up a group." :group 'gnus-group-select :type 'boolean) (defcustom gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus. + "If non-nil, require your confirmation when exiting Gnus. If `quiet', update any active summary buffers automatically first before exiting." :group 'gnus-exit @@ -1581,7 +1581,7 @@ first before exiting." (const quiet))) (defcustom gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. + "Function for extracting address components from a From header. Two pre-defined function exist: `gnus-extract-address-components', which is the default, quite fast, and too simplistic solution, and `mail-extract-address-components', which works much better, but is @@ -1617,7 +1617,7 @@ slower." server-marks cloud) ("nnmaildir" mail respool address server-marks) ("nnnil" none)) - "*An alist of valid select methods. + "An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be the category of this method (i. e., `post', `mail', `none' or whatever) or other @@ -1676,7 +1676,7 @@ If this variable is nil, screen refresh may be quicker." (const tree))) (defcustom gnus-mode-non-string-length 30 - "*Max length of mode-line non-string contents. + "Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest of the mode line intact." :version "24.1" @@ -1693,7 +1693,7 @@ of the mode line intact." :function-document "Return GROUP's to-address." :variable-document - "*Alist of group regexps and correspondent to-addresses." + "Alist of group regexps and correspondent to-addresses." :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To Address") :parameter-document "\ @@ -1720,7 +1720,7 @@ address was listed in gnus-group-split Addresses (see below).") :function-document "Return GROUP's to-list." :variable-document - "*Alist of group regexps and correspondent to-lists." + "Alist of group regexps and correspondent to-lists." :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To List") :parameter-document "\ @@ -1739,7 +1739,7 @@ address was listed in gnus-group-split Addresses (see below).") :function-document "Return GROUP's subscription status." :variable-document - "*Groups which are automatically considered subscribed." + "Groups which are automatically considered subscribed." :variable-group gnus-group-parameter :parameter-type '(const :tag "Subscribed" t) :parameter-document "\ @@ -1758,7 +1758,7 @@ above, or the list address (if the To address has not been set).") :variable gnus-auto-expirable-newsgroups :variable-default nil :variable-document - "*Groups in which to automatically mark read articles as expirable. + "Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups." :variable-group nnmail-expire @@ -1777,7 +1777,7 @@ which to perform auto-expiry. This only makes sense for mail groups." :variable gnus-total-expirable-newsgroups :variable-default nil :variable-document - "*Groups in which to perform expiry of all read articles. + "Groups in which to perform expiry of all read articles. Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after \(say) one week. (This only goes for mail groups and the like, of @@ -1846,7 +1846,7 @@ posting an article." :function-document "Return GROUP's initial input of the number of articles." :variable-document - "*Alist of group regexps and its initial input of the number of articles." + "Alist of group regexps and its initial input of the number of articles." :variable-group gnus-group-parameter :parameter-type '(choice :tag "Initial Input for Large Newsgroup" (const :tag "All" nil) @@ -1870,7 +1870,7 @@ total number of articles in the group.") '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "^nnir:" "archive")) :variable-document - "*Groups in which the registry should be turned off." + "Groups in which the registry should be turned off." :variable-group gnus-registry :variable-type '(repeat (list @@ -1883,7 +1883,7 @@ total number of articles in the group.") ;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com> (defcustom gnus-install-group-spam-parameters t - "*Disable the group parameters for spam detection. + "Disable the group parameters for spam detection. Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." :version "22.1" :type 'boolean @@ -1913,7 +1913,7 @@ registry.") :variable gnus-spam-newsgroup-contents :variable-default nil :variable-document - "*Group classification (spam, ham, or neither). Only + "Group classification (spam, ham, or neither). Only meaningful when spam.el is loaded. If non-nil, this should be a list of group name regexps associated with a classification for each one. In spam groups, new articles are marked as spam on @@ -2070,7 +2070,7 @@ Only applicable to non-spam (unclassified and ham) groups.") :variable gnus-spam-process-newsgroups :variable-default nil :variable-document - "*Groups in which to automatically process spam or ham articles with + "Groups in which to automatically process spam or ham articles with a backend on summary exit. If non-nil, this should be a list of group name regexps that should match all groups in which to do automatic spam processing, associated with the appropriate processor." @@ -2129,7 +2129,7 @@ spam processing, associated with the appropriate processor." :variable gnus-spam-autodetect :variable-default nil :variable-document - "*Groups in which spam should be autodetected when they are entered. + "Groups in which spam should be autodetected when they are entered. Only unseen articles will be examined, unless spam-autodetect-recheck-messages is set." :variable-group spam @@ -2175,7 +2175,7 @@ spam-autodetect-recheck-messages is set.") :variable gnus-spam-autodetect-methods :variable-default nil :variable-document - "*Methods for autodetecting spam per group. + "Methods for autodetecting spam per group. Requires the spam-autodetect parameter. Only unseen articles will be examined, unless spam-autodetect-recheck-messages is set." @@ -2227,7 +2227,7 @@ set.") :variable gnus-spam-process-destinations :variable-default nil :variable-document - "*Groups in which to explicitly send spam-processed articles to + "Groups in which to explicitly send spam-processed articles to another group, or expire them (the default). If non-nil, this should be a list of group name regexps that should match all groups in which to do spam-processed article moving, associated with the destination @@ -2264,7 +2264,7 @@ mail groups." :variable gnus-ham-process-destinations :variable-default nil :variable-document - "*Groups in which to explicitly send ham articles to + "Groups in which to explicitly send ham articles to another group, or do nothing (the default). If non-nil, this should be a list of group name regexps that should match all groups in which to do ham article moving, associated with the destination @@ -2309,7 +2309,7 @@ spam-ham-marks variable takes precedence." gnus-low-score-mark)))) :variable-group spam :variable-document - "*Groups in which to explicitly set the ham marks to some value.") + "Groups in which to explicitly set the ham marks to some value.") (gnus-define-group-parameter spam-marks @@ -2328,7 +2328,7 @@ spam-spam-marks variable takes precedence." :variable-default '((".*" ((gnus-spam-mark)))) :variable-group spam :variable-document - "*Groups in which to explicitly set the spam marks to some value.")) + "Groups in which to explicitly set the spam marks to some value.")) (defcustom gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name." @@ -2336,7 +2336,7 @@ spam-spam-marks variable takes precedence." :type 'integer) (defcustom gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level." + "If non-nil, once you set a level, Gnus will use this level." :group 'gnus-group-levels :type 'boolean) @@ -2384,7 +2384,7 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." tree-highlight menu highlight browse-menu server-menu page-marker tree-menu binary-menu pick-menu) - "*Enable visual features. + "Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of the visual customization options below will be ignored. Gnus will use less space and be faster as a result. @@ -2437,14 +2437,14 @@ Valid elements include `summary-highlight', `group-highlight', 'highlight) 'default) (error 'highlight)) - "*Face used for group or summary buffer mouse highlighting. + "Face used for group or summary buffer mouse highlighting. The line beneath the mouse pointer will be highlighted with this face." :group 'gnus-visual :type 'face) (defcustom gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\")." + "Name of the directory articles will be saved in (default \"~/News\")." :group 'gnus-article-saving :type 'directory) @@ -2596,7 +2596,7 @@ a string, be sure to use a valid format, see RFC 2616." (defcustom gnus-cache-directory (nnheader-concat gnus-directory "cache/") - "*The directory where cached articles will be stored." + "The directory where cached articles will be stored." :group 'gnus-cache :type 'directory) @@ -2930,7 +2930,7 @@ gnus-registry.el will populate this if it's loaded.") (defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" - "*The format specification of the lines in the summary buffer. + "The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index ebc9c97b656..59a97dbb8c6 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -228,7 +228,7 @@ Leave mails for this many days" :value 14))))) (boolean :tag "Plugged")))))))) (defcustom mail-source-ignore-errors nil - "*Ignore errors when querying mail sources. + "Ignore errors when querying mail sources. If nil, the user will be prompted when an error occurs. If non-nil, the error will be ignored." :version "22.1" @@ -236,13 +236,13 @@ the error will be ignored." :type 'boolean) (defcustom mail-source-primary-source nil - "*Primary source for incoming mail. + "Primary source for incoming mail. If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'sexp) (defcustom mail-source-flash t - "*If non-nil, flash periodically when mail is available." + "If non-nil, flash periodically when mail is available." :group 'mail-source :type 'boolean) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d4313e0b2f9..448ba7b9971 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1,4 +1,4 @@ -;;; message.el --- composing mail and news messages +;;; message.el --- composing mail and news messages -*- lexical-binding: t -*- ;; Copyright (C) 1996-2016 Free Software Foundation, Inc. @@ -48,6 +48,8 @@ (require 'dired) (require 'mm-util) (require 'rfc2047) +(require 'puny) +(require 'subr-x) (autoload 'mailclient-send-it "mailclient") @@ -114,12 +116,12 @@ :group 'faces) (defcustom message-directory "~/Mail/" - "*Directory from which all other mail file variables are derived." + "Directory from which all other mail file variables are derived." :group 'message-various :type 'directory) (defcustom message-max-buffers 10 - "*How many buffers to keep before starting to kill them off." + "How many buffers to keep before starting to kill them off." :group 'message-buffers :type 'integer) @@ -129,7 +131,7 @@ :type '(choice function (const nil))) (defcustom message-fcc-handler-function 'message-output - "*A function called to save outgoing articles. + "A function called to save outgoing articles. This function will be called with the name of the file to store the article in. The default function is `message-output' which saves in Unix mailbox format." @@ -145,7 +147,7 @@ mailbox format." (defcustom message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. + "This is inserted at the start of a mailed copy of a posted message. If the string contains the format spec \"%s\", the Newsgroups the article has been posted to will be inserted there. If this variable is nil, no such courtesy message will be added." @@ -154,7 +156,7 @@ If this variable is nil, no such courtesy message will be added." (defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\|Delivered-To\\):" - "*Regexp that matches headers to be removed in resent bounced mail." + "Regexp that matches headers to be removed in resent bounced mail." :group 'message-interface :type 'regexp) @@ -186,7 +188,7 @@ Otherwise, most addresses look like `angles', but they look like (defcustom message-syntax-checks (if message-insert-canlock '((sender . disabled)) nil) ;; Guess this one shouldn't be easy to customize... - "*Controls what syntax checks should not be performed on outgoing posts. + "Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add `(signature . disabled)' to this list. @@ -204,7 +206,7 @@ and `valid-newsgroups'." (defcustom message-required-headers '((optional . References) From) - "*Headers to be generated or prompted for when sending a message. + "Headers to be generated or prompted for when sending a message. Also see `message-required-news-headers' and `message-required-mail-headers'." :version "22.1" @@ -214,7 +216,7 @@ Also see `message-required-news-headers' and :type '(repeat sexp)) (defcustom message-draft-headers '(References From Date) - "*Headers to be generated when saving a draft message." + "Headers to be generated when saving a draft message." :version "22.1" :group 'message-news :group 'message-headers @@ -225,7 +227,7 @@ Also see `message-required-news-headers' and '(From Newsgroups Subject Date Message-ID (optional . Organization) (optional . User-Agent)) - "*Headers to be generated or prompted for when posting an article. + "Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines, In-Reply-To, Expires, and User-Agent are optional. If you don't want message to insert some @@ -238,7 +240,7 @@ header, remove it from this list." (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID (optional . User-Agent)) - "*Headers to be generated or prompted for when mailing a message. + "Headers to be generated or prompted for when mailing a message. It is recommended that From, Date, To, Subject and Message-ID be included. Organization and User-Agent are optional." :group 'message-mail @@ -263,7 +265,7 @@ This is a list of regexps and regexp matches." (defcustom message-ignored-news-headers "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:" - "*Regexp of headers to be removed unconditionally before posting." + "Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :link '(custom-manual "(message)Message Headers") @@ -276,14 +278,14 @@ This is a list of regexps and regexp matches." (defcustom message-ignored-mail-headers "^\\([GF]cc\\|Resent-Fcc\\|Xref\\|X-Draft-From\\|X-Gnus-Agent-Meta-Information\\):" - "*Regexp of headers to be removed unconditionally before mailing." + "Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers :link '(custom-manual "(message)Mail Headers") :type 'regexp) (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:" - "*Header lines matching this regexp will be deleted before posting. + "Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." :group 'message-interface @@ -297,7 +299,7 @@ any confusion." (defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" - "*Regexp matching \"Re: \" in the subject line." + "Regexp matching \"Re: \" in the subject line." :group 'message-various :link '(custom-manual "(message)Message Headers") :type 'regexp) @@ -305,7 +307,7 @@ any confusion." ;;; Start of variables adopted from `message-utils.el'. (defcustom message-subject-trailing-was-query t - "*What to do with trailing \"(was: <old subject>)\" in subject lines. + "What to do with trailing \"(was: <old subject>)\" in subject lines. If nil, leave the subject unchanged. If it is the symbol `ask', query the user what do do. In this case, the subject is matched against `message-subject-trailing-was-ask-regexp'. If @@ -321,7 +323,7 @@ used." (defcustom message-subject-trailing-was-ask-regexp "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)" - "*Regexp matching \"(was: <old subject>)\" in the subject line. + "Regexp matching \"(was: <old subject>)\" in the subject line. The function `message-strip-subject-trailing-was' uses this regexp if `message-subject-trailing-was-query' is set to the symbol `ask'. If @@ -336,7 +338,7 @@ It is okay to create some false positives here, as the user is asked." (defcustom message-subject-trailing-was-regexp "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)" - "*Regexp matching \"(was: <old subject>)\" in the subject line. + "Regexp matching \"(was: <old subject>)\" in the subject line. If `message-subject-trailing-was-query' is set to t, the subject is matched against `message-subject-trailing-was-regexp' in @@ -437,7 +439,7 @@ whitespace)." :group 'message-various) (defcustom message-elide-ellipsis "\n[...]\n\n" - "*The string which is inserted for elided text. + "The string which is inserted for elided text. This is a format-spec string, and you can use %l to say how many lines were removed, and %c to say how many characters were removed." @@ -463,7 +465,7 @@ A value of nil means let mailer mail back a message to report errors." :type 'boolean) (defcustom message-generate-new-buffers 'unsent - "*Say whether to create a new message buffer to compose a message. + "Say whether to create a new message buffer to compose a message. Valid values include: nil @@ -496,13 +498,13 @@ function (function :format "\n %{%t%}: %v"))) (defcustom message-kill-buffer-on-exit nil - "*Non-nil means that the message buffer will be killed after sending a message." + "Non-nil means that the message buffer will be killed after sending a message." :group 'message-buffers :link '(custom-manual "(message)Message Buffers") :type 'boolean) (defcustom message-kill-buffer-query t - "*Non-nil means that killing a modified message buffer has to be confirmed. + "Non-nil means that killing a modified message buffer has to be confirmed. This is used by `message-kill-buffer'." :version "23.1" ;; No Gnus :group 'message-buffers @@ -524,14 +526,14 @@ If t, use `message-user-organization-file'." (when (file-readable-p f) (setq orgfile f))) orgfile) - "*Local news organization file." + "Local news organization file." :type '(choice (const nil) file) :link '(custom-manual "(message)News Headers") :group 'message-headers) (defcustom message-make-forward-subject-function #'message-forward-subject-name-subject - "*List of functions called to generate subject headers for forwarded messages. + "List of functions called to generate subject headers for forwarded messages. The subject generated by the previous function is passed into each successive function. @@ -551,7 +553,7 @@ The provided functions are: (repeat :tag "List of functions" function))) (defcustom message-forward-as-mime t - "*Non-nil means forward messages as an inline/rfc822 MIME section. + "Non-nil means forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message." :version "21.1" :group 'message-forwarding @@ -559,7 +561,7 @@ Otherwise, directly inline the old message in the forwarded message." :type 'boolean) (defcustom message-forward-show-mml 'best - "*Non-nil means show forwarded messages as MML (decoded from MIME). + "Non-nil means show forwarded messages as MML (decoded from MIME). Otherwise, forwarded messages are unchanged. Can also be the symbol `best' to indicate that MML should be used, except when it is a bad idea to use MML. One example where @@ -573,12 +575,12 @@ digital signature." (const :tag "use MML when appropriate" best))) (defcustom message-forward-before-signature t - "*Non-nil means put forwarded message before signature, else after." + "Non-nil means put forwarded message before signature, else after." :group 'message-forwarding :type 'boolean) (defcustom message-wash-forwarded-subjects nil - "*Non-nil means try to remove as much cruft as possible from the subject. + "Non-nil means try to remove as much cruft as possible from the subject. Done before generating the new subject of a forward." :group 'message-forwarding :link '(custom-manual "(message)Forwarding") @@ -592,7 +594,7 @@ Done before generating the new subject of a forward." ;; bounced with a "mailing loop" error). "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\ \\|^X-Content-Length:\\|^X-UIDL:" - "*All headers that match this regexp will be deleted when resending a message." + "All headers that match this regexp will be deleted when resending a message." :version "24.4" :group 'message-interface :link '(custom-manual "(message)Resending") @@ -604,7 +606,7 @@ Done before generating the new subject of a forward." regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message. + "All headers that match this regexp will be deleted when forwarding a message. This may also be a list of regexps." :version "21.1" :group 'message-forwarding @@ -629,13 +631,13 @@ variable should be a regexp or a list of regexps." regexp)) (defcustom message-ignored-cited-headers "." - "*Delete these headers from the messages you yank." + "Delete these headers from the messages you yank." :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") :type 'regexp) (defcustom message-cite-prefix-regexp mail-citation-prefix-regexp - "*Regexp matching the longest possible citation prefix on a line." + "Regexp matching the longest possible citation prefix on a line." :version "24.1" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") @@ -746,7 +748,7 @@ These are used when composing a wide reply." :type '(repeat string)) (defcustom message-use-followup-to 'ask - "*Specifies what to do with Followup-To header. + "Specifies what to do with Followup-To header. If nil, always ignore the header. If it is t, use its value, but query before using the \"poster\" value. If it is the symbol `ask', always query the user whether to use the value. If it is the symbol @@ -759,7 +761,7 @@ always query the user whether to use the value. If it is the symbol (const ask))) (defcustom message-use-mail-followup-to 'use - "*Specifies what to do with Mail-Followup-To header. + "Specifies what to do with Mail-Followup-To header. If nil, always ignore the header. If it is the symbol `ask', always query the user whether to use the value. If it is the symbol `use', always use the value." @@ -771,7 +773,7 @@ always use the value." (const ask))) (defcustom message-subscribed-address-functions nil - "*Specifies functions for determining list subscription. + "Specifies functions for determining list subscription. If nil, do not attempt to determine list subscription with functions. If non-nil, this variable contains a list of functions which return regular expressions to match lists. These functions can be used in @@ -783,7 +785,7 @@ conjunction with `message-subscribed-regexps' and :type '(repeat sexp)) (defcustom message-subscribed-address-file nil - "*A file containing addresses the user is subscribed to. + "A file containing addresses the user is subscribed to. If nil, do not look at any files to determine list subscriptions. If non-nil, each line of this file should be a mailing list address." :version "22.1" @@ -792,7 +794,7 @@ non-nil, each line of this file should be a mailing list address." :type '(radio file (const nil))) (defcustom message-subscribed-addresses nil - "*Specifies a list of addresses the user is subscribed to. + "Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of addresses can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-regexps'." @@ -802,7 +804,7 @@ addresses can be used in conjunction with :type '(repeat string)) (defcustom message-subscribed-regexps nil - "*Specifies a list of addresses the user is subscribed to. + "Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of regular expressions can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-addresses'." @@ -824,7 +826,7 @@ symbol `never', the posting is not allowed. If it is the symbol (const ask))) (defcustom message-sendmail-f-is-evil nil - "*Non-nil means don't add \"-f username\" to the sendmail command line. + "Non-nil means don't add \"-f username\" to the sendmail command line. Doing so would be even more evil than leaving it out." :group 'message-sending :link '(custom-manual "(message)Mail Variables") @@ -833,7 +835,7 @@ Doing so would be even more evil than leaving it out." (defcustom message-sendmail-envelope-from ;; `mail-envelope-from' is unavailable unless sendmail.el is loaded. (if (boundp 'mail-envelope-from) mail-envelope-from) - "*Envelope-from when sending mail with sendmail. + "Envelope-from when sending mail with sendmail. If this is nil, use `user-mail-address'. If it is the symbol `header', use the From: header of the message." :version "23.2" @@ -881,7 +883,7 @@ might set this variable to (\"-f\" \"you@some.where\")." ((boundp 'gnus-select-method) gnus-select-method) (t '(nnspool ""))) - "*Method used to post news. + "Method used to post news. Note that when posting from inside Gnus, for instance, this variable isn't used." :group 'message-news @@ -962,7 +964,7 @@ the signature is inserted." :group 'message-various) (defcustom message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line. + "Function called to insert the \"Whomever writes:\" line. Predefined functions include `message-insert-citation-line' and `message-insert-formatted-citation-line' (see the variable @@ -1011,7 +1013,7 @@ Please also read the note in the documentation of :group 'message-insertion) (defcustom message-yank-prefix mail-yank-prefix - "*Prefix inserted on the lines of yanked messages. + "Prefix inserted on the lines of yanked messages. Fix `message-cite-prefix-regexp' if it is set to an abnormal value. See also `message-yank-cited-prefix' and `message-yank-empty-prefix'." :version "23.2" @@ -1020,7 +1022,7 @@ See also `message-yank-cited-prefix' and `message-yank-empty-prefix'." :group 'message-insertion) (defcustom message-yank-cited-prefix ">" - "*Prefix inserted on cited lines of yanked messages. + "Prefix inserted on cited lines of yanked messages. Fix `message-cite-prefix-regexp' if it is set to an abnormal value. See also `message-yank-prefix' and `message-yank-empty-prefix'." :version "22.1" @@ -1029,7 +1031,7 @@ See also `message-yank-prefix' and `message-yank-empty-prefix'." :group 'message-insertion) (defcustom message-yank-empty-prefix ">" - "*Prefix inserted on empty lines of yanked messages. + "Prefix inserted on empty lines of yanked messages. See also `message-yank-prefix' and `message-yank-cited-prefix'." :version "22.1" :type 'string @@ -1037,7 +1039,7 @@ See also `message-yank-prefix' and `message-yank-cited-prefix'." :group 'message-insertion) (defcustom message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. + "Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'." :version "23.2" :group 'message-insertion @@ -1045,7 +1047,7 @@ Used by `message-yank-original' via `message-yank-cite'." :type 'integer) (defcustom message-cite-function 'message-cite-original-without-signature - "*Function for citing an original message. + "Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. Note that these functions use `mail-citation-hook' if that is non-nil." @@ -1058,7 +1060,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil." :group 'message-insertion) (defcustom message-indent-citation-function 'message-indent-citation - "*Function for modifying a citation just inserted in the mail buffer. + "Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave point and mark around the citation text as modified." @@ -1067,7 +1069,7 @@ point and mark around the citation text as modified." :group 'message-insertion) (defcustom message-signature mail-signature - "*String to be inserted at the end of the message buffer. + "String to be inserted at the end of the message buffer. If t, the `message-signature-file' file will be inserted instead. If a function, the result from the function will be used instead. If a form, the result from the form will be used instead." @@ -1080,7 +1082,7 @@ If a form, the result from the form will be used instead." :group 'message-insertion) (defcustom message-signature-file mail-signature-file - "*Name of file containing the text inserted at end of message buffer. + "Name of file containing the text inserted at end of message buffer. Ignored if the named file doesn't exist. If nil, don't insert a signature. If a path is specified, the value of `message-signature-directory' is ignored, @@ -1091,7 +1093,7 @@ even if set." :group 'message-insertion) (defcustom message-signature-directory nil - "*Name of directory containing signature files. + "Name of directory containing signature files. Comes in handy if you have many such files, handled via posting styles for instance. If nil, `message-signature-file' is expected to specify the directory if @@ -1101,14 +1103,14 @@ needed." :group 'message-insertion) (defcustom message-signature-insert-empty-line t - "*If non-nil, insert an empty line before the signature separator." + "If non-nil, insert an empty line before the signature separator." :version "22.1" :type 'boolean :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) (defcustom message-cite-reply-position 'traditional - "*Where the reply should be positioned. + "Where the reply should be positioned. If `traditional', reply inline. If `above', reply above quoted text. If `below', reply below quoted text. @@ -1125,7 +1127,7 @@ e.g. using `gnus-posting-styles': :group 'message-insertion) (defcustom message-cite-style nil - "*The overall style to be used when yanking cited text. + "The overall style to be used when yanking cited text. Value is either nil (no variable overrides) or a let-style list of pairs (VARIABLE VALUE) that will be bound in `message-yank-original' to do the quoting. @@ -1174,7 +1176,7 @@ use in `gnus-posting-styles', such as: "Message citation style used by Gmail. Use with message-cite-style.") (defcustom message-distribution-function nil - "*Function called to return a Distribution header." + "Function called to return a Distribution header." :group 'message-news :group 'message-headers :link '(custom-manual "(message)News Headers") @@ -1250,7 +1252,7 @@ called and its result is inserted." (stringp mail-archive-file-name)) (format "FCC: %s\n" mail-archive-file-name)) mail-default-headers) - "*A string of header lines to be inserted in outgoing mails." + "A string of header lines to be inserted in outgoing mails." :version "23.2" :group 'message-headers :group 'message-mail @@ -1258,7 +1260,7 @@ called and its result is inserted." :type 'message-header-lines) (defcustom message-default-news-headers "" - "*A string of header lines to be inserted in outgoing news articles." + "A string of header lines to be inserted in outgoing news articles." :group 'message-headers :group 'message-news :link '(custom-manual "(message)News Headers") @@ -1280,7 +1282,7 @@ called and its result is inserted." ;; 33 and 126, except colon)", i. e., any chars except ctl chars, ;; space, or colon. '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "*Set this non-nil if the system's mailer runs the header and body together. + "Set this non-nil if the system's mailer runs the header and body together. \(This problem exists on Sunos 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will actually occur." @@ -1312,7 +1314,7 @@ PREDICATE returns non-nil. FUNCTION is called with one parameter -- the prefix.") (defcustom message-mail-alias-type 'abbrev - "*What alias expansion type to use in Message buffers. + "What alias expansion type to use in Message buffers. The default is `abbrev', which uses mailabbrev. `ecomplete' uses an electric completion mode. nil switches mail aliases off. This can also be a list of values." @@ -1336,7 +1338,7 @@ text and it replaces `self-insert-command' with the other command, e.g. (if (file-writable-p message-directory) (file-name-as-directory (expand-file-name "drafts" message-directory)) "~/") - "*Directory where Message auto-saves buffers if Gnus isn't running. + "Directory where Message auto-saves buffers if Gnus isn't running. If nil, Message won't auto-save." :group 'message-buffers :link '(custom-manual "(message)Various Message Variables") @@ -1351,7 +1353,7 @@ If nil, you might be asked to input the charset." :type 'symbol) (make-obsolete-variable 'message-default-charset - "The default charset comes from the language environment" "25.2") + "The default charset comes from the language environment" "26.1") (defcustom message-dont-reply-to-names mail-dont-reply-to-names "Addresses to prune when doing wide replies. @@ -1371,8 +1373,8 @@ If a function email is passed as the argument." message-dont-reply-to-names (gmm-regexp-concat message-dont-reply-to-names))) -(defvar message-shoot-gnksa-feet nil - "*A list of GNKSA feet you are allowed to shoot. +(defcustom message-shoot-gnksa-feet nil + "A list of GNKSA feet you are allowed to shoot. Gnus gives you all the opportunity you could possibly want for shooting yourself in the foot. Also, Gnus allows you to shoot the feet of Good Net-Keeping Seal of Approval. The following are foot @@ -1382,7 +1384,11 @@ candidates: `multiple-copies' Allow you to post multiple copies; `cancel-messages' Allow you to cancel or supersede messages from your other email addresses; -`canlock-verify' Allow you to cancel messages without verifying canlock.") +`canlock-verify' Allow you to cancel messages without verifying canlock." + :group 'message + :type '(set (const empty-article) (const quoted-text-only) + (const multiple-copies) (const cancel-messages) + (const canlock-verify))) (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) @@ -1686,7 +1692,7 @@ should be sent in several parts. If it is nil, the size is unlimited." (integer 1000000))) (defcustom message-alternative-emails nil - "*Regexp or predicate function matching alternative email addresses. + "Regexp or predicate function matching alternative email addresses. The first address in the To, Cc or From headers of the original article matching this variable is used as the From field of outgoing messages. @@ -1749,32 +1755,16 @@ no, only reply back to the author." :type 'boolean) (defcustom message-user-fqdn nil - "*Domain part of Message-Ids." + "Domain part of Message-Ids." :version "22.1" :group 'message-headers :link '(custom-manual "(message)News Headers") :type '(radio (const :format "%v " nil) (string :format "FQDN: %v"))) -(defcustom message-use-idna - (and (or (mm-coding-system-p 'utf-8) - (condition-case nil - (let (mucs-ignore-version-incompatibilities) - (require 'un-define)) - (error))) - (condition-case nil - (require 'idna) - (file-error) - (invalid-operation)) - idna-program - (executable-find idna-program) - (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o") - t) - "Whether to encode non-ASCII in domain names into ASCII according to IDNA. -GNU Libidn, and in particular the elisp package \"idna.el\" and -the external program \"idn\", must be installed for this -functionality to work." - :version "22.1" +(defcustom message-use-idna t + "Whether to encode non-ASCII in domain names into ASCII according to IDNA." + :version "26.1" :group 'message-headers :link '(custom-manual "(message)IDNA") :type '(choice (const :tag "Ask" ask) @@ -1782,7 +1772,7 @@ functionality to work." (const :tag "Always" t))) (defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic) - "*Whether to generate X-Hashcash: headers. + "Whether to generate X-Hashcash: headers. If t, always generate hashcash headers. If `opportunistic', only generate hashcash headers if it can be done without the user waiting (i.e., only asynchronously). @@ -1926,7 +1916,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-server-string "gnus") -(autoload 'idna-to-ascii "idna") (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") (autoload 'mh-send-letter "mh-comp") @@ -3879,8 +3868,13 @@ This function uses `mail-citation-hook' if that is non-nil." (defun message-insert-formatted-citation-line (&optional from date tz) "Function that inserts a formatted citation line. The optional FROM, and DATE are strings containing the contents of -the From header and the Date header respectively. The optional TZ -is a number of seconds, overrides the time zone of DATE. +the From header and the Date header respectively. + +The optional TZ is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as +in the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') +applied without consideration for daylight saving time. See `message-citation-line-format'." ;; The optional args are for testing/debugging. They will disappear later. @@ -3971,7 +3965,7 @@ See `message-citation-line-format'." (>= i ?a))) (push i lst) (push (condition-case nil - (gmm-format-time-string (format "%%%c" i) time tz) + (format-time-string (format "%%%c" i) time tz) (error (format ">%c<" i))) lst)) (setq i (1+ i))) @@ -4487,7 +4481,7 @@ This function could be useful in `message-setup-hook'." (declare-function hashcash-wait-async "hashcash" (&optional buffer)) -(defun message-send-mail (&optional arg) +(defun message-send-mail (&optional _) (require 'mail-utils) (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) @@ -4556,7 +4550,7 @@ This function could be useful in `message-setup-hook'." (setq message-options options) ;; Avoid copying text props (except hard newlines). (insert (with-current-buffer mailbuf - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some (point-min) (point-max)))) ;; Remove some headers. (message-encode-message-body) @@ -4644,6 +4638,8 @@ If you always want Gnus to send messages in one piece, set (push 'mail message-sent-message-via))) (defvar sendmail-program) +(defvar smtpmail-smtp-server) +(defvar smtpmail-smtp-service) (defvar smtpmail-smtp-user) (defun message-multi-smtp-send-mail () @@ -4823,6 +4819,8 @@ command evaluates `message-send-mail-hook' just before sending a message." (run-hooks 'message-send-mail-hook) (mailclient-send-it)) +(defvar sha1-maximum-internal-length) + (defun message-canlock-generate () "Return a string that is non-trivial to guess. Do not use this for anything important, it is cryptographically weak." @@ -4920,7 +4918,7 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Avoid copying text props (except hard newlines). (insert (with-current-buffer messbuf - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some (point-min) (point-max)))) (message-encode-message-body) ;; Remove some headers. @@ -5415,9 +5413,7 @@ Otherwise, generate and save a value for `canlock-password' first." (setq file (pop list)) (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil shell-command-switch - (match-string 1 file)) + (call-shell-region (point-min) (point-max) (match-string 1 file)) ;; Save the article. (setq file (expand-file-name file)) (unless (file-exists-p (file-name-directory file)) @@ -5862,7 +5858,7 @@ subscribed address (and not the additional To and Cc header contents)." ;; the domain part, i.e., if it is a local user's address. (setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs) rhs - (downcase (idna-to-ascii rhs)))) + (downcase (puny-encode-domain rhs)))) (when (and (not (equal rhs ace)) (or (not (eq message-use-idna 'ask)) (y-or-n-p (format "Replace %s with %s in %s:? " @@ -6247,7 +6243,7 @@ When point is at the first header line, moves it after the colon and spaces separating header name and header value. When point is in a continuation line of a folded header (i.e. the -line starts with a space), the behaviour depends on HANDLE-FOLDED +line starts with a space), the behavior depends on HANDLE-FOLDED argument. If it’s nil, function moves the point to the start of the header continuation; otherwise, function locates the beginning of the header and moves point past the colon as is the @@ -7637,6 +7633,9 @@ is for the internal use." (let ((case-fold-search t)) (re-search-forward "^mime-version:" nil t))) (message-inhibit-ecomplete t) + ;; We don't want smtpmail.el to encode anything, either. + (sendmail-coding-system 'raw-text) + (select-safe-coding-system-function nil) message-required-mail-headers message-generate-hashcash rfc2047-encode-encoded-words) @@ -7914,7 +7913,7 @@ Each element is a symbol and can be `bbdb' or `eudc'." :type '(set (const bbdb) (const eudc))) (defcustom message-tab-body-function nil - "*Function to execute when `message-tab' (TAB) is executed in the body. + "Function to execute when `message-tab' (TAB) is executed in the body. If nil, the function bound in `text-mode-map' or `global-map' is executed." :version "22.1" :group 'message @@ -8394,30 +8393,33 @@ Used in `message-simplify-recipients'." (defun message-toggle-image-thumbnails () "For any included image files, insert a thumbnail of that image." (interactive) - (let ((overlays (overlays-in (point-min) (point-max))) - (displayed nil)) - (while overlays - (let ((overlay (car overlays))) - (when (overlay-get overlay 'put-image) - (delete-overlay overlay) - (setq displayed t))) - (setq overlays (cdr overlays))) + (let ((displayed nil)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when-let ((props (get-text-property (point) 'display))) + (when (and (consp props) + (eq (car props) 'image)) + (put-text-property (point) (1+ (point)) 'display nil) + (setq displayed t))) + (forward-char 1))) (unless displayed (save-excursion (goto-char (point-min)) - (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t) - (let ((file (match-string 1)) + (while (re-search-forward "<img.*src=\"\\([^\"]+\\).*>" nil t) + (let ((string (match-string 0)) + (file (match-string 1)) (edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))) - (put-image + (delete-region (match-beginning 0) (match-end 0)) + (insert-image (create-image file 'imagemagick nil :max-width (truncate (* 0.7 (- (nth 2 edges) (nth 0 edges)))) :max-height (truncate (* 0.5 (- (nth 3 edges) (nth 1 edges))))) - (match-beginning 0) - " "))))))) + string))))))) (provide 'message) diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el deleted file mode 100644 index 6eadf2aab23..00000000000 --- a/lisp/gnus/messcompat.el +++ /dev/null @@ -1,91 +0,0 @@ -;;; messcompat.el --- making message mode compatible with mail mode - -;; Copyright (C) 1996-2016 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file tries to provide backward compatibility with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If nil, they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley <king@grassland.com> - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(if (boundp 'mail-mode-hook) - (defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.")) - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;; Deleted the autoload cookie because this crashes in loaddefs.el. -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of the message buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(defvar message-send-mail-function send-mail-function - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'.") - -(provide 'messcompat) - -;;; messcompat.el ends here diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index f45337dc042..3127a22e41d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -425,13 +425,15 @@ functions), `mm-file-name-delete-whitespace', :group 'mime-display) -(defvar mm-path-name-rewrite-functions nil - "*List of functions for rewriting the full file names of MIME parts. +(defcustom mm-path-name-rewrite-functions nil + "List of functions for rewriting the full file names of MIME parts. This is used when viewing parts externally, and is meant for transforming the absolute name so that non-compliant programs can find the file where it's saved. -Each function takes a file name as input and returns a file name.") +Each function takes a file name as input and returns a file name." + :type '(repeat function) + :group 'mime-display) (defvar mm-file-name-replace-whitespace nil "String used for replacing whitespace characters; default is `\"_\"'.") @@ -1834,14 +1836,14 @@ If RECURSIVE, search recursively." (delete-region ,(point-min-marker) ,(point-max-marker)))))))) -(defvar shr-map) (defvar shr-image-map) (autoload 'widget-convert-button "wid-edit") +(defvar widget-keymap) (defun mm-convert-shr-links () (let ((start (point-min)) - end) + end keymap) (while (and start (< start (point-max))) (when (setq start (text-property-not-all start (point-max) 'shr-url nil)) @@ -1849,10 +1851,18 @@ If RECURSIVE, search recursively." (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - ;;; FIXME Should only use the image map on images. - :keymap shr-image-map + :keymap (setq keymap (copy-keymap shr-image-map)) (get-text-property start 'shr-url)) - (put-text-property start end 'local-map nil) + ;; Mask keys that launch `widget-button-click'. + ;; Those bindings are provided by `widget-keymap' + ;; that is a parent of `gnus-article-mode-map'. + (dolist (key (where-is-internal #'widget-button-click widget-keymap)) + (unless (lookup-key keymap key) + (define-key keymap key #'ignore))) + ;; Avoid `shr-next-link' and `shr-previous-link' in `keymap' so + ;; TAB and M-TAB run `widget-forward' and `widget-backward' instead. + (substitute-key-definition 'shr-next-link nil keymap) + (substitute-key-definition 'shr-previous-link nil keymap) (dolist (overlay (overlays-at start)) (overlay-put overlay 'face nil)) (setq start end))))) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 69192667948..76c37722995 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -45,7 +45,7 @@ (condition-case nil (require 'url) (error nil))) - "*If non-nil, use external grab program `mm-url-program'." + "If non-nil, use external grab program `mm-url-program'." :version "22.1" :type 'boolean :group 'mm-url) @@ -245,7 +245,7 @@ Likely values are `wget', `w3m', `lynx' and `curl'." ;; To be done ;; (shy . ????) ; soft hyphen ) - "*An assoc list of entity names and how to actually display them.") + "An assoc list of entity names and how to actually display them.") (defconst mm-url-unreserved-chars '( @@ -402,43 +402,54 @@ spaces. Die Die Die." (autoload 'mml-compute-boundary "mml") -(defun mm-url-encode-multipart-form-data (pairs &optional boundary) - "Return PAIRS encoded in multipart/form-data." +(defun mm-url-encode-multipart-form-data (data &optional boundary) + "Return DATA encoded in multipart/form-data. +DATA is a list where the elements can have the following form: + (\"NAME\" . \"VALUE\") + (\"submit\") + (\"file\" . ((\"name\" . \"NAME\") + (\"filename\" . \"FILENAME\") + (\"content-type\" . \"CONTENT-TYPE\") + (\"filedata\" . \"FILEDATA\"))) +Lowercase strings above are literals and uppercase are not." ;; RFC1867 - ;; Get a good boundary + ;; Get a good boundary. (unless boundary (setq boundary (mml-compute-boundary '()))) - (concat - ;; Start with the boundary - "--" boundary "\r\n" - ;; Create name value pairs - (mapconcat - 'identity - ;; Delete any returned items that are empty - (delq nil - (mapcar (lambda (data) - (cond ((equal (car data) "file") - ;; For each pair - (format - ;; Encode the name - "Content-Disposition: form-data; name=%S; filename=%S\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s" - (cdr (assoc "name" (cdr data))) (cdr (assoc "filename" (cdr data))) - (cond ((stringp (cdr (assoc "filedata" (cdr data)))) - (cdr (assoc "filedata" (cdr data)))) - ((integerp (cdr (assoc "filedata" (cdr data)))) - (number-to-string (cdr (assoc "filedata" (cdr data)))))))) - ((equal (car data) "submit") - "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n") - (t - (format - "Content-Disposition: form-data;name=%S\r\n\r\n%s\r\n" - (car data) (concat (mm-url-form-encode-xwfu (cdr data))) - )))) - pairs)) - ;; use the boundary as a separator - (concat "\r\n--" boundary "\r\n")) - ;; put a boundary at the end. - "--" boundary "--\r\n")) + (with-temp-buffer + (set-buffer-multibyte nil) + (dolist (elem data) + (let ((name (car elem)) + (value (cdr elem))) + (insert "--" boundary "\r\n") + (cond + ((equal name "file") + (insert (format + "Content-Disposition: form-data; name=%S; filename=%S\r\n" + (or (cdr (assoc "name" value)) name) + (cdr (assoc "filename" value)))) + (insert "Content-Transfer-Encoding: binary\r\n") + (insert (format "Content-Type: %s\r\n\r\n" + (or (cdr (assoc "content-type" value)) + "text/plain"))) + (let ((filedata (cdr (assoc "filedata" value)))) + (cond + ((stringp filedata) + (insert filedata)) + ;; How can this possibly be useful? + ((integerp filedata) + (insert (number-to-string filedata)))))) + ((equal name "submit") + (insert + "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")) + (t + (insert (format "Content-Disposition: form-data; name=%S\r\n\r\n" + name)) + (insert value))) + (unless (bolp) + (insert "\r\n")))) + (insert "--" boundary "--\r\n") + (buffer-string))) (defun mm-url-remove-markup () "Remove all HTML markup, leaving just plain text." diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index c0f8742504e..59ab7913912 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -420,7 +420,7 @@ variable is set, it overrides the default priority." Setting it to nil is useful on Emacsen supporting Unicode if sending mail with multiple parts is preferred to sending a Unicode one.") -(defvar mm-extra-numeric-entities +(defcustom mm-extra-numeric-entities (mapcar (lambda (item) (cons (car item) (mm-ucs-to-char (cdr item)))) @@ -433,7 +433,9 @@ mail with multiple parts is preferred to sending a Unicode one.") (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178))) "*Alist of extra numeric entities and characters other than ISO 10646. This table is used for decoding extra numeric entities to characters, -like \"€\" to the euro sign, mainly in html messages.") +like \"€\" to the euro sign, mainly in html messages." + :type '(alist :key-type character :value-type character) + :group 'mime) ;;; Internal variables: @@ -755,7 +757,7 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (write-region start end filename append visit lockname))) (defalias 'mm-make-temp-file 'make-temp-file) -(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "25.2") +(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "26.1") (defvar mm-image-load-path-cache nil) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 049890e2e30..4927a5e660d 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -43,7 +43,7 @@ (autoload 'yenc-extract-filename "yenc") (defcustom mm-uu-decode-function 'uudecode-decode-region - "*Function to uudecode. + "Function to uudecode. Internal function is done in Lisp by default, therefore decoding may appear to be horribly slow. You can make Gnus use an external decoder, such as uudecode." @@ -54,7 +54,7 @@ decoder, such as uudecode." :group 'gnus-article-mime) (defcustom mm-uu-binhex-decode-function 'binhex-decode-region - "*Function to binhex decode. + "Function to binhex decode. Internal function is done in elisp by default, therefore decoding may appear to be horribly slow . You can make Gnus use the external Unix decoder, such as hexbin." @@ -85,7 +85,7 @@ This can be either \"inline\" or \"attachment\".") :group 'gnus-article-mime) (defcustom mm-uu-tex-groups-regexp "\\.tex\\>" - "*Regexp matching TeX groups." + "Regexp matching TeX groups." :version "23.1" :type 'regexp :group 'gnus-article-mime) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index c62ea958da6..e934f8b2841 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -198,8 +198,10 @@ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defvar mm-w3m-standalone-supports-m17n-p 'undecided - "*T means the w3m command supports the m17n feature.") +(defcustom mm-w3m-standalone-supports-m17n-p 'undecided + "T means the w3m command supports the m17n feature." + :type '(choice (const nil) (const t) (other :tag "detect" undecided)) + :group 'mime-display) (defun mm-w3m-standalone-supports-m17n-p () "Say whether the w3m command supports the m17n feature." diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 576eceecf4b..0e2d4381993 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -38,6 +38,7 @@ (autoload 'mml1991-encrypt "mml1991") (autoload 'message-fetch-field "message") (autoload 'message-goto-body "message") +(autoload 'message-options-get "message") (autoload 'mml-insert-tag "mml") (autoload 'mml-smime-sign "mml-smime") (autoload 'mml-smime-encrypt "mml-smime") @@ -49,6 +50,8 @@ (autoload 'message-options-get "message") (autoload 'message-options-set "message") +(declare-function message-options-set "message" (symbol value)) + (defvar mml-sign-alist '(("smime" mml-smime-sign-buffer mml-smime-sign-query) ("pgp" mml-pgp-sign-buffer list) @@ -115,6 +118,7 @@ details." :group 'message :type 'boolean) +;; FIXME If it's "NOT recommended", why is it the default? (defcustom mml-secure-cache-passphrase password-cache "If t, cache OpenPGP or S/MIME passphrases inside Emacs. Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead. diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 02e602ce77f..b15accd631c 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -32,17 +32,17 @@ (autoload 'message-narrow-to-headers "message") (autoload 'message-fetch-field "message") -;; Prefer epg over openssl if it is available as epg uses GnuPG's gpgsm, +;; Prefer epg over openssl as epg uses GnuPG's gpgsm, ;; which features full-fledged certificate management, while openssl requires ;; major manual efforts for certificate revocation and expiry and has bugs ;; as documented under man smime(1). -(ignore-errors (require 'epg)) +(require 'epg) -(defcustom mml-smime-use (if (featurep 'epg) 'epg 'openssl) +(defcustom mml-smime-use 'epg "Whether to use OpenSSL or EasyPG (EPG) to handle S/MIME messages. -Defaults to EPG if it's available. -If you think about using OpenSSL, please read the BUGS section in the manual -for the `smime' command coming with OpenSSL first. EasyPG is recommended." +If you're thinking about using OpenSSL, please first read the BUGS section +in the manual for the `smime' command that comes with OpenSSL. +We recommend EasyPG." :group 'mime-security :type '(choice (const :tag "EPG" epg) (const :tag "OpenSSL" openssl))) @@ -349,10 +349,6 @@ Whether the passphrase is cached at all is controlled by (autoload 'mml-compute-boundary "mml") -;; We require mm-decode, which requires mm-bodies, which autoloads -;; message-options-get (!). -(declare-function message-options-set "message" (symbol value)) - (defun mml-smime-epg-sign (cont) (let ((inhibit-redisplay t) (boundary (mml-compute-boundary cont))) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 97cc87d06e3..6105f79ae23 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -58,7 +58,7 @@ (defcustom mml-content-type-parameters '(name access-type expiration size permission format) - "*A list of acceptable parameters in MML tag. + "A list of acceptable parameters in MML tag. These parameters are generated in Content-Type header if exists." :version "22.1" :type '(repeat (symbol :tag "Parameter")) @@ -66,7 +66,7 @@ These parameters are generated in Content-Type header if exists." (defcustom mml-content-disposition-parameters '(filename creation-date modification-date read-date) - "*A list of acceptable parameters in MML tag. + "A list of acceptable parameters in MML tag. These parameters are generated in Content-Disposition header if exists." :version "22.1" :type '(repeat (symbol :tag "Parameter")) @@ -148,17 +148,19 @@ is called. FUNCTION is a Lisp function which is called with the MML handle to tweak the part.") (defvar mml-externalize-attachments nil - "*If non-nil, local-file attachments are generated as external parts.") + "If non-nil, local-file attachments are generated as external parts.") -(defvar mml-generate-multipart-alist nil - "*Alist of multipart generation functions. +(defcustom mml-generate-multipart-alist nil + "Alist of multipart generation functions. Each entry has the form (NAME . FUNCTION), where NAME is a string containing the name of the part (without the leading \"/multipart/\"), FUNCTION is a Lisp function which is called to generate the part. The Lisp function has to supply the appropriate MIME headers and the -contents of this part.") +contents of this part." + :group 'message + :type '(alist :key-type string :value-type function)) (defvar mml-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) @@ -413,12 +415,21 @@ A message part needs to be split into %d charset parts. Really send? " (setq contents (append (list (cons 'tag-location orig-point)) contents)) (cons (intern name) (nreverse contents)))) -(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) +(defun mml-buffer-substring-no-properties-except-some (start end) (let ((str (buffer-substring-no-properties start end)) - (bufstart start) tmp) - (while (setq tmp (text-property-any start end 'hard 't)) - (set-text-properties (- tmp bufstart) (- tmp bufstart -1) - '(hard t) str) + (bufstart start) + tmp) + ;; Copy over all hard newlines. + (while (setq tmp (text-property-any start end 'hard t)) + (put-text-property (- tmp bufstart) (- tmp bufstart -1) + 'hard t str) + (setq start (1+ tmp))) + ;; Copy over all `display' properties (which are usually images). + (setq start bufstart) + (while (setq tmp (text-property-not-all start end 'display nil)) + (put-text-property (- tmp bufstart) (- tmp bufstart -1) + 'display (get-text-property tmp 'display) + str) (setq start (1+ tmp))) str)) @@ -435,21 +446,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (re-search-forward "<#\\(/\\)?mml." nil t) (setq count (+ count (if (match-beginning 1) -1 1))) (goto-char (point-max)))) - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (if (> count 0) (point) (match-beginning 0)))) (if (re-search-forward "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) (prog1 - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (match-beginning 0)) (if (or (not (match-beginning 1)) (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) - (mml-buffer-substring-no-properties-except-hard-newlines + (mml-buffer-substring-no-properties-except-some beg (goto-char (point-max))))))) (defvar mml-boundary nil) @@ -514,7 +525,9 @@ be \"related\" or \"alternate\"." (when (search-forward (url-filename parsed) end t) (let ((cid (format "fsf.%d" cid))) (replace-match (concat "cid:" cid) t t) - (push (list cid (url-filename parsed)) new-parts)) + (push (list cid (url-filename parsed) + (get-text-property start 'display)) + new-parts)) (setq cid (1+ cid))))))) ;; We have local images that we want to include. (if (not new-parts) @@ -527,11 +540,41 @@ be \"related\" or \"alternate\"." (setq cont (nconc cont (list `(part (type . "image/png") - (filename . ,(nth 1 new-part)) + ,@(mml--possibly-alter-image + (nth 1 new-part) + (nth 2 new-part)) (id . ,(concat "<" (nth 0 new-part) ">"))))))) cont)))) +(defun mml--possibly-alter-image (file-name image) + (if (or (null image) + (not (consp image)) + (not (eq (car image) 'image)) + (not (image-property image :rotation)) + (not (executable-find "exiftool"))) + `((filename . ,file-name)) + `((filename . ,file-name) + (buffer + . + ,(with-current-buffer (mml-generate-new-buffer " *mml rotation*") + (set-buffer-multibyte nil) + (call-process "exiftool" + file-name + (list (current-buffer) nil) + nil + (format "-Orientation#=%d" + (cl-case (truncate + (image-property image :rotation)) + (0 0) + (90 6) + (180 3) + (270 8) + (otherwise 0))) + "-o" "-" + "-") + (current-buffer)))))) + (defun mml-generate-mime-1 (cont) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 140f7201d80..f98984c1cdf 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -25,11 +25,6 @@ ;;; Code: -(eval-and-compile - (if (locate-library "password-cache") - (require 'password-cache) - (require 'password))) - (eval-when-compile (require 'cl) (require 'mm-util)) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 309f1a77ff0..774821320f1 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -27,16 +27,12 @@ ;;; Code: -(eval-and-compile - (if (locate-library "password-cache") - (require 'password-cache) - (require 'password))) - (eval-when-compile (require 'cl)) (require 'mm-decode) (require 'mm-util) (require 'mml) (require 'mml-sec) +(require 'epg-config) (defvar mc-pgp-always-sign) @@ -47,27 +43,7 @@ ;; Maybe this should be in eg mml-sec.el (and have a different name). ;; Then mml1991 would not need to require mml2015, and mml1991-use ;; could be removed. -(defvar mml2015-use (or - (progn - (ignore-errors (require 'epg-config)) - (and (fboundp 'epg-check-configuration) - 'epg)) - (progn - (let ((abs-file (locate-library "pgg"))) - ;; Don't load PGG if it is marked as obsolete - ;; (Emacs 24). - (when (and abs-file - (not (string-match "/obsolete/[^/]*\\'" - abs-file))) - (ignore-errors (require 'pgg)) - (and (fboundp 'pgg-sign-region) - 'pgg)))) - (progn (ignore-errors - (load "mc-toplev")) - (and (fboundp 'mc-encrypt-generic) - (fboundp 'mc-sign-generic) - (fboundp 'mc-cleanup-recipient-headers) - 'mailcrypt))) +(defvar mml2015-use 'epg "The package used for PGP/MIME. Valid packages include `epg', `pgg' and `mailcrypt'.") diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 71229dd9394..dbdbbadea87 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -97,7 +97,7 @@ (defcustom nndiary-mail-sources `((file :path ,(expand-file-name "~/.nndiary"))) - "*NNDiary specific mail sources. + "NNDiary specific mail sources. This variable is used by nndiary in place of the standard `mail-sources' variable when `nndiary-get-new-mail' is set to non-nil. These sources must contain diary messages ONLY." @@ -106,7 +106,7 @@ must contain diary messages ONLY." :type 'sexp) (defcustom nndiary-split-methods '(("diary" "")) - "*NNDiary specific split methods. + "NNDiary specific split methods. This variable is used by nndiary in place of the standard `nnmail-split-methods' variable when `nndiary-get-new-mail' is set to non-nil." @@ -118,7 +118,7 @@ non-nil." (defcustom nndiary-reminders '((0 . day)) - "*Different times when you want to be reminded of your appointments. + "Different times when you want to be reminded of your appointments. Diary articles will appear again, as if they'd been just received. Entries look like (3 . day) which means something like \"Please @@ -164,7 +164,7 @@ In order to make this clear, here are some examples: (const :format "%v" year))))) (defcustom nndiary-week-starts-on-monday nil - "*Whether a week starts on monday (otherwise, sunday)." + "Whether a week starts on monday (otherwise, sunday)." :type 'boolean :group 'nndiary) @@ -172,7 +172,7 @@ In order to make this clear, here are some examples: (define-obsolete-variable-alias 'nndiary-request-create-group-hooks 'nndiary-request-create-group-functions "24.3") (defcustom nndiary-request-create-group-functions nil - "*Hook run after `nndiary-request-create-group' is executed. + "Hook run after `nndiary-request-create-group' is executed. The hook functions will be called with the full group name as argument." :group 'nndiary :type 'hook) @@ -180,7 +180,7 @@ The hook functions will be called with the full group name as argument." (define-obsolete-variable-alias 'nndiary-request-update-info-hooks 'nndiary-request-update-info-functions "24.3") (defcustom nndiary-request-update-info-functions nil - "*Hook run after `nndiary-request-update-info-group' is executed. + "Hook run after `nndiary-request-update-info-group' is executed. The hook functions will be called with the full group name as argument." :group 'nndiary :type 'hook) @@ -188,14 +188,14 @@ The hook functions will be called with the full group name as argument." (define-obsolete-variable-alias 'nndiary-request-accept-article-hooks 'nndiary-request-accept-article-functions "24.3") (defcustom nndiary-request-accept-article-functions nil - "*Hook run before accepting an article. + "Hook run before accepting an article. Executed near the beginning of `nndiary-request-accept-article'. The hook functions will be called with the article in the current buffer." :group 'nndiary :type 'hook) (defcustom nndiary-check-directory-twice t - "*If t, check directories twice to avoid NFS failures." + "If t, check directories twice to avoid NFS failures." :group 'nndiary :type 'boolean) @@ -1278,27 +1278,27 @@ all. This may very well take some time.") (while (setq reminder (pop reminders)) (push (cond ((eq (cdr reminder) 'minute) - (subtract-time + (time-subtract (apply 'encode-time 0 (nthcdr 1 date-elts)) (seconds-to-time (* (car reminder) 60.0)))) ((eq (cdr reminder) 'hour) - (subtract-time + (time-subtract (apply 'encode-time 0 0 (nthcdr 2 date-elts)) (seconds-to-time (* (car reminder) 3600.0)))) ((eq (cdr reminder) 'day) - (subtract-time + (time-subtract (apply 'encode-time 0 0 0 (nthcdr 3 date-elts)) (seconds-to-time (* (car reminder) 86400.0)))) ((eq (cdr reminder) 'week) - (subtract-time + (time-subtract (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts)) (seconds-to-time (* (car reminder) 604800.0)))) ((eq (cdr reminder) 'month) - (subtract-time + (time-subtract (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts)) (seconds-to-time (* (car reminder) 18748800.0)))) ((eq (cdr reminder) 'year) - (subtract-time + (time-subtract (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) (seconds-to-time (* (car reminder) 400861056.0))))) res)) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index f10b6fa3df8..0c887f089d1 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -43,10 +43,12 @@ "Where nndraft will store its files." nnmh-directory) -(defvar nndraft-required-headers '(Date) - "*Headers to be generated when saving a draft message. +(defcustom nndraft-required-headers '(Date) + "Headers to be generated when saving a draft message. The headers in this variable and the ones in `message-required-headers' -are generated if and only if they are also in `message-draft-headers'.") +are generated if and only if they are also in `message-draft-headers'." + :type '(repeat sexp) + :group 'message-headers) ; FIXME wrong group diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 191a90892f3..6782229ad24 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -63,18 +63,23 @@ they will keep on jabbering all the time." :group 'gnus-server :type 'boolean) -(defvar nnheader-max-head-length 8192 - "*Max length of the head of articles. +(defcustom nnheader-max-head-length 8192 + "Max length of the head of articles. Value is an integer, nil, or t. nil means read in chunks of a file indefinitely until a complete head is found; t means always read the entire file immediately, disregarding `nnheader-head-chop-length'. Integer values will in effect be rounded up to the nearest multiple of -`nnheader-head-chop-length'.") - -(defvar nnheader-head-chop-length 2048 - "*Length of each read operation when trying to fetch HEAD headers.") +`nnheader-head-chop-length'." + :group 'gnus-article-various ; FIXME? + :type '(choice integer (const :tag "Read chunks" nil) + (const :tag "Read entire file" t))) + +(defcustom nnheader-head-chop-length 2048 + "Length of each read operation when trying to fetch HEAD headers." + :group 'gnus-article-various ; FIXME? + :type 'integer) (defvar nnheader-read-timeout (if (string-match "windows-nt\\|os/2\\|cygwin" @@ -99,7 +104,7 @@ Integer values will in effect be rounded up to the nearest multiple of "How long nntp should wait between checking for the end of output. Shorter values mean quicker response, but are more CPU intensive.") -(defvar nnheader-file-name-translation-alist +(defcustom nnheader-file-name-translation-alist (let ((case-fold-search t)) (cond ((string-match "windows-nt\\|os/2\\|cygwin" @@ -111,15 +116,19 @@ Shorter values mean quicker response, but are more CPU intensive.") nil '((?+ . ?-))))) (t nil))) - "*Alist that says how to translate characters in file names. + "Alist that says how to translate characters in file names. For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: -\(setq nnheader-file-name-translation-alist \\='((?: . ?_)))") +\(setq nnheader-file-name-translation-alist \\='((?: . ?_)))" + :group 'gnus-article-various ; FIXME? + :type '(alist :key-type character :value-type character)) -(defvar nnheader-directory-separator-character +(defcustom nnheader-directory-separator-character (string-to-char (substring (file-name-as-directory ".") -1)) - "*A character used to a directory separator.") + "A character used as a directory separator." + :group 'gnus-article-various ; FIXME? + :type 'character) (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") @@ -865,8 +874,10 @@ without formatting." (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends))) -(defvar nnheader-pathname-coding-system 'iso-8859-1 - "*Coding system for file name.") +(defcustom nnheader-pathname-coding-system 'iso-8859-1 + "Coding system for file name." + :group 'gnus-article-various ; FIXME? + :type 'coding-system) (defun nnheader-group-pathname (group dir &optional file) "Make file name for GROUP." diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index fc9304f672b..2e2ec59aa5d 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -157,7 +157,8 @@ textual parts.") (forward "gnus-forward"))) (defvar nnimap-quirks - '(("QRESYNC" "Zimbra" "QRESYNC "))) + '(("QRESYNC" "Zimbra" "QRESYNC ") + ("MOVE" "Dovecot" nil))) (defvar nnimap-inhibit-logging nil) @@ -929,7 +930,8 @@ textual parts.") (let ((message-id (message-field-value "message-id"))) (if internal-move-group (with-current-buffer (nnimap-buffer) - (let* ((can-move (nnimap-capability "MOVE")) + (let* ((can-move (and (nnimap-capability "MOVE") + (equal (nnimap-quirk "MOVE") "MOVE"))) (command (if can-move "UID MOVE %d %S" "UID COPY %d %S")) @@ -995,7 +997,8 @@ textual parts.") (and (nnimap-change-group group server) (with-current-buffer (nnimap-buffer) (nnheader-message 7 "Expiring articles from %s: %s" group articles) - (let ((can-move (nnimap-capability "MOVE"))) + (let ((can-move (and (nnimap-capability "MOVE") + (equal (nnimap-quirk "MOVE") "MOVE")))) (nnimap-command (if can-move "UID MOVE %s %S" @@ -2066,7 +2069,8 @@ Return the server's response to the SELECT or EXAMINE command." nnmail-split-fancy)) (nnmail-inhibit-default-split-group t) (groups (nnimap-get-groups)) - (can-move (nnimap-capability "MOVE")) + (can-move (and (nnimap-capability "MOVE") + (equal (nnimap-quirk "MOVE") "MOVE"))) new-articles) (erase-buffer) (nnimap-command "SELECT %S" nnimap-inbox) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 6c2d11396cb..a3ad4d6b0a3 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -294,14 +294,14 @@ is `(valuefunc member)'." :group 'gnus) (defcustom nnir-ignored-newsgroups "" - "*A regexp to match newsgroups in the active file that should + "A regexp to match newsgroups in the active file that should be skipped when searching." :version "24.1" :type '(regexp) :group 'nnir) (defcustom nnir-summary-line-format nil - "*The format specification of the lines in an nnir summary buffer. + "The format specification of the lines in an nnir summary buffer. All the items from `gnus-summary-line-format' are available, along with three items unique to nnir summary buffers: @@ -316,7 +316,7 @@ If nil this will use `gnus-summary-line-format'." :group 'nnir) (defcustom nnir-retrieve-headers-override-function nil - "*If non-nil, a function that accepts an article list and group + "If non-nil, a function that accepts an article list and group and populates the `nntp-server-buffer' with the retrieved headers. Must return either 'nov or 'headers indicating the retrieved header format. @@ -328,7 +328,7 @@ result, `gnus-retrieve-headers' will be called instead." :group 'nnir) (defcustom nnir-imap-default-search-key "whole message" - "*The default IMAP search key for an nnir search. Must be one of + "The default IMAP search key for an nnir search. Must be one of the keys in `nnir-imap-search-arguments'. To use raw imap queries by default set this to \"imap\"." :version "24.1" @@ -338,17 +338,17 @@ result, `gnus-retrieve-headers' will be called instead." (defcustom nnir-swish++-configuration-file (expand-file-name "~/Mail/swish++.conf") - "*Configuration file for swish++." + "Configuration file for swish++." :type '(file) :group 'nnir) (defcustom nnir-swish++-program "search" - "*Name of swish++ search executable." + "Name of swish++ search executable." :type '(string) :group 'nnir) (defcustom nnir-swish++-additional-switches '() - "*A list of strings, to be given as additional arguments to swish++. + "A list of strings, to be given as additional arguments to swish++. Note that this should be a list. I.e., do NOT use the following: (setq nnir-swish++-additional-switches \"-i -w\") ; wrong @@ -358,7 +358,7 @@ Instead, use this: :group 'nnir) (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by swish++ + "The prefix to remove from each file name returned by swish++ in order to get a group name (albeit with / instead of .). This is a regular expression. @@ -376,7 +376,7 @@ that it is for swish++, not Namazu." 'nnir-swish-e-index-files "Emacs 23.1") (defcustom nnir-swish-e-index-file (expand-file-name "~/Mail/index.swish-e") - "*Index file for swish-e. + "Index file for swish-e. This could be a server parameter. It is never consulted once `nnir-swish-e-index-files', which should be used instead, has been customized." @@ -385,19 +385,19 @@ used instead, has been customized." (defcustom nnir-swish-e-index-files (list nnir-swish-e-index-file) - "*List of index files for swish-e. + "List of index files for swish-e. This could be a server parameter." :type '(repeat (file)) :group 'nnir) (defcustom nnir-swish-e-program "swish-e" - "*Name of swish-e search executable. + "Name of swish-e search executable. This cannot be a server parameter." :type '(string) :group 'nnir) (defcustom nnir-swish-e-additional-switches '() - "*A list of strings, to be given as additional arguments to swish-e. + "A list of strings, to be given as additional arguments to swish-e. Note that this should be a list. I.e., do NOT use the following: (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong @@ -409,7 +409,7 @@ This could be a server parameter." :group 'nnir) (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by swish-e + "The prefix to remove from each file name returned by swish-e in order to get a group name (albeit with / instead of .). This is a regular expression. @@ -423,12 +423,12 @@ This could be a server parameter." ;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/> (defcustom nnir-hyrex-program "nnir-search" - "*Name of the nnir-search executable." + "Name of the nnir-search executable." :type '(string) :group 'nnir) (defcustom nnir-hyrex-additional-switches '() - "*A list of strings, to be given as additional arguments for nnir-search. + "A list of strings, to be given as additional arguments for nnir-search. Note that this should be a list. I.e., do NOT use the following: (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! Instead, use this: @@ -437,12 +437,12 @@ Instead, use this: :group 'nnir) (defcustom nnir-hyrex-index-directory (getenv "HOME") - "*Index directory for HyREX." + "Index directory for HyREX." :type '(directory) :group 'nnir) (defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by HyREX + "The prefix to remove from each file name returned by HyREX in order to get a group name (albeit with / instead of .). For example, suppose that HyREX returns file names such as @@ -457,17 +457,17 @@ arrive at the correct group name, \"mail.misc\"." ;; Namazu engine, see <URL:http://www.namazu.org/> (defcustom nnir-namazu-program "namazu" - "*Name of Namazu search executable." + "Name of Namazu search executable." :type '(string) :group 'nnir) (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") - "*Index directory for Namazu." + "Index directory for Namazu." :type '(directory) :group 'nnir) (defcustom nnir-namazu-additional-switches '() - "*A list of strings, to be given as additional arguments to namazu. + "A list of strings, to be given as additional arguments to namazu. The switches `-q', `-a', and `-s' are always used, very few other switches make any sense in this context. @@ -479,7 +479,7 @@ Instead, use this: :group 'nnir) (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by Namazu + "The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). For example, suppose that Namazu returns file names such as @@ -492,13 +492,13 @@ arrive at the correct group name, \"mail.misc\"." :group 'nnir) (defcustom nnir-notmuch-program "notmuch" - "*Name of notmuch search executable." + "Name of notmuch search executable." :version "24.1" :type '(string) :group 'nnir) (defcustom nnir-notmuch-additional-switches '() - "*A list of strings, to be given as additional arguments to notmuch. + "A list of strings, to be given as additional arguments to notmuch. Note that this should be a list. I.e., do NOT use the following: (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong @@ -509,7 +509,7 @@ Instead, use this: :group 'nnir) (defcustom nnir-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by notmuch + "The prefix to remove from each file name returned by notmuch in order to get a group name (albeit with / instead of .). This is a regular expression. @@ -563,7 +563,7 @@ needs the variables `nnir-namazu-program', Add an entry here when adding a new search engine.") (defcustom nnir-method-default-engines '((nnimap . imap) (nntp . gmane)) - "*Alist of default search engines keyed by server method." + "Alist of default search engines keyed by server method." :version "24.1" :group 'nnir :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 94589e1734d..5495510d94a 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -76,7 +76,7 @@ :group 'nnmail) (defcustom nnmail-split-methods '(("mail.misc" "")) - "*Incoming mail will be split according to this variable. + "Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the \"4ad-l\" mailing list, one group for junk mail and one for everything @@ -158,7 +158,7 @@ If nil, groups like \"mail.misc\" will end up in directories like :type 'integer) (defcustom nnmail-expiry-wait 7 - "*Expirable articles that are older than this will be expired. + "Expirable articles that are older than this will be expired. This variable can either be a number (which will be interpreted as a number of days) -- this doesn't have to be an integer. This variable can also be `immediate' and `never'." @@ -187,7 +187,7 @@ E.g.: (function :format "%v" nnmail-))) (defcustom nnmail-expiry-target 'delete - "*Variable that says where expired messages should end up. + "Variable that says where expired messages should end up. The default value is `delete' (which says to delete the messages), but it can also be a string or a function. If it is a string, expired messages end up in that group. If it is a function, the function is @@ -246,12 +246,12 @@ If non-nil, also update the cache when copy or move articles." ;; Variable removed in No Gnus v0.7 (defcustom nnmail-resplit-incoming nil - "*If non-nil, re-split incoming procmail sorted mail." + "If non-nil, re-split incoming procmail sorted mail." :group 'nnmail-procmail :type 'boolean) (defcustom nnmail-scan-directory-mail-source-once nil - "*If non-nil, scan all incoming procmail sorted mails once. + "If non-nil, scan all incoming procmail sorted mails once. It scans low-level sorted spools even when not required." :version "21.1" :group 'nnmail-procmail @@ -266,7 +266,7 @@ It scans low-level sorted spools even when not required." (if (string-match "windows-nt" (symbol-name system-type)) 'copy-file 'add-name-to-file) - "*Function called to create a copy of a file. + "Function called to create a copy of a file. This is `add-name-to-file' by default, which means that crossposts will use hard links. If your file system doesn't allow hard links, you could set this variable to `copy-file' instead." @@ -279,7 +279,7 @@ links, you could set this variable to `copy-file' instead." (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) - "*Hook that will be run after the incoming mail has been transferred. + "Hook that will be run after the incoming mail has been transferred. The incoming mail is moved from the specified spool file (which normally is something like \"/usr/spool/mail/$user\") to the user's home directory. This hook is called after the incoming mail box has been @@ -355,13 +355,13 @@ discarded after running the split process." :type 'hook) (defcustom nnmail-spool-hook nil - "*A hook called when a new article is spooled." + "A hook called when a new article is spooled." :version "22.1" :group 'nnmail :type 'hook) (defcustom nnmail-large-newsgroup 50 - "*The number of articles which indicates a large newsgroup or nil. + "The number of articles which indicates a large newsgroup or nil. If the number of articles is greater than the value, verbose messages will be shown to indicate the current status." :group 'nnmail-various @@ -489,12 +489,12 @@ Example: (from . "from\\|sender\\|resent-from") (nato . "to\\|cc\\|resent-to\\|resent-cc") (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) - "*Alist of abbreviations allowed in `nnmail-split-fancy'." + "Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) (defcustom nnmail-message-id-cache-length 1000 - "*The approximate number of Message-IDs nnmail will keep in its cache. + "The approximate number of Message-IDs nnmail will keep in its cache. If this variable is nil, no checking on duplicate messages will be performed." :group 'nnmail-duplicate @@ -509,7 +509,7 @@ performed." :type 'file) (defcustom nnmail-treat-duplicates 'warn - "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. + "If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. Three values are valid: nil, which means that nnmail is not to keep a Message-ID cache; `warn', which means that nnmail should insert extra headers to warn the user about the duplication (this is the default); @@ -601,8 +601,10 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." mm-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system nil - "*Coding system for file name.") +(defcustom nnmail-pathname-coding-system nil + "Coding system for file name." + :group 'nnmail-various + :type 'coding-system) (defun nnmail-find-file (file) "Insert FILE in server buffer safely." @@ -670,8 +672,10 @@ nn*-request-list should have been called before calling this function." (forward-line 1)) group-assoc)) -(defvar nnmail-active-file-coding-system 'raw-text - "*Coding system for active file.") +(defcustom nnmail-active-file-coding-system 'raw-text + "Coding system for active file." + :group 'nnmail-various + :type 'coding-system) (defun nnmail-save-active (group-assoc file-name) "Save GROUP-ASSOC in ACTIVE-FILE." @@ -1368,7 +1372,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; Builtin & operation. ((eq (car split) '&) - (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) + (mapcan 'nnmail-split-it (cdr split))) ;; Builtin | operation. ((eq (car split) '|) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index cebdc95876f..03cb445675c 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -125,8 +125,8 @@ SUFFIX should start with \":2,\"." (concat ":2," new-flags))) (defvar nnmaildir-article-file-name nil - "*The filename of the most recently requested article. This variable is set -by nnmaildir-request-article.") + "The filename of the most recently requested article. +This variable is set by `nnmaildir-request-article'.") ;; The filename of the article being moved/copied: (defvar nnmaildir--file nil) @@ -371,8 +371,7 @@ by nnmaildir-request-article.") (string= (downcase (caddr err)) "too many links"))) (defun nnmaildir--enoent-p (err) - (and (eq (car err) 'file-error) - (string= (downcase (caddr err)) "no such file or directory"))) + (eq (car err) 'file-missing)) (defun nnmaildir--eexist-p (err) (eq (car err) 'file-already-exists)) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 6168e5a281b..68dabcb142e 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -39,6 +39,10 @@ (require 'mml) (require 'xml) +(defgroup nnrss nil + "RSS access for Gnus." + :group 'gnus) + (nnoo-declare nnrss) (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") @@ -86,14 +90,16 @@ The arguments are (ENTRY GROUP ARTICLE). ENTRY is the record of the current headline. GROUP is the group name. ARTICLE is the article number of the current headline.") -(defvar nnrss-file-coding-system mm-universal-coding-system - "*Coding system used when reading and writing files. +(defcustom nnrss-file-coding-system mm-universal-coding-system + "Coding system used when reading and writing files. If you run Gnus with various versions of Emacsen, the value of this variable should be the coding system that all those Emacsen support. Note that you have to regenerate all the nnrss groups if you change the value. Moreover, you should be patient even if you are made to read the same articles twice, that arises for the difference of the -versions of xml.el.") +versions of xml.el." + :group 'nnrss + :type 'coding-system) (defvar nnrss-compatible-encoding-alist (delq nil (mapcar (lambda (elem) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index fa5f0e6c582..38e7c6ecbbe 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -252,8 +252,10 @@ update their active files often, this can help.") ;;; Internal variables. (defvoo nntp-retrieval-in-progress nil) -(defvar nntp-record-commands nil - "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.") +(defcustom nntp-record-commands nil + "If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer." + :group 'nntp + :type 'boolean) (defvar nntp-have-messaged nil) diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index 8413f227e5c..5ae59c3424f 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -28,14 +28,20 @@ (require 'mm-util) ; for mm-universal-coding-system (require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks -(defvar gnus-score-edit-done-hook nil - "*Hook run at the end of closing the score buffer.") - -(defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - -(defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") +(defcustom gnus-score-edit-done-hook nil + "Hook run at the end of closing the score buffer." + :group 'gnus-score + :type 'hook) + +(defcustom gnus-score-mode-hook nil + "Hook run in score mode buffers." + :group 'gnus-score + :type 'hook) + +(defcustom gnus-score-menu-hook nil + "Hook run after creating the score mode menu." + :group 'gnus-score + :type 'hook) (defvar gnus-score-edit-exit-function nil "Function run on exit from the score buffer.") diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index b5450a82bdd..1ea4c1e51de 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -92,7 +92,7 @@ is nil, use `smiley-style'." ((eq smiley-style 'grayscale) "/grayscale"))))) (defcustom smiley-data-directory (smiley-directory) - "*Location of the smiley faces files." + "Location of the smiley faces files." :set (lambda (symbol value) (set-default symbol value) (smiley-update-cache)) @@ -116,7 +116,7 @@ is nil, use `smiley-style'." ("\\(:-D\\)\\W" 1 "grin") ;; "smile" must be come after "evil" ("\\(\\^?:-?)\\)\\W" 1 "smile")) - "*A list of regexps to map smilies to images. + "A list of regexps to map smilies to images. The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in regexp to replace with IMAGE. IMAGE is the name of an image file in `smiley-data-directory'." @@ -137,7 +137,7 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in (when (gnus-image-type-available-p 'gif) (push "gif" types)) types) - "*List of suffixes on smiley file names to try." + "List of suffixes on smiley file names to try." :version "24.1" :type '(repeat string) :group 'smiley) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 44841a71422..888974e1401 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -120,9 +120,7 @@ (require 'dig) -(if (locate-library "password-cache") - (require 'password-cache) - (require 'password)) +(require 'password-cache) (eval-when-compile (require 'cl)) @@ -131,7 +129,7 @@ :group 'mime) (defcustom smime-keys nil - "*Map mail addresses to a file containing Certificate (and private key). + "Map mail addresses to a file containing Certificate (and private key). The file is assumed to be in PEM format. You can also associate additional certificates to be sent with every message to each address." :type '(repeat (list (string :tag "Mail address") @@ -141,7 +139,7 @@ certificates to be sent with every message to each address." :group 'smime) (defcustom smime-CA-directory nil - "*Directory containing certificates for CAs you trust. + "Directory containing certificates for CAs you trust. Directory should contain files (in PEM format) named to the X.509 hash of the certificate. This can be done using OpenSSL such as: @@ -154,7 +152,7 @@ certificate." :group 'smime) (defcustom smime-CA-file nil - "*Files containing certificates for CAs you trust. + "Files containing certificates for CAs you trust. File should contain certificates in PEM format." :version "22.1" :type '(choice (const :tag "none" nil) @@ -162,7 +160,7 @@ File should contain certificates in PEM format." :group 'smime) (defcustom smime-certificate-directory "~/Mail/certs/" - "*Directory containing other people's certificates. + "Directory containing other people's certificates. It should contain files named to the X.509 hash of the certificate, and the files themselves should be in PEM format." ;The S/MIME library provide simple functionality for fetching @@ -176,14 +174,14 @@ and the files themselves should be in PEM format." (eq 0 (call-process "openssl" nil nil nil "version")) (error nil)) "openssl") - "*Name of OpenSSL binary." + "Name of OpenSSL binary." :type 'string :group 'smime) ;; OpenSSL option to select the encryption cipher (defcustom smime-encrypt-cipher "-des3" - "*Cipher algorithm used for encryption." + "Cipher algorithm used for encryption." :version "22.1" :type '(choice (const :tag "Triple DES" "-des3") (const :tag "DES" "-des") @@ -193,7 +191,7 @@ and the files themselves should be in PEM format." :group 'smime) (defcustom smime-crl-check nil - "*Check revocation status of signers certificate using CRLs. + "Check revocation status of signers certificate using CRLs. Enabling this will have OpenSSL check the signers certificate against a certificate revocation list (CRL). @@ -214,7 +212,7 @@ At least OpenSSL version 0.9.7 is required for this to work." :group 'smime) (defcustom smime-dns-server nil - "*DNS server to query certificates from. + "DNS server to query certificates from. If nil, use system defaults." :version "22.1" :type '(choice (const :tag "System defaults") @@ -231,9 +229,6 @@ must be set in `ldap-host-parameters-alist'." (defvar smime-details-buffer "*OpenSSL output*") -;; Password dialog function -(declare-function password-read-and-add "password-cache" (prompt &optional key)) - (defun smime-ask-passphrase (&optional cache-key) "Asks the passphrase to unlock the secret key. If `cache-key' and `password-cache' is non-nil then cache the diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c3a5f26d261..23dec896b81 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -34,6 +34,7 @@ (require 'cl-lib) (require 'help-mode) +(require 'radix-tree) (defvar help-fns-describe-function-functions nil "List of functions to run in help buffer in `describe-function'. @@ -43,6 +44,61 @@ The functions will receive the function name as argument.") ;; Functions +(defvar help-definition-prefixes nil + ;; FIXME: We keep `definition-prefixes' as a hash-table so as to + ;; avoid pre-loading radix-tree and because it takes slightly less + ;; memory. But when we use this table it's more efficient to + ;; represent it as a radix tree, since the main operation is to do + ;; `radix-tree-prefixes'. Maybe we should just bite the bullet and + ;; use a radix tree for `definition-prefixes' (it's not *that* + ;; costly, really). + "Radix-tree representation replacing `definition-prefixes'.") + +(defun help-definition-prefixes () + "Return the up-to-date radix-tree form of `definition-prefixes'." + (when (> (hash-table-count definition-prefixes) 0) + (maphash (lambda (prefix files) + (let ((old (radix-tree-lookup help-definition-prefixes prefix))) + (setq help-definition-prefixes + (radix-tree-insert help-definition-prefixes + prefix (append old files))))) + definition-prefixes) + (clrhash definition-prefixes)) + help-definition-prefixes) + +(defun help--loaded-p (file) + "Try and figure out if FILE has already been loaded." + (or (let ((feature (intern-soft file))) + (and feature (featurep feature))) + (let* ((re (load-history-regexp file)) + (done nil)) + (dolist (x load-history) + (if (string-match-p re (car x)) (setq done t))) + done))) + +(defun help--load-prefixes (prefixes) + (pcase-dolist (`(,prefix . ,files) prefixes) + (setq help-definition-prefixes + (radix-tree-insert help-definition-prefixes prefix nil)) + (dolist (file files) + ;; FIXME: Should we scan help-definition-prefixes to remove + ;; other prefixes of the same file? + ;; FIXME: this regexp business is not good enough: for file + ;; `toto', it will say `toto' is loaded when in reality it was + ;; just cedet/semantic/toto that has been loaded. + (unless (help--loaded-p file) + (load file 'noerror 'nomessage))))) + +(defun help--symbol-completion-table (string pred action) + (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) + (help--load-prefixes prefixes)) + (let ((prefix-completions + (mapcar #'intern (all-completions string definition-prefixes)))) + (complete-with-action action obarray string + (if pred (lambda (sym) + (or (funcall pred sym) + (memq sym prefix-completions))))))) + (defvar describe-function-orig-buffer nil "Buffer that was current when `describe-function' was invoked. Functions on `help-fns-describe-function-functions' can use this @@ -50,22 +106,24 @@ to get buffer-local values.") ;;;###autoload (defun describe-function (function) - "Display the full documentation of FUNCTION (a symbol)." + "Display the full documentation of FUNCTION (a symbol). +When called from lisp, FUNCTION may also be a function object." (interactive - (let ((fn (function-called-at-point)) - (enable-recursive-minibuffers t) - val) - (setq val (completing-read (if fn - (format "Describe function (default %s): " fn) - "Describe function: ") - obarray 'fboundp t nil nil - (and fn (symbol-name fn)))) - (list (if (equal val "") - fn (intern val))))) - (or (and function (symbolp function)) - (user-error "You didn't specify a function symbol")) - (or (fboundp function) - (user-error "Symbol's function definition is void: %s" function)) + (let* ((fn (function-called-at-point)) + (enable-recursive-minibuffers t) + (val (completing-read + (if fn + (format "Describe function (default %s): " fn) + "Describe function: ") + #'help--symbol-completion-table #'fboundp t nil nil + (and fn (symbol-name fn))))) + (unless (equal val "") + (setq fn (intern val))) + (unless (and fn (symbolp fn)) + (user-error "You didn't specify a function symbol")) + (unless (fboundp fn) + (user-error "Symbol's function definition is void: %s" fn)) + (list fn))) ;; We save describe-function-orig-buffer on the help xref stack, so ;; it is restored by the back/forward buttons. 'help-buffer' @@ -514,19 +572,25 @@ FILE is the file where FUNCTION was probably defined." real-function)) (aliased (or (symbolp def) ;; Advised & aliased function. - (and advised (symbolp real-function)))) + (and advised (symbolp real-function) + (not (eq 'autoload (car-safe def)))) + (and (subrp def) + (not (string= (subr-name def) + (symbol-name function)))))) (real-def (cond - (aliased (let ((f real-function)) - (while (and (fboundp f) - (symbolp (symbol-function f))) - (setq f (symbol-function f))) - f)) + ((and aliased (not (subrp def))) + (let ((f real-function)) + (while (and (fboundp f) + (symbolp (symbol-function f))) + (setq f (symbol-function f))) + f)) ((subrp def) (intern (subr-name def))) (t def))) (sig-key (if (subrp def) (indirect-function real-def) real-def)) - (file-name (find-lisp-object-file-name function def)) + (file-name (find-lisp-object-file-name function (if aliased 'defun + def))) (pt1 (with-current-buffer (help-buffer) (point))) (beg (if (and (or (byte-code-function-p def) (keymapp def) @@ -541,14 +605,14 @@ FILE is the file where FUNCTION was probably defined." ;; Print what kind of function-like object FUNCTION is. (princ (cond ((or (stringp def) (vectorp def)) "a keyboard macro") - ((subrp def) - (if (eq 'unevalled (cdr (subr-arity def))) - (concat beg "special form") - (concat beg "built-in function"))) ;; Aliases are Lisp functions, so we need to check ;; aliases before functions. (aliased (format-message "an alias for `%s'" real-def)) + ((subrp def) + (if (eq 'unevalled (cdr (subr-arity def))) + (concat beg "special form") + (concat beg "built-in function"))) ((autoloadp def) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an") @@ -699,17 +763,23 @@ it is displayed along with the global value." (interactive (let ((v (variable-at-point)) (enable-recursive-minibuffers t) + (orig-buffer (current-buffer)) val) - (setq val (completing-read (if (symbolp v) - (format - "Describe variable (default %s): " v) - "Describe variable: ") - obarray - (lambda (vv) - (or (get vv 'variable-documentation) - (and (boundp vv) (not (keywordp vv))))) - t nil nil - (if (symbolp v) (symbol-name v)))) + (setq val (completing-read + (if (symbolp v) + (format + "Describe variable (default %s): " v) + "Describe variable: ") + #'help--symbol-completion-table + (lambda (vv) + ;; In case the variable only exists in the buffer + ;; the command we switch back to that buffer before + ;; we examine the variable. + (with-current-buffer orig-buffer + (or (get vv 'variable-documentation) + (and (boundp vv) (not (keywordp vv)))))) + t nil nil + (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) (let (file-name) @@ -758,9 +828,8 @@ it is displayed along with the global value." (unless valvoid (with-current-buffer standard-output (setq val-start-pos (point)) - (princ "value is ") - (let ((from (point)) - (line-beg (line-beginning-position)) + (princ "value is") + (let ((line-beg (line-beginning-position)) (print-rep (let ((rep (let ((print-quoted t)) @@ -769,17 +838,17 @@ it is displayed along with the global value." (format-message "`%s'" rep) rep)))) (if (< (+ (length print-rep) (point) (- line-beg)) 68) - (insert print-rep) + (insert " " print-rep) (terpri) (pp val) - (if (< (point) (+ 68 (line-beginning-position 0))) - (delete-region from (1+ from)) - (delete-region (1- from) from))) + ;; Remove trailing newline. + (delete-char -1)) (let* ((sv (get variable 'standard-value)) (origval (and (consp sv) (condition-case nil (eval (car sv)) - (error :help-eval-error))))) + (error :help-eval-error)))) + from) (when (and (consp sv) (not (equal origval val)) (not (equal origval :help-eval-error))) @@ -849,6 +918,7 @@ it is displayed along with the global value." (indirect-variable variable) (error variable))) (obsolete (get variable 'byte-obsolete-variable)) + (watchpoints (get-variable-watchers variable)) (use (car obsolete)) (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property @@ -898,6 +968,12 @@ if it is given a local binding.\n")))) (t "."))) (terpri)) + (when watchpoints + (setq extra-line t) + (princ " Calls these functions when changed: ") + (princ watchpoints) + (terpri)) + (when (member (cons variable val) (with-current-buffer buffer file-local-variables-alist)) @@ -1104,7 +1180,13 @@ BUFFER should be a buffer or a buffer name." (if (or (not (vectorp docs)) (/= (length docs) 95)) (error "Invalid first extra slot in this category table\n")) (with-current-buffer standard-output - (insert "Legend of category mnemonics (see the tail for the longer description)\n") + (setq-default help-button-cache (make-marker)) + (insert "Legend of category mnemonics ") + (insert-button "(longer descriptions at the bottom)" + 'action help-button-cache + 'follow-link t + 'help-echo "mouse-2, RET: show full legend") + (insert "\n") (let ((pos (point)) (items 0) lines n) (dotimes (i 95) (if (aref docs i) (setq items (1+ items)))) @@ -1131,6 +1213,7 @@ BUFFER should be a buffer or a buffer name." "character(s)\tcategory mnemonics\n" "------------\t------------------") (describe-vector table 'help-describe-category-set) + (set-marker help-button-cache (point)) (insert "Legend of category mnemonics:\n") (dotimes (i 95) (let ((elt (aref docs i))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7b95e5fb04e..e008698618c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -202,6 +202,7 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun type file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) @@ -231,6 +232,7 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let ((location (find-variable-noselect var file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) diff --git a/lisp/help.el b/lisp/help.el index baccf5988b8..b8485667ae0 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -946,14 +946,15 @@ documentation for the major and minor modes of that buffer." (let ((mode-function (nth 0 mode)) (pretty-minor-mode (nth 1 mode)) (indicator (nth 2 mode))) - (add-text-properties 0 (length pretty-minor-mode) - '(face bold) pretty-minor-mode) (save-excursion (goto-char (point-max)) (princ "\n\f\n") (push (point-marker) help-button-cache) ;; Document the minor modes fully. - (insert pretty-minor-mode) + (insert-text-button + pretty-minor-mode 'type 'help-function + 'help-args (list mode-function) + 'button '(t)) (princ (format " minor mode (%s):\n" (if (zerop (length indicator)) "no indicator" @@ -1484,7 +1485,8 @@ the same names as used in the original source code, when possible." (define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1") (defun help--make-usage-docstring (fn arglist) - (help--docstring-quote (format "%S" (help--make-usage fn arglist)))) + (let ((print-escape-newlines t)) + (help--docstring-quote (format "%S" (help--make-usage fn arglist))))) (provide 'help) diff --git a/lisp/hex-util.el b/lisp/hex-util.el index 4867359401b..889bf9bfed5 100644 --- a/lisp/hex-util.el +++ b/lisp/hex-util.el @@ -1,4 +1,4 @@ -;;; hex-util.el --- Functions to encode/decode hexadecimal string. +;;; hex-util.el --- Functions to encode/decode hexadecimal string -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index ec14e0b4329..549010dda03 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -727,7 +727,7 @@ with completion and history." (font-lock-flush))) (defun hi-lock-find-patterns () - "Find patterns in current buffer for hi-lock." + "Add patterns from the current buffer to the list of hi-lock patterns." (interactive) (unless (memq major-mode hi-lock-exclude-modes) (let ((all-patterns nil) diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 8f042b6b10b..1e4deb9353e 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -194,8 +194,6 @@ (t (:inverse-video t))) "Face used for highlighting changes." :group 'highlight-changes) -(define-obsolete-face-alias 'highlight-changes-face - 'highlight-changes "22.1") ;; This looks pretty ugly, actually. Maybe the underline should be removed. (defface highlight-changes-delete @@ -204,9 +202,6 @@ (t (:inverse-video t))) "Face used for highlighting deletions." :group 'highlight-changes) -(define-obsolete-face-alias 'highlight-changes-delete-face - 'highlight-changes-delete "22.1") - ;; A (not very good) default list of colors to rotate through. (define-obsolete-variable-alias 'highlight-changes-colours @@ -782,7 +777,7 @@ is non-nil." a-start a-end len-a b-start b-end len-b (bufa-modified (buffer-modified-p buf-a)) - (bufb-modified (buffer-modified-p buf-b)) + (bufb-modified (and (not (eq buf-a buf-b)) (buffer-modified-p buf-b))) (buf-a-read-only (with-current-buffer buf-a buffer-read-only)) (buf-b-read-only (with-current-buffer buf-b buffer-read-only)) temp-a temp-b) @@ -913,7 +908,7 @@ changes are made, so \\[highlight-changes-next-change] and (let (hilit-e hilit-x hilit-y) (ediff-setup buf-a file-a buf-b file-b nil nil ; buf-c file-C - 'hilit-chg-get-diff-list-hk + '(hilit-chg-get-diff-list-hk) (list (cons 'ediff-job-name 'something)) ) (ediff-with-current-buffer hilit-e (ediff-really-quit nil)) diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 25c8a087f42..d75e52f2973 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -126,6 +126,9 @@ It should return nil if there's no region to be highlighted. This variable is expected to be made buffer-local by modes.") +(defvar hl-line-overlay-buffer nil + "Most recently visited buffer in which Hl-Line mode is enabled.") + ;;;###autoload (define-minor-mode hl-line-mode "Toggle highlighting of the current line (Hl-Line mode). @@ -142,22 +145,21 @@ non-selected window. Hl-Line mode uses the function When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the line about point in the selected window only. In this case, it -uses the function `hl-line-unhighlight' on `pre-command-hook' in +uses the function `hl-line-maybe-unhighlight' in addition to `hl-line-highlight' on `post-command-hook'." :group 'hl-line (if hl-line-mode (progn ;; In case `kill-all-local-variables' is called. (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) - (if hl-line-sticky-flag - (remove-hook 'pre-command-hook #'hl-line-unhighlight t) - (add-hook 'pre-command-hook #'hl-line-unhighlight nil t)) (hl-line-highlight) - (add-hook 'post-command-hook #'hl-line-highlight nil t)) + (setq hl-line-overlay-buffer (current-buffer)) + (add-hook 'post-command-hook #'hl-line-highlight nil t) + (add-hook 'post-command-hook #'hl-line-maybe-unhighlight nil t)) (remove-hook 'post-command-hook #'hl-line-highlight t) (hl-line-unhighlight) (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) - (remove-hook 'pre-command-hook #'hl-line-unhighlight t))) + (remove-hook 'post-command-hook #'hl-line-maybe-unhighlight t))) (defun hl-line-make-overlay () (let ((ol (make-overlay (point) (point)))) @@ -181,6 +183,22 @@ addition to `hl-line-highlight' on `post-command-hook'." (when hl-line-overlay (delete-overlay hl-line-overlay))) +(defun hl-line-maybe-unhighlight () + "Maybe deactivate the Hl-Line overlay on the current line. +Specifically, when `hl-line-sticky-flag' is nil deactivate all +such overlays in all buffers except the current one." + (let ((hlob hl-line-overlay-buffer) + (curbuf (current-buffer))) + (when (and (not hl-line-sticky-flag) + (not (eq curbuf hlob)) + (not (minibufferp))) + (with-current-buffer hlob + (when (overlayp hl-line-overlay) + (delete-overlay hl-line-overlay)))) + (when (and (overlayp hl-line-overlay) + (eq (overlay-buffer hl-line-overlay) curbuf)) + (setq hl-line-overlay-buffer curbuf)))) + ;;;###autoload (define-minor-mode global-hl-line-mode "Toggle line highlighting in all buffers (Global Hl-Line mode). @@ -189,25 +207,24 @@ positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode -highlights the line about the current buffer's point in all +highlights the line about the current buffer's point in all live windows. -Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and -`global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'." +Global-Hl-Line mode uses the functions `global-hl-line-highlight' +and `global-hl-line-maybe-unhighlight' on `post-command-hook'." :global t :group 'hl-line (if global-hl-line-mode (progn ;; In case `kill-all-local-variables' is called. (add-hook 'change-major-mode-hook #'global-hl-line-unhighlight) - (if global-hl-line-sticky-flag - (remove-hook 'pre-command-hook #'global-hl-line-unhighlight) - (add-hook 'pre-command-hook #'global-hl-line-unhighlight)) - (global-hl-line-highlight) - (add-hook 'post-command-hook #'global-hl-line-highlight)) + (global-hl-line-highlight-all) + (add-hook 'post-command-hook #'global-hl-line-highlight) + (add-hook 'post-command-hook #'global-hl-line-maybe-unhighlight)) (global-hl-line-unhighlight-all) - (remove-hook 'pre-command-hook #'global-hl-line-unhighlight) - (remove-hook 'post-command-hook #'global-hl-line-highlight))) + (remove-hook 'post-command-hook #'global-hl-line-highlight) + (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight) + (remove-hook 'post-command-hook #'global-hl-line-maybe-unhighlight))) (defun global-hl-line-highlight () "Highlight the current line in the current window." @@ -222,11 +239,33 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and (selected-window))) (hl-line-move global-hl-line-overlay)))) +(defun global-hl-line-highlight-all () + "Highlight the current line in all live windows." + (walk-windows (lambda (w) + (with-current-buffer (window-buffer w) + (global-hl-line-highlight))) + nil t)) + (defun global-hl-line-unhighlight () "Deactivate the Global-Hl-Line overlay on the current line." (when global-hl-line-overlay (delete-overlay global-hl-line-overlay))) +(defun global-hl-line-maybe-unhighlight () + "Maybe deactivate the Global-Hl-Line overlay on the current line. +Specifically, when `global-hl-line-sticky-flag' is nil deactivate +all such overlays in all buffers except the current one." + (mapc (lambda (ov) + (let ((ovb (overlay-buffer ov))) + (when (and (not global-hl-line-sticky-flag) + (bufferp ovb) + (not (eq ovb (current-buffer))) + (not (minibufferp))) + (with-current-buffer ovb + (when (overlayp global-hl-line-overlay) + (delete-overlay global-hl-line-overlay)))))) + global-hl-line-overlays)) + (defun global-hl-line-unhighlight-all () "Deactivate all Global-Hl-Line overlays." (mapc (lambda (ov) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 431300c81c2..19a57ba8b2e 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1,4 +1,4 @@ -;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks +;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks -*- lexical-binding: t -*- ;; Copyright (C) 2002-2003, 2009-2016 Free Software Foundation, Inc. @@ -81,7 +81,7 @@ ;; Changes: moved to changelog (CHANGES) file. ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'faces) ;; (`facep' `face-attr-construct' `x-color-values' `color-values' `face-name') (require 'custom) @@ -524,8 +524,8 @@ Some examples:\n (defvar hfy-sheet-assoc 'please-ignore-this-line "An assoc with elements of the form (face-name style-name . style-string):\n -'((default \"default\" . \"{background: black; color: white}\") - (font-lock-string-face \"string\" . \"{color: rgb(64,224,208)}\"))" ) +\((default \"default\" . \"{background: black; color: white}\") + (font-lock-string-face \"string\" . \"{color: rgb(64,224,208)}\"))" ) (defvar hfy-facemap-assoc 'please-ignore-this-line "An assoc of (point . FACE-SYMBOL) or (point . DEFFACE-LIST) @@ -818,7 +818,7 @@ regular specifiers." (if spec (let ((tag (car spec)) (val (cadr spec))) - (cons (case tag + (cons (cl-case tag (:color (cons "colour" val)) (:width (cons "width" val)) (:style (cons "style" val))) @@ -831,7 +831,7 @@ regular specifiers." (list (if col (cons "border-color" (cdr (assoc "colour" css)))) (cons "border-width" (format "%dpx" (or (cdr (assoc "width" css)) 1))) - (cons "border-style" (case s + (cons "border-style" (cl-case s (released-button "outset") (pressed-button "inset" ) (t "solid" )))))) @@ -850,7 +850,7 @@ TAG is an Emacs font attribute key (eg :underline). VAL is ignored." (list ;; FIXME: Why not '("text-decoration" . "underline")? --Stef - (case tag + (cl-case tag (:underline (cons "text-decoration" "underline" )) (:overline (cons "text-decoration" "overline" )) (:strike-through (cons "text-decoration" "line-through"))))) @@ -1003,7 +1003,7 @@ merged by the user - `hfy-flatten-style' should do this." (hfy-face-to-style-i (hfy-face-attr-for-class v hfy-display-class)))))) (setq this - (if val (case key + (if val (cl-case key (:family (hfy-family val)) (:width (hfy-width val)) (:weight (hfy-weight val)) @@ -1287,7 +1287,7 @@ return a `defface' style list of face properties instead of a face symbol." (setq fprops (cdr fprops))) ;; ((prop val)) (setq p (caar fprops)) - (setq v (cadar fprops)) + (setq v (cl-cadar fprops)) (setq fprops (cdr fprops))) (if (listp (cdr fprops)) (progn @@ -1304,7 +1304,7 @@ return a `defface' style list of face properties instead of a face symbol." (setq v (cdr fprops)) (setq fprops nil)) (error "Eh... another format! fprops=%s" fprops) ))) - (setq p (case p + (setq p (cl-case p ;; These are all the properties handled ;; in `hfy-face-to-style-i'. ;; @@ -1407,8 +1407,8 @@ Returns a modified copy of FACE-MAP." ;;(push (car tmp-map) reduced-map) ;;(push (cadr tmp-map) reduced-map) (while tmp-map - (setq first-start (cadddr tmp-map) - first-stop (caddr tmp-map) + (setq first-start (cl-cadddr tmp-map) + first-stop (cl-caddr tmp-map) last-start (cadr tmp-map) last-stop (car tmp-map) map-buf tmp-map @@ -1421,8 +1421,8 @@ Returns a modified copy of FACE-MAP." (not (re-search-forward "[^ \t\n\r]" (car last-start) t)))) (setq map-buf (cddr map-buf) span-start first-start - first-start (cadddr map-buf) - first-stop (caddr map-buf) + first-start (cl-cadddr map-buf) + first-stop (cl-caddr map-buf) last-start (cadr map-buf) last-stop (car map-buf))) (push span-stop reduced-map) @@ -1762,7 +1762,7 @@ FILE, if set, is the file name." (if (not (setq pr (get-text-property pt lp))) nil (goto-char pt) (remove-text-properties pt (1+ pt) (list lp nil)) - (case lp + (cl-case lp (hfy-link (if (setq rr (get-text-property pt 'hfy-inst)) (insert (format "<a name=\"%s\"></a>" rr))) @@ -1805,8 +1805,7 @@ It is assumed that STRING has text properties that allow it to be fontified. This is a simple convenience wrapper around `htmlfontify-buffer'." (let* ((hfy-optimizations-1 (copy-sequence hfy-optimizations)) - (hfy-optimizations (add-to-list 'hfy-optimizations-1 - 'skip-refontification))) + (hfy-optimizations (cl-pushnew 'skip-refontification hfy-optimizations-1))) (with-temp-buffer (insert string) (htmlfontify-buffer) @@ -1849,8 +1848,9 @@ Dangerous characters in the existing buffer are turned into HTML entities, so you should even be able to do HTML-within-HTML fontified display. -You should, however, note that random control or eight-bit -characters such as ^L (\x0c) or ¤ (\xa4) won't get mapped yet. +You should, however, note that random control or non-ASCII +characters such as ^L (U+000C FORM FEED (FF)) or ¤ (U+00A4 +CURRENCY SIGN) won't get mapped yet. If the SRCDIR and FILE arguments are set, lookup etags derived entries in the `hfy-tags-cache' and add HTML anchors and @@ -1962,7 +1962,7 @@ property, with a value of \"tag.line-number\"." (lambda (TLIST) (if (string= file (car TLIST)) (let* ((line (cadr TLIST) ) - (chr (caddr TLIST) ) + (chr (cl-caddr TLIST)) (link (format "%s.%d" TAG line) )) (put-text-property (+ 1 chr) (+ 2 chr) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 6052bf32ce3..9ce7b5a4846 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -35,15 +35,15 @@ (eval-when-compile (require 'ibuf-macs) - (require 'cl-lib)) + (require 'cl-lib) + (require 'subr-x)) ;;; Utility functions -(defun ibuffer-delete-alist (key alist) - "Delete all entries in ALIST that have a key equal to KEY." - (let (entry) - (while (setq entry (assoc key alist)) - (setq alist (delete entry alist))) - alist)) +(defun ibuffer-remove-alist (key alist) + "Remove all entries in ALIST that have a key equal to KEY." + (while (ibuffer-awhen (assoc key alist) + (setq alist (remove it alist)) it)) + alist) ;; borrowed from Gnus (defun ibuffer-remove-duplicates (list) @@ -85,6 +85,32 @@ regardless of any active filters in this buffer." :type '(repeat (choice regexp function)) :group 'ibuffer) +(defcustom ibuffer-never-search-content-name + (let* ((names '("Completions" "Help" "Messages" "Pp Eval Output" + "CompileLog" "Info" "Buffer List" "Ibuffer" "Apropos")) + (partial '("Customize Option: " "Async Shell Command\\*" + "Shell Command Output\\*" "ediff ")) + (beg "\\`\\*") + (end "\\*\\'") + (excluded (mapcar (lambda (x) + (format "%s%s" beg x)) partial))) + (dolist (str names (nreverse excluded)) + (push (format "%s%s%s" beg str end) excluded))) + "A list of regexps for buffers ignored by `ibuffer-mark-by-content-regexp'. +Buffers whose name matches a regexp in this list, are not searched." + :version "26.1" + :type '(repeat regexp) + :require 'ibuf-ext + :group 'ibuffer) + +(defcustom ibuffer-never-search-content-mode '(dired-mode) + "A list of major modes ignored by `ibuffer-mark-by-content-regexp'. +Buffers whose major mode is in this list, are not searched." + :version "26.1" + :type '(repeat regexp) + :require 'ibuf-ext + :group 'ibuffer) + (defvar ibuffer-tmp-hide-regexps nil "A list of regexps which should match buffer names to not show.") @@ -93,32 +119,100 @@ regardless of any active filters in this buffer." (defvar ibuffer-auto-buffers-changed nil) -(defcustom ibuffer-saved-filters '(("gnus" - ((or (mode . message-mode) - (mode . mail-mode) - (mode . gnus-group-mode) - (mode . gnus-summary-mode) - (mode . gnus-article-mode)))) - ("programming" - ((or (mode . emacs-lisp-mode) - (mode . cperl-mode) - (mode . c-mode) - (mode . java-mode) - (mode . idl-mode) - (mode . lisp-mode))))) - - "An alist of filter qualifiers to switch between. +(defun ibuffer-update-saved-filters-format (filters) + "Transforms alist from old to new `ibuffer-saved-filters' format. + +Specifically, converts old-format alist with values of the +form (STRING (FILTER-SPECS...)) to alist with values of the +form (STRING FILTER-SPECS...), where each filter spec should be a +cons cell with a symbol in the car. Any elements in the latter +form are kept as is. + +Returns (OLD-FORMAT-DETECTED . UPDATED-SAVED-FILTERS-LIST)." + (when filters + (let* ((old-format-detected nil) + (fix-filter (lambda (filter-spec) + (if (symbolp (car (cadr filter-spec))) + filter-spec + (setq old-format-detected t) ; side-effect + (cons (car filter-spec) (cadr filter-spec))))) + (fixed (mapcar fix-filter filters))) + (cons old-format-detected fixed)))) -This variable should look like ((\"STRING\" QUALIFIERS) - (\"STRING\" QUALIFIERS) ...), where -QUALIFIERS is a list of the same form as -`ibuffer-filtering-qualifiers'. -See also the variables `ibuffer-filtering-qualifiers', -`ibuffer-filtering-alist', and the functions -`ibuffer-switch-to-saved-filters', `ibuffer-save-filters'." - :type '(repeat sexp) +(defcustom ibuffer-saved-filters '(("gnus" + (or (mode . message-mode) + (mode . mail-mode) + (mode . gnus-group-mode) + (mode . gnus-summary-mode) + (mode . gnus-article-mode))) + ("programming" + (or (mode . emacs-lisp-mode) + (mode . cperl-mode) + (mode . c-mode) + (mode . java-mode) + (mode . idl-mode) + (mode . lisp-mode)))) + + "An alist mapping saved filter names to filter specifications. + +Each element should look like (\"NAME\" . FILTER-LIST), where +FILTER-LIST has the same structure as the variable +`ibuffer-filtering-qualifiers', which see. The filters defined +here are joined with an implicit logical `and' and associated +with NAME. The combined specification can be used by name in +other filter specifications via the `saved' qualifier (again, see +`ibuffer-filtering-qualifiers'). They can also be switched to by +name (see the functions `ibuffer-switch-to-saved-filters' and +`ibuffer-save-filters'). The variable `ibuffer-save-with-custom' +affects how this information is saved for future sessions. This +variable can be set directly from lisp code." + :version "26.1" + :type '(alist :key-type (string :tag "Filter name") + :value-type (repeat :tag "Filter specification" sexp)) + :set (lambda (symbol value) + ;; Just set-default but update legacy old-style format + (set-default symbol (cdr (ibuffer-update-saved-filters-format value)))) :group 'ibuffer) +(defvar ibuffer-old-saved-filters-warning + (concat "Deprecated format detected for variable `ibuffer-saved-filters'. + +The format has been repaired and the variable modified accordingly. +You can save the current value through the customize system by +either clicking or hitting return " + (make-text-button + "here" nil + 'face '(:weight bold :inherit button) + 'mouse-face '(:weight normal :background "gray50" :inherit button) + 'follow-link t + 'help-echo "Click or RET: save new value in customize" + 'action (lambda (_) + (if (not (fboundp 'customize-save-variable)) + (message "Customize not available; value not saved") + (customize-save-variable 'ibuffer-saved-filters + ibuffer-saved-filters) + (message "Saved updated ibuffer-saved-filters.")))) + ". See below for +an explanation and alternative ways to save the repaired value. + +Explanation: For the list variable `ibuffer-saved-filters', +elements of the form (STRING (FILTER-SPECS...)) are deprecated +and should instead have the form (STRING FILTER-SPECS...), where +each filter spec is a cons cell with a symbol in the car. See +`ibuffer-saved-filters' for details. The repaired value fixes +this format without changing the meaning of the saved filters. + +Alternative ways to save the repaired value: + + 1. Do M-x customize-variable and entering `ibuffer-saved-filters' + when prompted. + + 2. Set the updated value manually by copying the + following emacs-lisp form to your emacs init file. + +%s +")) + (defvar ibuffer-filtering-qualifiers nil "A list like (SYMBOL . QUALIFIER) which filters the current buffer list. See also `ibuffer-filtering-alist'.") @@ -198,6 +292,28 @@ Currently, this only applies to `ibuffer-saved-filters' and :type 'boolean :group 'ibuffer) +(defun ibuffer-repair-saved-filters () + "Updates `ibuffer-saved-filters' to its new-style format, if needed. + +If this list has any elements of the old-style format, a +deprecation warning is raised, with a button allowing persistent +update. Any updated filters retain their meaning in the new +format. See `ibuffer-update-saved-filters-format' and +`ibuffer-saved-filters' for details of the old and new formats." + (interactive) + (when (and (boundp 'ibuffer-saved-filters) ibuffer-saved-filters) + (let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters))) + (prog1 + (setq ibuffer-saved-filters (cdr fixed)) + (when-let (old-format-detected (car fixed)) + (let ((warning-series t) + (updated-form + (with-output-to-string + (pp `(setq ibuffer-saved-filters ',ibuffer-saved-filters))))) + (display-warning + 'ibuffer + (format ibuffer-old-saved-filters-warning updated-form)))))))) + (defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf) (or (ibuffer-buf-matches-predicates buf ibuffer-tmp-show-regexps) @@ -224,8 +340,11 @@ the mode if ARG is omitted or nil." nil nil nil (unless (derived-mode-p 'ibuffer-mode) (error "This buffer is not in Ibuffer mode")) - (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector - (add-hook 'post-command-hook 'ibuffer-auto-update-changed)) + (cond (ibuffer-auto-mode + (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector + (add-hook 'post-command-hook 'ibuffer-auto-update-changed)) + (t + (remove-hook 'post-command-hook 'ibuffer-auto-update-changed)))) (defun ibuffer-auto-update-changed () (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) @@ -252,7 +371,7 @@ the mode if ARG is omitted or nil." (let ((buf (ibuffer-current-buffer))) (if (assq 'mode ibuffer-filtering-qualifiers) (setq ibuffer-filtering-qualifiers - (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers)) + (ibuffer-remove-alist 'mode ibuffer-filtering-qualifiers)) (ibuffer-push-filter (cons 'mode (buffer-local-value 'major-mode buf))))) (ibuffer-update nil t)) @@ -324,8 +443,7 @@ the mode if ARG is omitted or nil." :opstring "Shell command executed on" :modifier-p nil) (shell-command-on-region - (point-min) (point-max) command - (get-buffer-create "* ibuffer-shell-output*"))) + (point-min) (point-max) command)) ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext") (define-ibuffer-op shell-command-pipe-replace (command) @@ -347,10 +465,14 @@ the mode if ARG is omitted or nil." :modifier-p nil) (shell-command (concat command " " (shell-quote-argument - (if buffer-file-name - buffer-file-name - (make-temp-file - (substring (buffer-name) 0 (min 10 (length (buffer-name)))))))))) + (or buffer-file-name + (let ((file + (make-temp-file + (substring + (buffer-name) 0 + (min 10 (length (buffer-name))))))) + (write-region nil nil file nil 0) + file)))))) ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext") (define-ibuffer-op eval (form) @@ -503,13 +625,11 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (ibuffer-included-in-filter-p buf x)) (cdr filter)))) (`saved - (let ((data - (assoc (cdr filter) - ibuffer-saved-filters))) + (let ((data (assoc (cdr filter) ibuffer-saved-filters))) (unless data (ibuffer-filter-disable t) (error "Unknown saved filter %s" (cdr filter))) - (ibuffer-included-in-filters-p buf (cadr data)))) + (ibuffer-included-in-filters-p buf (cdr data)))) (_ (pcase-let ((`(,_type ,_desc ,func) (assq (car filter) ibuffer-filtering-alist))) @@ -524,7 +644,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (append ibuffer-filter-groups (list (cons "Default" nil)))))) ;; (dolist (hidden ibuffer-hidden-filter-groups) - ;; (setq filter-group-alist (ibuffer-delete-alist + ;; (setq filter-group-alist (ibuffer-remove-alist ;; hidden filter-group-alist))) (let ((vec (make-vector (length filter-group-alist) nil)) (i 0)) @@ -608,7 +728,7 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (interactive (list (ibuffer-read-filter-group-name "Decompose filter group: " t))) (let ((data (cdr (assoc group ibuffer-filter-groups)))) - (setq ibuffer-filter-groups (ibuffer-delete-alist + (setq ibuffer-filter-groups (ibuffer-remove-alist group ibuffer-filter-groups) ibuffer-filtering-qualifiers data)) (ibuffer-update nil t)) @@ -656,7 +776,7 @@ The group will be added to `ibuffer-filter-group-kill-ring'." (ibuffer-aif (assoc name ibuffer-filter-groups) (progn (push (copy-tree it) ibuffer-filter-group-kill-ring) - (setq ibuffer-filter-groups (ibuffer-delete-alist + (setq ibuffer-filter-groups (ibuffer-remove-alist name ibuffer-filter-groups)) (setq ibuffer-hidden-filter-groups (delete name ibuffer-hidden-filter-groups))) @@ -746,7 +866,7 @@ They are removed from `ibuffer-saved-filter-groups'." (completing-read "Delete saved filter group: " ibuffer-saved-filter-groups nil t)))) (setq ibuffer-saved-filter-groups - (ibuffer-delete-alist name ibuffer-saved-filter-groups)) + (ibuffer-remove-alist name ibuffer-saved-filter-groups)) (ibuffer-maybe-save-stuff) (ibuffer-update nil t)) @@ -808,43 +928,35 @@ This means that the topmost filter on the filtering stack, which must be a complex filter like (OR [name: foo] [mode: bar-mode]), will be turned into two separate filters [name: foo] and [mode: bar-mode]." (interactive) - (when (null ibuffer-filtering-qualifiers) + (unless ibuffer-filtering-qualifiers (error "No filters in effect")) - (let ((lim (pop ibuffer-filtering-qualifiers))) - (pcase (car lim) - (`or - (setq ibuffer-filtering-qualifiers (append - (cdr lim) - ibuffer-filtering-qualifiers))) - (`saved - (let ((data - (assoc (cdr lim) - ibuffer-saved-filters))) - (unless data - (ibuffer-filter-disable) - (error "Unknown saved filter %s" (cdr lim))) - (setq ibuffer-filtering-qualifiers (append - (cadr data) - ibuffer-filtering-qualifiers)))) - (`not - (push (cdr lim) - ibuffer-filtering-qualifiers)) - (_ - (error "Filter type %s is not compound" (car lim))))) + (let* ((filters ibuffer-filtering-qualifiers) + (head (cdar filters)) + (tail (cdr filters)) + (value + (pcase (caar filters) + (`or (nconc head tail)) + (`saved + (let ((data (assoc head ibuffer-saved-filters))) + (unless data + (ibuffer-filter-disable) + (error "Unknown saved filter %s" head)) + (append (cdr data) tail))) + (`not (cons head tail)) + (_ + (error "Filter type %s is not compound" (caar filters)))))) + (setq ibuffer-filtering-qualifiers value)) (ibuffer-update nil t)) ;;;###autoload (defun ibuffer-exchange-filters () "Exchange the top two filters on the stack in this buffer." (interactive) - (when (< (length ibuffer-filtering-qualifiers) - 2) - (error "Need two filters to exchange")) - (let ((first (pop ibuffer-filtering-qualifiers)) - (second (pop ibuffer-filtering-qualifiers))) - (push first ibuffer-filtering-qualifiers) - (push second ibuffer-filtering-qualifiers)) - (ibuffer-update nil t)) + (let ((filters ibuffer-filtering-qualifiers)) + (when (< (length filters) 2) + (error "Need two filters to exchange")) + (cl-rotatef (car filters) (cadr filters)) + (ibuffer-update nil t))) ;;;###autoload (defun ibuffer-negate-filter () @@ -907,7 +1019,7 @@ Interactively, prompt for NAME, and use the current filters." ibuffer-filtering-qualifiers))) (ibuffer-aif (assoc name ibuffer-saved-filters) (setcdr it filters) - (push (list name filters) ibuffer-saved-filters)) + (push (cons name filters) ibuffer-saved-filters)) (ibuffer-maybe-save-stuff)) ;;;###autoload @@ -920,7 +1032,7 @@ Interactively, prompt for NAME, and use the current filters." (completing-read "Delete saved filters: " ibuffer-saved-filters nil t)))) (setq ibuffer-saved-filters - (ibuffer-delete-alist name ibuffer-saved-filters)) + (ibuffer-remove-alist name ibuffer-saved-filters)) (ibuffer-maybe-save-stuff) (ibuffer-update nil t)) @@ -1388,7 +1500,7 @@ This requires the external program \"diff\" to be in your `exec-path'." ;;;###autoload (defun ibuffer-copy-filename-as-kill (&optional arg) - "Copy filenames of marked buffers into the kill ring. + "Copy filenames of marked (or next ARG) buffers into the kill ring. The names are separated by a space. If a buffer has no filename, it is ignored. @@ -1399,37 +1511,51 @@ With \\[universal-argument], use the filename of each marked file relative to `ibuffer-default-directory' if non-nil, otherwise `default-directory'. You can then feed the file name(s) to other commands with \\[yank]." - (interactive "p") - (if (zerop (ibuffer-count-marked-lines)) - (message "No buffers marked; use 'm' to mark a buffer") - (let ((ibuffer-copy-filename-as-kill-result "") - (type (cond ((or (null arg) (zerop arg)) - 'full) - ((= arg 4) - 'relative) - (t - 'name)))) - (ibuffer-map-marked-lines - #'(lambda (buf _mark) - (setq ibuffer-copy-filename-as-kill-result - (concat ibuffer-copy-filename-as-kill-result - (let ((name (buffer-file-name buf))) - (cond (name - (concat - (pcase type - (`full - name) - (`relative - (file-relative-name - name (or ibuffer-default-directory - default-directory))) - (_ - (file-name-nondirectory name))) " ")) - (t ""))))))) - (when (not (zerop (length ibuffer-copy-filename-as-kill-result))) - (setq ibuffer-copy-filename-as-kill-result - (substring ibuffer-copy-filename-as-kill-result 0 -1))) - (kill-new ibuffer-copy-filename-as-kill-result)))) + (interactive "P") + (let* ((buffers (cond ((and (integerp arg) (not (zerop arg))) + (ibuffer--near-buffers arg)) + (t + (or (ibuffer-get-marked-buffers) + (list (ibuffer-current-buffer)))))) + (file-names + (mapcar + (lambda (buf) + (let ((name (with-current-buffer buf + (ibuffer-buffer-file-name)))) + (if (null name) + "" + (cond ((and (integerp arg) (zerop arg)) name) + ((consp arg) + (file-relative-name + name (or ibuffer-default-directory + default-directory))) + (t (file-name-nondirectory name)))))) + buffers)) + (string + (mapconcat 'identity (delete "" file-names) " "))) + (unless (string= string "") + (if (eq last-command 'kill-region) + (kill-append string nil) + (kill-new string)) + (message "%s" string)))) + +;;;###autoload +(defun ibuffer-copy-buffername-as-kill (&optional arg) + "Copy buffer names of marked (or next ARG) buffers into the kill ring. +The names are separated by a space. +You can then feed the file name(s) to other commands with \\[yank]." + (interactive "P") + (let* ((buffers (cond ((and (integerp arg) (not (zerop arg))) + (ibuffer--near-buffers arg)) + (t + (or (ibuffer-get-marked-buffers) + (list (ibuffer-current-buffer)))))) + (string (mapconcat #'buffer-name buffers " "))) + (unless (string= string "") + (if (eq last-command 'kill-region) + (kill-append string nil) + (kill-new string)) + (message "%s" string)))) (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) (let ((count @@ -1453,6 +1579,23 @@ You can then feed the file name(s) to other commands with \\[yank]." #'(lambda (buf) (string-match regexp (buffer-name buf))))) +(defun ibuffer-locked-buffer-p (&optional buf) + "Return non-nil if BUF is locked. +When BUF nil, default to the buffer at current line." + (let ((cbuffer (or buf (ibuffer-current-buffer)))) + (when cbuffer + (with-current-buffer cbuffer + (and (boundp 'emacs-lock-mode) emacs-lock-mode))))) + +;;;###autoload +(defun ibuffer-mark-by-locked () + "Mark all locked buffers." + (interactive) + (when (featurep 'emacs-lock) + (ibuffer-mark-on-buffer + (lambda (buf) + (ibuffer-locked-buffer-p buf))))) + ;;;###autoload (defun ibuffer-mark-by-mode-regexp (regexp) "Mark all buffers whose major mode matches REGEXP." @@ -1478,6 +1621,31 @@ You can then feed the file name(s) to other commands with \\[yank]." (string-match regexp name)))))) ;;;###autoload +(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers) + "Mark all buffers whose content matches REGEXP. +Optional arg ALL-BUFFERS, if non-nil, then search in all buffers. +Otherwise buffers whose name matches an element of +`ibuffer-never-search-content-name' or whose major mode is on +`ibuffer-never-search-content-mode' are excluded." + (interactive (let ((reg (read-string "Mark by content (regexp): "))) + (list reg current-prefix-arg))) + (ibuffer-mark-on-buffer + #'(lambda (buf) + (let ((mode (with-current-buffer buf major-mode)) + res) + (cond ((and (not all-buffers) + (or + (memq mode ibuffer-never-search-content-mode) + (cl-some (lambda (x) (string-match x (buffer-name buf))) + ibuffer-never-search-content-name))) + (setq res nil)) + (t + (with-current-buffer buf + (save-mark-and-excursion + (goto-char (point-min)) + (setq res (re-search-forward regexp nil t)))))) res)))) + +;;;###autoload (defun ibuffer-mark-by-mode (mode) "Mark all buffers whose major mode equals MODE." (interactive diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 2f4d50d9a3e..3c95f4c44ce 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -198,8 +198,13 @@ operation is complete, in the form: ACTIVE-OPSTRING is a string which will be displayed to the user in a confirmation message, in the form: \"Really ACTIVE-OPSTRING x buffers?\" -COMPLEX means this function is special; see the source code of this -macro for exactly what it does. +COMPLEX means this function is special; if COMPLEX is nil BODY +evaluates once for each marked buffer, MBUF, with MBUF current +and saving the point. If COMPLEX is non-nil, BODY evaluates +without requiring MBUF current. +BODY define the operation; they are forms to evaluate per each +marked buffer. BODY is evaluated with `buf' bound to the +buffer object. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" (declare (indent 2) (doc-string 3)) @@ -297,8 +302,13 @@ bound to the current value of the filter. qualifier)) (ibuffer-update nil t)) (push (list ',name ,description - #'(lambda (buf qualifier) - ,@body)) + (lambda (buf qualifier) + (condition-case nil + ,@body + (error (ibuffer-pop-filter) + (when (eq ',name 'predicate) + (error "Wrong filter predicate: %S" + qualifier)))))) ibuffer-filtering-alist) :autoload-end))) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 9a1f3b9a0df..94cee329d5a 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -36,6 +36,7 @@ (require 'dired)) (require 'font-core) +(require 'seq) (require 'ibuffer-loaddefs) ;; These come from ibuf-ext.el, which can not be require'd at compile time @@ -70,7 +71,8 @@ and filter displayed buffers by various criteria." :version "22.1" :group 'convenience) -(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) +(defcustom ibuffer-formats '((mark modified read-only locked + " " (name 18 18 :left :elide) " " (size 9 -1 :right) " " (mode 16 16 :left :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) @@ -89,7 +91,7 @@ Each element in `ibuffer-formats' should be a list containing COLUMN specifiers. A COLUMN can be any of the following: SYMBOL - A symbol naming the column. Predefined columns are: - mark modified read-only name size mode process filename + mark modified read-only locked name size mode process filename When you define your own columns using `define-ibuffer-column', just use their name like the predefined columns here. This entry can also be a function of two arguments, which should return a string. @@ -136,6 +138,7 @@ value for this variable would be Using \\[ibuffer-switch-format], you can rotate the display between the specified formats in the list." + :version "26.1" :type '(repeat sexp) :group 'ibuffer) @@ -157,7 +160,8 @@ elisp byte-compiler." (null buffer-file-name)) italic) (30 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face) - (35 (derived-mode-p 'dired-mode) font-lock-function-name-face)) + (35 (derived-mode-p 'dired-mode) font-lock-function-name-face) + (40 (and (boundp 'emacs-lock-mode) emacs-lock-mode) ibuffer-locked-buffer)) "An alist describing how to fontify buffers. Each element should be of the form (PRIORITY FORM FACE), where PRIORITY is an integer, FORM is an arbitrary form to evaluate in the @@ -279,6 +283,12 @@ Note that this specialized filtering occurs before real filtering." :type 'character :group 'ibuffer) +(defcustom ibuffer-locked-char ?L + "The character to display for locked buffers." + :version "26.1" + :type 'character + :group 'ibuffer) + (defcustom ibuffer-deletion-char ?D "The character to display for buffers marked for deletion." :type 'character @@ -470,6 +480,8 @@ directory, like `default-directory'." (define-key map (kbd "DEL") 'ibuffer-unmark-backward) (define-key map (kbd "M-DEL") 'ibuffer-unmark-all) (define-key map (kbd "* *") 'ibuffer-unmark-all) + (define-key map (kbd "* c") 'ibuffer-change-marks) + (define-key map (kbd "U") 'ibuffer-unmark-all-marks) (define-key map (kbd "* M") 'ibuffer-mark-by-mode) (define-key map (kbd "* m") 'ibuffer-mark-modified-buffers) (define-key map (kbd "* u") 'ibuffer-mark-unsaved-buffers) @@ -544,6 +556,8 @@ directory, like `default-directory'." (define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp) (define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp) (define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp) + (define-key map (kbd "% g") 'ibuffer-mark-by-content-regexp) + (define-key map (kbd "% L") 'ibuffer-mark-by-locked) (define-key map (kbd "C-t") 'ibuffer-visit-tags-table) @@ -565,13 +579,14 @@ directory, like `default-directory'." (define-key map (kbd "R") 'ibuffer-do-rename-uniquely) (define-key map (kbd "S") 'ibuffer-do-save) (define-key map (kbd "T") 'ibuffer-do-toggle-read-only) - (define-key map (kbd "U") 'ibuffer-do-replace-regexp) + (define-key map (kbd "r") 'ibuffer-do-replace-regexp) (define-key map (kbd "V") 'ibuffer-do-revert) (define-key map (kbd "W") 'ibuffer-do-view-and-eval) (define-key map (kbd "X") 'ibuffer-do-shell-command-pipe) (define-key map (kbd "k") 'ibuffer-do-kill-lines) (define-key map (kbd "w") 'ibuffer-copy-filename-as-kill) + (define-key map (kbd "B") 'ibuffer-copy-buffername-as-kill) (define-key map (kbd "RET") 'ibuffer-visit-buffer) (define-key map (kbd "e") 'ibuffer-visit-buffer) @@ -700,16 +715,10 @@ directory, like `default-directory'." (define-key-after map [menu-bar view dashes2] '("--")) - (define-key-after map [menu-bar view diff-with-file] - '(menu-item "Diff with file" ibuffer-diff-with-file - :help "View the differences between this buffer and its file")) (define-key-after map [menu-bar view auto-mode] '(menu-item "Auto Mode" ibuffer-auto-mode :button (:toggle . ibuffer-auto-mode) :help "Attempt to automatically update the Ibuffer buffer")) - (define-key-after map [menu-bar view customize] - '(menu-item "Customize Ibuffer" ibuffer-customize - :help "Use Custom to customize Ibuffer")) (define-key-after map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) @@ -717,6 +726,9 @@ directory, like `default-directory'." (define-key-after map [menu-bar mark toggle-marks] '(menu-item "Toggle marks" ibuffer-toggle-marks :help "Unmark marked buffers, and mark unmarked buffers")) + (define-key-after map [menu-bar mark change-marks] + '(menu-item "Change marks" ibuffer-change-marks + :help "Change OLD mark for marked buffers with NEW")) (define-key-after map [menu-bar mark mark-forward] '(menu-item "Mark" ibuffer-mark-forward :help "Mark the buffer at point")) @@ -756,6 +768,8 @@ directory, like `default-directory'." :help "Mark buffers which have not been viewed recently")) (define-key-after map [menu-bar mark unmark-all] '(menu-item "Unmark All" ibuffer-unmark-all)) + (define-key-after map [menu-bar mark unmark-all-marks] + '(menu-item "Unmark All buffers" ibuffer-unmark-all-marks)) (define-key-after map [menu-bar mark dashes] '("--")) @@ -770,6 +784,13 @@ directory, like `default-directory'." '(menu-item "Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp :help "Mark buffers whose file name matches a regexp")) + (define-key-after map [menu-bar mark ibuffer-mark-by-content-regexp] + '(menu-item "Mark by content (regexp)..." + ibuffer-mark-by-content-regexp + :help "Mark buffers whose content matches a regexp")) + (define-key-after map [menu-bar mark mark-by-locked] + '(menu-item "Mark by locked buffers..." ibuffer-mark-by-locked + :help "Mark all locked buffers")) map)) @@ -820,6 +841,9 @@ directory, like `default-directory'." (define-key-after operate-map [do-view-and-eval] '(menu-item "Eval (viewing buffer)..." ibuffer-do-view-and-eval :help "Evaluate a Lisp form in each marked buffer while viewing it")) + (define-key-after operate-map [diff-with-file] + '(menu-item "Diff with file" ibuffer-diff-with-file + :help "View the differences between this buffer and its file")) operate-map)) @@ -969,8 +993,7 @@ width and the longest string in LIST." (popup-menu ibuffer-mode-groups-popup)) (let ((inhibit-read-only t)) (ibuffer-save-marks - ;; hm. we could probably do this in a better fashion - (ibuffer-unmark-all ?\r) + (ibuffer-unmark-all-marks) (save-excursion (goto-char eventpt) (ibuffer-set-mark ibuffer-marked-char)) @@ -1120,17 +1143,17 @@ a new window in the current frame, splitting vertically." (ibuffer-do-view-1 (if other-frame 'other-frame 'horizontally))) (defun ibuffer-do-view-1 (type) - (let ((marked-bufs (ibuffer-get-marked-buffers))) - (when (null marked-bufs) - (setq marked-bufs (list (ibuffer-current-buffer t)))) + (let ((marked-bufs (or (ibuffer-get-marked-buffers) + (list (ibuffer-current-buffer t))))) (unless (and (eq type 'other-frame) (not ibuffer-expert) (> (length marked-bufs) 3) (not (y-or-n-p (format "Really create a new frame for %s buffers? " (length marked-bufs))))) - (set-buffer-modified-p nil) - (delete-other-windows) - (switch-to-buffer (pop marked-bufs)) + (unless (eq type 'other-frame) + (set-buffer-modified-p nil) + (delete-other-windows) + (switch-to-buffer (pop marked-bufs))) (let ((height (/ (1- (if (eq type 'horizontally) (frame-width) (frame-height))) (1+ (length marked-bufs))))) @@ -1174,7 +1197,11 @@ a new window in the current frame, splitting vertically." (ibuffer-columnize-and-insert-list names) (goto-char (point-min)) (setq buffer-read-only t)) - (let ((lastwin (car (last (window-list nil 'nomini))))) + (let ((windows (nreverse (window-list nil 'nomini))) + lastwin) + (while (window-parameter (car windows) 'window-side) + (setq windows (cdr windows))) + (setq lastwin (car windows)) ;; Now attempt to display the buffer... (save-window-excursion (select-window lastwin) @@ -1213,7 +1240,7 @@ a new window in the current frame, splitting vertically." (let ((ibuffer-buffer-names-with-mark-result nil)) (ibuffer-map-lines-nomodify (lambda (buf mk) - (when (char-equal mark mk) + (when (eq mark mk) (push (buffer-name buf) ibuffer-buffer-names-with-mark-result)))) ibuffer-buffer-names-with-mark-result)) @@ -1228,15 +1255,15 @@ a new window in the current frame, splitting vertically." (if all (ibuffer-map-lines-nomodify (lambda (_buf mark) - (not (char-equal mark ?\s)))) + (not (eq mark ?\s)))) (ibuffer-map-lines-nomodify (lambda (_buf mark) - (char-equal mark ibuffer-marked-char))))) + (eq mark ibuffer-marked-char))))) (defsubst ibuffer-count-deletion-lines () (ibuffer-map-lines-nomodify (lambda (_buf mark) - (char-equal mark ibuffer-deletion-char)))) + (eq mark ibuffer-deletion-char)))) (defsubst ibuffer-map-deletion-lines (func) (ibuffer-map-on-mark ibuffer-deletion-char func)) @@ -1276,13 +1303,15 @@ a new window in the current frame, splitting vertically." :modifier-p t) (set-buffer-modified-p (not (buffer-modified-p)))) -(define-ibuffer-op ibuffer-do-toggle-read-only (&optional _arg);FIXME:arg unused! +(define-ibuffer-op ibuffer-do-toggle-read-only (&optional arg) "Toggle read only status in marked buffers. -With optional ARG, make read-only only if ARG is not negative." +If optional ARG is a non-negative integer, make buffers read only. +If ARG is a negative integer or 0, make buffers writable. +Otherwise, toggle read only status." (:opstring "toggled read only status in" :interactive "P" :modifier-p t) - (read-only-mode 'toggle)) + (read-only-mode (if (integerp arg) arg 'toggle))) (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." @@ -1312,25 +1341,20 @@ With optional ARG, make read-only only if ARG is not negative." (interactive "cRemove marks (RET means all):") (if (= (ibuffer-count-marked-lines t) 0) (message "No buffers marked; use 'm' to mark a buffer") - (cond - ((char-equal mark ibuffer-marked-char) - (ibuffer-map-marked-lines - (lambda (_buf _mark) - (ibuffer-set-mark-1 ?\s) - t))) - ((char-equal mark ibuffer-deletion-char) - (ibuffer-map-deletion-lines - (lambda (_buf _mark) - (ibuffer-set-mark-1 ?\s) - t))) - (t - (ibuffer-map-lines - (lambda (_buf mark) - (when (not (char-equal mark ?\s)) - (ibuffer-set-mark-1 ?\s)) - t))))) + (let ((fn (lambda (_buf mk) + (unless (eq mk ?\s) + (ibuffer-set-mark-1 ?\s)) t))) + (if (eq mark ?\r) + (ibuffer-map-lines fn) + (ibuffer-map-on-mark mark fn)))) (ibuffer-redisplay t)) +(defun ibuffer-unmark-all-marks () + "Remove all marks from all marked buffers in Ibuffer." + (interactive) + ;; hm. we could probably do this in a better fashion + (ibuffer-unmark-all ?\r)) + (defun ibuffer-toggle-marks (&optional group) "Toggle which buffers are marked. In other words, unmarked buffers become marked, and marked buffers @@ -1355,6 +1379,24 @@ group." (message "%s buffers marked" count)) (ibuffer-redisplay t)) +(defun ibuffer-change-marks (&optional old new) + "Change all OLD marks to NEW marks. +OLD and NEW are both characters used to mark buffers." + (interactive + (let* ((cursor-in-echo-area t) + (old (progn (message "Change (old mark): ") (read-char))) + (new (progn (message "Change %c marks to (new mark): " old) + (read-char)))) + (list old new))) + (if (or (eq old ?\r) (eq new ?\r)) + (ding) + (let ((count + (ibuffer-map-lines + (lambda (_buf mark) + (when (eq mark old) + (ibuffer-set-mark new) t))))) + (message "%s marks changed" count)))) + (defsubst ibuffer-get-region-and-prefix () (let ((arg (prefix-numeric-value current-prefix-arg))) (if (use-region-p) (list (region-beginning) (region-end) arg) @@ -1372,11 +1414,11 @@ If point is on a group name, this function operates on that group." (interactive (ibuffer-get-region-and-prefix)) (ibuffer-mark-region-or-n-with-char start end arg ?\s)) -(defun ibuffer-unmark-backward (arg) - "Unmark the ARG previous buffers. +(defun ibuffer-unmark-backward (start end arg) + "Unmark the buffers in the region, or previous ARG buffers. If point is on a group name, this function operates on that group." - (interactive "p") - (ibuffer-unmark-forward nil nil (- arg))) + (interactive (ibuffer-get-region-and-prefix)) + (ibuffer-unmark-forward start end (- arg))) (defun ibuffer-mark-region-or-n-with-char (start end arg mark-char) (if (use-region-p) @@ -1398,15 +1440,14 @@ If point is on a group name, this function operates on that group." (require 'ibuf-ext) (ibuffer-mark-on-buffer #'identity mark it)) (ibuffer-forward-line 0 t) - (let ((inhibit-read-only t)) - (while (> arg 0) - (ibuffer-set-mark mark) - (ibuffer-forward-line 1 t) - (setq arg (1- arg))) - (while (< arg 0) - (ibuffer-forward-line -1 t) - (ibuffer-set-mark mark) - (setq arg (1+ arg)))))) + (while (> arg 0) + (ibuffer-set-mark mark) + (ibuffer-forward-line 1 t) + (setq arg (1- arg))) + (while (< arg 0) + (ibuffer-forward-line -1 t) + (ibuffer-set-mark mark) + (setq arg (1+ arg))))) (defun ibuffer-set-mark (mark) (ibuffer-assert-ibuffer-mode) @@ -1502,20 +1543,23 @@ If point is on a group name, this function operates on that group." (if (or elide (with-no-warnings ibuffer-elide-long-columns)) `(if (> strlen 5) ,(if from-end-p + ;; FIXME: this should probably also be using + ;; `truncate-string-to-width' (Bug#24972) `(concat ,ellipsis (substring ,strvar - (length ibuffer-eliding-string))) + (string-width ibuffer-eliding-string))) `(concat - (substring ,strvar 0 (- strlen ,(length ellipsis))) - ,ellipsis)) + (truncate-string-to-width + ,strvar (- strlen (string-width ,ellipsis)) nil ?.) + ,ellipsis)) ,strvar) strvar))) (defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p) (if from-end-p - `(substring str - (- strlen ,maxvar)) - `(substring ,strvar 0 ,maxvar))) + ;; FIXME: not sure if this case is correct (Bug#24972) + `(truncate-string-to-width str strlen (- strlen ,maxvar) nil ?\s) + `(truncate-string-to-width ,strvar ,maxvar nil ?\s))) (defun ibuffer-compile-make-format-form (strvar widthform alignment) (let* ((left `(make-string tmp2 ?\s)) @@ -1584,7 +1628,7 @@ If point is on a group name, this function operates on that group." max 'max) from-end-p)) - (setq strlen (length str)) + (setq strlen (string-width str)) (setq str ,(ibuffer-compile-make-eliding-form 'str elide from-end-p))))) @@ -1642,7 +1686,7 @@ If point is on a group name, this function operates on that group." outforms) (push `(setq str ,callform ,@(when strlen-used - `(strlen (length str)))) + `(strlen (string-width str)))) outforms) (setq outforms (append outforms @@ -1715,6 +1759,15 @@ If point is on a group name, this function operates on that group." (defvar ibuffer-inline-columns nil) +(defface ibuffer-locked-buffer + '((((background dark)) (:foreground "RosyBrown")) + (t (:foreground "brown4"))) + "*Face used for locked buffers in Ibuffer." + :version "26.1" + :group 'ibuffer + :group 'font-lock-highlighting-faces) +(defvar ibuffer-locked-buffer 'ibuffer-locked-buffer) + (define-ibuffer-column mark (:name " " :inline t) (string mark)) @@ -1723,6 +1776,12 @@ If point is on a group name, this function operates on that group." (string ibuffer-read-only-char) " ")) +(define-ibuffer-column locked + (:name "L" :inline t :props ('font-lock-face 'ibuffer-locked-buffer)) + (if (and (boundp 'emacs-lock-mode) emacs-lock-mode) + (string ibuffer-locked-char) + " ")) + (define-ibuffer-column modified (:name "M" :inline t) (if (buffer-modified-p) (string ibuffer-modified-char) @@ -1743,7 +1802,13 @@ If point is on a group name, this function operates on that group." (cond ((zerop bufs) "No buffers") ((= 1 bufs) "1 buffer") (t (format "%s buffers" bufs)))))) - (propertize (buffer-name) 'font-lock-face (ibuffer-buffer-name-face buffer mark))) + (let ((string (propertize (buffer-name) + 'font-lock-face + (ibuffer-buffer-name-face buffer mark)))) + (if (not (seq-position string ?\n)) + string + (replace-regexp-in-string + "\n" (propertize "^J" 'font-lock-face 'escape-glyph) string)))) (define-ibuffer-column size (:inline t @@ -1830,9 +1895,9 @@ If point is on a group name, this function operates on that group." (_ (concat str left right))))) (defun ibuffer-buffer-name-face (buf mark) - (cond ((char-equal mark ibuffer-marked-char) + (cond ((eq mark ibuffer-marked-char) ibuffer-marked-face) - ((char-equal mark ibuffer-deletion-char) + ((eq mark ibuffer-deletion-char) ibuffer-deletion-face) (t (let ((level -1) @@ -1876,7 +1941,7 @@ If point is on a group name, this function operates on that group." (defun ibuffer-map-on-mark (mark func) (ibuffer-map-lines (lambda (buf mk) - (if (char-equal mark mk) + (if (eq mark mk) (funcall func buf mark) nil)))) @@ -1947,6 +2012,16 @@ the buffer object itself and the current mark symbol." (ibuffer-forward-line 0) (ibuffer-forward-line (1- target-line-offset)))))) +;; Return buffers around current line. +(defun ibuffer--near-buffers (n) + (delq nil + (mapcar + (lambda (x) + (car (get-text-property + (line-beginning-position (if (natnump n) x (- (1- x)))) + 'ibuffer-properties))) + (number-sequence 1 (abs n))))) + (defun ibuffer-get-marked-buffers () "Return a list of buffer objects currently marked." (delq nil @@ -2093,8 +2168,8 @@ the value of point at the beginning of the line for that buffer." (buffer-substring (point) (line-end-position))))) (apply #'insert (mapcar (lambda (c) - (if (not (or (char-equal c ?\s) - (char-equal c ?\n))) + (if (not (or (eq c ?\s) + (eq c ?\n))) ?- ?\s)) str))) @@ -2337,7 +2412,8 @@ FORMATS is the value to use for `ibuffer-formats'. (setq other-window-p t)) (let ((buf (get-buffer-create (or name "*Ibuffer*")))) (if other-window-p - (funcall (if noselect (lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf) + (or (and noselect (display-buffer buf t)) + (pop-to-buffer buf t)) (funcall (if noselect #'display-buffer #'switch-to-buffer) buf)) (with-current-buffer buf (save-selected-window @@ -2412,10 +2488,12 @@ Marking commands: `\\[ibuffer-mark-forward]' - Mark the buffer at point. `\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark all unmarked buffers. + `\\[ibuffer-change-marks]' - Change the mark used on marked buffers. `\\[ibuffer-unmark-forward]' - Unmark the buffer at point. `\\[ibuffer-unmark-backward]' - Unmark the buffer at point, and move to the previous line. - `\\[ibuffer-unmark-all]' - Unmark all marked buffers. + `\\[ibuffer-unmark-all]' - Unmark buffers marked with MARK. + `\\[ibuffer-unmark-all-marks]' - Unmark all marked buffers. `\\[ibuffer-mark-by-mode]' - Mark buffers by major mode. `\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers. This means that the buffer is modified, and has an associated file. @@ -2433,6 +2511,8 @@ Marking commands: `\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp. `\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp. `\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp. + `\\[ibuffer-mark-by-content-regexp]' - Mark buffers by their content, using a regexp. + `\\[ibuffer-mark-by-locked]' - Mark all locked buffers. Filtering commands: diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 3b60daa9654..6a962640dea 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -388,6 +388,9 @@ matches exist." (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) (format " %sNo matches%s" open-bracket close-bracket)) (if last (setcdr last nil)) + (when (and minibuffer-completing-file-name + icomplete-with-completion-tables) + (setq comps (completion-pcm--filename-try-filter comps))) (let* ((most-try (if (and base-size (> base-size 0)) (completion-try-completion diff --git a/lisp/ido.el b/lisp/ido.el index 0e74cbc7a2d..9df89c9fb61 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1882,6 +1882,7 @@ If INITIAL is non-nil, it specifies the initial input string." ido-selected ido-final-text (done nil) + (non-essential t) ;; prevent eager Tramp connection (icomplete-mode nil) ;; prevent icomplete starting up ;; Exported dynamic variables: ido-cur-list diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 67b023dfd70..7978f075645 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -104,9 +104,6 @@ ;; * Some sort of auto-rotate function based on rotate info in the ;; EXIF data. ;; -;; * Check if exiftool exist before trying to call it to give a better -;; error message. -;; ;; * Investigate if it is possible to also write the tags to the image ;; files. ;; @@ -156,9 +153,8 @@ (require 'format-spec) (require 'widget) -(require 'cl-lib) - (eval-when-compile + (require 'cl-lib) (require 'wid-edit)) (defgroup image-dired nil @@ -274,8 +270,7 @@ with the information required by the Thumbnail Managing Standard." (defcustom image-dired-cmd-create-standard-thumbnail-command (concat - image-dired-cmd-create-thumbnail-program " " - "-size %wx%h \"%f\" " + "%p -size %wx%h \"%f\" " (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) (concat "-set \"Thumb::MTime\" \"%m\" " @@ -304,6 +299,7 @@ with the information required by the Thumbnail Managing Standard." "%q %t" " ; rm %q"))) "Command to create thumbnails according to the Thumbnail Managing Standard." + :version "26.1" :type 'string :group 'image-dired) @@ -613,8 +609,14 @@ according to the Thumbnail Managing Standard." (file-name-base f) (file-name-extension f)))))) +(defun image-dired--check-executable-exists (executable) + (unless (executable-find (symbol-value executable)) + (error "Executable %S not found" executable))) + (defun image-dired-create-thumb (original-file thumbnail-file) "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE." + (image-dired--check-executable-exists + 'image-dired-cmd-create-thumbnail-program) (let* ((width (int-to-string image-dired-thumb-width)) (height (int-to-string image-dired-thumb-height)) (modif-time (format "%.0f" (float-time (nth 5 (file-attributes @@ -650,25 +652,22 @@ of the marked files. If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) files." (interactive "P") (dired-map-over-marks - (let* ((image-pos (dired-move-to-filename)) - (image-file (dired-get-filename nil t)) - thumb-file - overlay) + (let ((image-pos (dired-move-to-filename)) + (image-file (dired-get-filename nil t)) + thumb-file + overlay) (when (and image-file (string-match-p (image-file-name-regexp) image-file)) (setq thumb-file (image-dired-get-thumbnail-image image-file)) ;; If image is not already added, then add it. - (let* ((cur-ovs (overlays-in (point) (1+ (point)))) - (thumb-ov (car (cl-remove-if-not - (lambda (ov) (overlay-get ov 'thumb-file)) - cur-ovs)))) + (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point))) + if (overlay-get ov 'thumb-file) return ov))) (if thumb-ov (delete-overlay thumb-ov) (put-image thumb-file image-pos) (setq overlay - (cl-loop for o in (overlays-in (point) (1+ (point))) - when (overlay-get o 'put-image) collect o into ov - finally return (car ov))) + (cl-loop for ov in (overlays-in (point) (1+ (point))) + if (overlay-get ov 'put-image) return ov)) (overlay-put overlay 'image-file image-file) (overlay-put overlay 'thumb-file thumb-file))))) arg ; Show or hide image on ARG next files. @@ -793,9 +792,9 @@ calling `image-dired-restore-window-configuration'." (setq truncate-lines t) (save-excursion (other-window 1) - (switch-to-buffer buf) + (pop-to-buffer-same-window buf) (select-window (split-window-below)) - (switch-to-buffer buf2) + (pop-to-buffer-same-window buf2) (other-window -2))))) (defun image-dired-restore-window-configuration () @@ -840,14 +839,15 @@ thumbnail buffer to be selected." (if (not append) (erase-buffer) (goto-char (point-max))) - (mapc - (lambda (curr-file) - (setq thumb-name (image-dired-thumb-name curr-file)) - (if (and (not (file-exists-p thumb-name)) - (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) - (message "Thumb could not be created for file %s" curr-file) - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) - files)) + (dolist (curr-file files) + (setq thumb-name (image-dired-thumb-name curr-file)) + (if (and (not (file-exists-p thumb-name)) + (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) + (message "Thumb could not be created for file %s" curr-file) + (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))) + (if do-not-pop + (display-buffer buf) + (pop-to-buffer buf)) (cond ((eq 'dynamic image-dired-line-up-method) (image-dired-line-up-dynamic)) ((eq 'fixed image-dired-line-up-method) @@ -857,10 +857,7 @@ thumbnail buffer to be selected." ((eq 'none image-dired-line-up-method) nil) (t - (image-dired-line-up-dynamic)))) - (if do-not-pop - (display-buffer image-dired-thumbnail-buffer) - (pop-to-buffer image-dired-thumbnail-buffer)))) + (image-dired-line-up-dynamic)))))) ;;;###autoload (defun image-dired-show-all-from-dir (dir) @@ -868,7 +865,7 @@ thumbnail buffer to be selected." If the number of files in DIR matching `image-file-name-regexp' exceeds `image-dired-show-all-from-dir-max-files', a warning will be displayed." - (interactive "DDir: ") + (interactive "DImage Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) (let ((files (dired-get-marked-files))) @@ -1104,7 +1101,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (eobp)) (save-excursion (forward-char) @@ -1125,7 +1122,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (bobp)) (save-excursion (backward-char) @@ -1144,7 +1141,8 @@ image." "Move to next line and display properties." (interactive) (let ((goal-column (current-column))) - (next-line)) + (forward-line 1) + (move-to-column goal-column)) ;; If we end up in an empty spot, back up to the next thumbnail. (if (not (image-dired-image-at-point-p)) (image-dired-backward-image)) @@ -1157,7 +1155,8 @@ image." "Move to previous line and display properties." (interactive) (let ((goal-column (current-column))) - (previous-line)) + (forward-line -1) + (move-to-column goal-column)) ;; If we end up in an empty spot, back up to the next ;; thumbnail. This should only happen if the user deleted a ;; thumbnail and did not refresh, so it is not very common. But we @@ -1276,198 +1275,122 @@ You probably want to use this together with (select-window window)) (message "Thumbnail buffer not visible")))) -(defvar image-dired-thumbnail-mode-map (make-sparse-keymap) - "Keymap for `image-dired-thumbnail-mode'.") - -(defvar image-dired-thumbnail-mode-line-up-map (make-sparse-keymap) +(defvar image-dired-thumbnail-mode-line-up-map + (let ((map (make-sparse-keymap))) + ;; map it to "g" so that the user can press it more quickly + (define-key map "g" 'image-dired-line-up-dynamic) + ;; "f" for "fixed" number of thumbs per row + (define-key map "f" 'image-dired-line-up) + ;; "i" for "interactive" + (define-key map "i" 'image-dired-line-up-interactive) + map) "Keymap for line-up commands in `image-dired-thumbnail-mode'.") -(defvar image-dired-thumbnail-mode-tag-map (make-sparse-keymap) +(defvar image-dired-thumbnail-mode-tag-map + (let ((map (make-sparse-keymap))) + ;; map it to "t" so that the user can press it more quickly + (define-key map "t" 'image-dired-tag-thumbnail) + ;; "r" for "remove" + (define-key map "r" 'image-dired-tag-thumbnail-remove) + map) "Keymap for tag commands in `image-dired-thumbnail-mode'.") -(defun image-dired-define-thumbnail-mode-keymap () - "Define keymap for `image-dired-thumbnail-mode'." - - ;; Keys - (define-key image-dired-thumbnail-mode-map [right] 'image-dired-forward-image) - (define-key image-dired-thumbnail-mode-map [left] 'image-dired-backward-image) - (define-key image-dired-thumbnail-mode-map [up] 'image-dired-previous-line) - (define-key image-dired-thumbnail-mode-map [down] 'image-dired-next-line) - (define-key image-dired-thumbnail-mode-map "\C-f" 'image-dired-forward-image) - (define-key image-dired-thumbnail-mode-map "\C-b" 'image-dired-backward-image) - (define-key image-dired-thumbnail-mode-map "\C-p" 'image-dired-previous-line) - (define-key image-dired-thumbnail-mode-map "\C-n" 'image-dired-next-line) - - (define-key image-dired-thumbnail-mode-map "d" 'image-dired-flag-thumb-original-file) - (define-key image-dired-thumbnail-mode-map [delete] - 'image-dired-flag-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "m" 'image-dired-mark-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "u" 'image-dired-unmark-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "." 'image-dired-track-original-file) - (define-key image-dired-thumbnail-mode-map [tab] 'image-dired-jump-original-dired-buffer) - - ;; add line-up map - (define-key image-dired-thumbnail-mode-map "g" image-dired-thumbnail-mode-line-up-map) - - ;; map it to "g" so that the user can press it more quickly - (define-key image-dired-thumbnail-mode-line-up-map "g" 'image-dired-line-up-dynamic) - ;; "f" for "fixed" number of thumbs per row - (define-key image-dired-thumbnail-mode-line-up-map "f" 'image-dired-line-up) - ;; "i" for "interactive" - (define-key image-dired-thumbnail-mode-line-up-map "i" 'image-dired-line-up-interactive) - - ;; add tag map - (define-key image-dired-thumbnail-mode-map "t" image-dired-thumbnail-mode-tag-map) - - ;; map it to "t" so that the user can press it more quickly - (define-key image-dired-thumbnail-mode-tag-map "t" 'image-dired-tag-thumbnail) - ;; "r" for "remove" - (define-key image-dired-thumbnail-mode-tag-map "r" 'image-dired-tag-thumbnail-remove) - - (define-key image-dired-thumbnail-mode-map "\C-m" - 'image-dired-display-thumbnail-original-image) - (define-key image-dired-thumbnail-mode-map [C-return] - 'image-dired-thumbnail-display-external) - - (define-key image-dired-thumbnail-mode-map "l" 'image-dired-rotate-thumbnail-left) - (define-key image-dired-thumbnail-mode-map "r" 'image-dired-rotate-thumbnail-right) - - (define-key image-dired-thumbnail-mode-map "L" 'image-dired-rotate-original-left) - (define-key image-dired-thumbnail-mode-map "R" 'image-dired-rotate-original-right) - - (define-key image-dired-thumbnail-mode-map "D" - 'image-dired-thumbnail-set-image-description) - - (define-key image-dired-thumbnail-mode-map "\C-d" 'image-dired-delete-char) - (define-key image-dired-thumbnail-mode-map " " - 'image-dired-display-next-thumbnail-original) - (define-key image-dired-thumbnail-mode-map - (kbd "DEL") 'image-dired-display-previous-thumbnail-original) - (define-key image-dired-thumbnail-mode-map "c" 'image-dired-comment-thumbnail) - (define-key image-dired-thumbnail-mode-map "q" 'image-dired-kill-buffer-and-window) - - ;; Mouse - (define-key image-dired-thumbnail-mode-map [mouse-2] 'image-dired-mouse-display-image) - (define-key image-dired-thumbnail-mode-map [mouse-1] 'image-dired-mouse-select-thumbnail) - - ;; Seems I must first set C-down-mouse-1 to undefined, or else it - ;; will trigger the buffer menu. If I try to instead bind - ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message - ;; about C-mouse-1 not being defined afterwards. Annoying, but I - ;; probably do not completely understand mouse events. - - (define-key image-dired-thumbnail-mode-map [C-down-mouse-1] 'undefined) - (define-key image-dired-thumbnail-mode-map [C-mouse-1] 'image-dired-mouse-toggle-mark) - - ;; Menu - (define-key image-dired-thumbnail-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) +(defvar image-dired-thumbnail-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [right] 'image-dired-forward-image) + (define-key map [left] 'image-dired-backward-image) + (define-key map [up] 'image-dired-previous-line) + (define-key map [down] 'image-dired-next-line) + (define-key map "\C-f" 'image-dired-forward-image) + (define-key map "\C-b" 'image-dired-backward-image) + (define-key map "\C-p" 'image-dired-previous-line) + (define-key map "\C-n" 'image-dired-next-line) + + (define-key map "d" 'image-dired-flag-thumb-original-file) + (define-key map [delete] 'image-dired-flag-thumb-original-file) + (define-key map "m" 'image-dired-mark-thumb-original-file) + (define-key map "u" 'image-dired-unmark-thumb-original-file) + (define-key map "." 'image-dired-track-original-file) + (define-key map [tab] 'image-dired-jump-original-dired-buffer) + + ;; add line-up map + (define-key map "g" image-dired-thumbnail-mode-line-up-map) + ;; add tag map + (define-key map "t" image-dired-thumbnail-mode-tag-map) + + (define-key map "\C-m" 'image-dired-display-thumbnail-original-image) + (define-key map [C-return] 'image-dired-thumbnail-display-external) + + (define-key map "l" 'image-dired-rotate-thumbnail-left) + (define-key map "r" 'image-dired-rotate-thumbnail-right) + (define-key map "L" 'image-dired-rotate-original-left) + (define-key map "R" 'image-dired-rotate-original-right) + + (define-key map "D" 'image-dired-thumbnail-set-image-description) + (define-key map "\C-d" 'image-dired-delete-char) + (define-key map " " 'image-dired-display-next-thumbnail-original) + (define-key map (kbd "DEL") 'image-dired-display-previous-thumbnail-original) + (define-key map "c" 'image-dired-comment-thumbnail) + (define-key map "q" 'image-dired-kill-buffer-and-window) + + ;; Mouse + (define-key map [mouse-2] 'image-dired-mouse-display-image) + (define-key map [mouse-1] 'image-dired-mouse-select-thumbnail) + ;; Seems I must first set C-down-mouse-1 to undefined, or else it + ;; will trigger the buffer menu. If I try to instead bind + ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message + ;; about C-mouse-1 not being defined afterwards. Annoying, but I + ;; probably do not completely understand mouse events. + (define-key map [C-down-mouse-1] 'undefined) + (define-key map [C-mouse-1] 'image-dired-mouse-toggle-mark) + + ;; Menu + (easy-menu-define nil map + "Menu for `image-dired-thumbnail-mode'." + '("Image-Dired" + ["Quit" image-dired-kill-buffer-and-window] + ["Delete thumbnail from buffer" image-dired-delete-char] + ["Remove tag from thumbnail" image-dired-tag-thumbnail-remove] + ["Tag thumbnail" image-dired-tag-thumbnail] + ["Comment thumbnail" image-dired-comment-thumbnail] + ["Refresh thumb" image-dired-refresh-thumb] + ["Dynamic line up" image-dired-line-up-dynamic] + ["Line up thumbnails" image-dired-line-up] + + ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] + ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] + ["Rotate original left" image-dired-rotate-original-left] + ["Rotate original right" image-dired-rotate-original-right] + + ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking] + + ["Jump to dired buffer" image-dired-jump-original-dired-buffer] + ["Track original" image-dired-track-original-file] + + ["Flag original for deletion" image-dired-flag-thumb-original-file] + ["Unmark original" image-dired-unmark-thumb-original-file] + ["Mark original" image-dired-mark-thumb-original-file] + + ["Display in external viewer" image-dired-thumbnail-display-external] + ["Display image" image-dired-display-thumbnail-original-image])) + map) + "Keymap for `image-dired-thumbnail-mode'.") - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-kill-buffer-and-window] - '("Quit" . image-dired-kill-buffer-and-window)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-delete-char] - '("Delete thumbnail from buffer" . image-dired-delete-char)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-tag-thumbnail-remove] - '("Remove tag from thumbnail" . image-dired-tag-thumbnail-remove)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-tag-thumbnail] - '("Tag thumbnail" . image-dired-tag-thumbnail)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-comment-thumbnail] - '("Comment thumbnail" . image-dired-comment-thumbnail)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-refresh-thumb] - '("Refresh thumb" . image-dired-refresh-thumb)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-line-up-dynamic] - '("Dynamic line up" . image-dired-line-up-dynamic)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-line-up] - '("Line up thumbnails" . image-dired-line-up)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-thumbnail-left] - '("Rotate thumbnail left" . image-dired-rotate-thumbnail-left)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-thumbnail-right] - '("Rotate thumbnail right" . image-dired-rotate-thumbnail-right)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-original-left] - '("Rotate original left" . image-dired-rotate-original-left)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-original-right] - '("Rotate original right" . image-dired-rotate-original-right)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-toggle-movement-tracking] - '("Toggle movement tracking on/off" . image-dired-toggle-movement-tracking)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-jump-original-dired-buffer] - '("Jump to dired buffer" . image-dired-jump-original-dired-buffer)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-track-original-file] - '("Track original" . image-dired-track-original-file)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-flag-thumb-original-file] - '("Flag original for deletion" . image-dired-flag-thumb-original-file)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-unmark-thumb-original-file] - '("Unmark original" . image-dired-unmark-thumb-original-file)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-mark-thumb-original-file] - '("Mark original" . image-dired-mark-thumb-original-file)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-thumbnail-display-external] - '("Display in external viewer" . image-dired-thumbnail-display-external)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-display-thumbnail-original-image] - '("Display image" . image-dired-display-thumbnail-original-image))) - -(defvar image-dired-display-image-mode-map (make-sparse-keymap) +(defvar image-dired-display-image-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'image-dired-kill-buffer-and-window) + (define-key map "f" 'image-dired-display-current-image-full) + (define-key map "s" 'image-dired-display-current-image-sized) + + (easy-menu-define nil map + "Menu for `image-dired-display-image-mode-map'." + '("Image-Dired" + ["Quit" image-dired-kill-buffer-and-window] + ["Display original, sized to fit" image-dired-display-current-image-sized] + ["Display original, full size" image-dired-display-current-image-full])) + map) "Keymap for `image-dired-display-image-mode'.") -(defun image-dired-define-display-image-mode-keymap () - "Define keymap for `image-dired-display-image-mode'." - - ;; Keys - (define-key image-dired-display-image-mode-map "q" 'image-dired-kill-buffer-and-window) - - (define-key image-dired-display-image-mode-map "f" - 'image-dired-display-current-image-full) - - (define-key image-dired-display-image-mode-map "s" - 'image-dired-display-current-image-sized) - - ;; Menu - (define-key image-dired-display-image-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-kill-buffer-and-window] - '("Quit" . image-dired-kill-buffer-and-window)) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-display-current-image-sized] - '("Display original, sized to fit" . image-dired-display-current-image-sized)) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-display-current-image-full] - '("Display original, full size" . image-dired-display-current-image-full)) - - ) - (defun image-dired-display-current-image-full () "Display current image in full size." (interactive) @@ -1485,7 +1408,7 @@ You probably want to use this together with (if file (progn (image-dired-display-image file) - (message "Full size image displayed")) + (message "Fitted image displayed")) (error "No original file name at point")))) (define-derived-mode image-dired-thumbnail-mode @@ -1493,14 +1416,12 @@ You probably want to use this together with "Browse and manipulate thumbnail images using dired. Use `image-dired-dired' and `image-dired-setup-dired-keybindings' to get a nice setup to start with." - (image-dired-define-thumbnail-mode-keymap) (message "image-dired-thumbnail-mode enabled")) (define-derived-mode image-dired-display-image-mode fundamental-mode "image-dired-image-display" "Mode for displaying and manipulating original image. Resized or in full-size." - (image-dired-define-display-image-mode-keymap) (message "image-dired-display-image-mode enabled")) ;;;###autoload @@ -1603,22 +1524,18 @@ Note that n, p and <down> and <up> will be hijacked and bound to With prefix argument ARG, create thumbnails even if they already exist \(i.e. use this to refresh your thumbnails)." (interactive "P") - (let (thumb-name files) - (setq files (dired-get-marked-files)) - (mapcar - (lambda (curr-file) - (setq thumb-name (image-dired-thumb-name curr-file)) - ;; If the user overrides the exist check, we must clear the - ;; image cache so that if the user wants to display the - ;; thumbnail, it is not fetched from cache. - (if arg - (clear-image-cache)) - (if (or (not (file-exists-p thumb-name)) - arg) - (if (not (= 0 (image-dired-create-thumb curr-file - (image-dired-thumb-name curr-file)))) - (error "Thumb could not be created")))) - files))) + (let (thumb-name) + (dolist (curr-file (dired-get-marked-files)) + (setq thumb-name (image-dired-thumb-name curr-file)) + ;; If the user overrides the exist check, we must clear the + ;; image cache so that if the user wants to display the + ;; thumbnail, it is not fetched from cache. + (if arg + (clear-image-cache)) + (when (or (not (file-exists-p thumb-name)) + arg) + (when (not (= 0 (image-dired-create-thumb curr-file thumb-name))) + (error "Thumb could not be created")))))) (defvar image-dired-slideshow-timer nil "Slideshow timer.") @@ -1802,6 +1719,8 @@ should feel snappy enough. If optional argument ORIGINAL-SIZE is non-nil, display image in its original size." + (image-dired--check-executable-exists + 'image-dired-cmd-create-temp-image-program) (let ((new-file (expand-file-name image-dired-temp-image-file)) width height command ret (image-type 'jpeg)) @@ -1866,6 +1785,8 @@ With prefix argument ARG, display image in its original size." (defun image-dired-rotate-thumbnail (degrees) "Rotate thumbnail DEGREES degrees." + (image-dired--check-executable-exists + 'image-dired-cmd-rotate-thumbnail-program) (if (not (image-dired-image-at-point-p)) (message "No thumbnail at point") (let ((file (image-dired-thumb-name (image-dired-original-file-name))) @@ -1908,12 +1829,14 @@ overwritten. This confirmation can be turned off using (defun image-dired-rotate-original (degrees) "Rotate original image DEGREES degrees." + (image-dired--check-executable-exists + 'image-dired-cmd-rotate-original-program) (if (not (image-dired-image-at-point-p)) (message "No image at point") (let ((file (image-dired-original-file-name)) command) - (if (not (string-match "\\.[jJ][pP[eE]?[gG]$" file)) - (error "Only JPEG images can be rotated!")) + (unless (eq 'jpeg (image-type file)) + (error "Only JPEG images can be rotated!")) (setq command (format-spec image-dired-cmd-rotate-original-options (list @@ -1952,15 +1875,14 @@ for traceability. The format of the returned file name is YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from `image-dired-copy-with-exif-file-name'." (let (data no-exif-data-found) - (if (not (string-match "\\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file))) - (progn - (setq no-exif-data-found t) - (setq data - (format-time-string - "%Y:%m:%d %H:%M:%S" - (nth 5 (file-attributes (expand-file-name file)))))) + (if (not (eq 'jpeg (image-type (expand-file-name file)))) + (setq no-exif-data-found t + data (format-time-string + "%Y:%m:%d %H:%M:%S" + (file-attribute-modification-time + (file-attributes (expand-file-name file))))) (setq data (image-dired-get-exif-data (expand-file-name file) - "DateTimeOriginal"))) + "DateTimeOriginal"))) (while (string-match "[ :]" data) (setq data (replace-match "_" nil nil data))) (format "%s%s%s" data @@ -1987,6 +1909,8 @@ default value at the prompt." (defun image-dired-set-exif-data (file tag-name tag-value) "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE." + (image-dired--check-executable-exists + 'image-dired-cmd-write-exif-data-program) (let (command) (setq command (format-spec image-dired-cmd-write-exif-data-options @@ -1999,6 +1923,8 @@ default value at the prompt." (defun image-dired-get-exif-data (file tag-name) "From FILE, return EXIF tag TAG-NAME." + (image-dired--check-executable-exists + 'image-dired-cmd-read-exif-data-program) (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) command tag-value) (setq command (format-spec @@ -2467,7 +2393,7 @@ easy-to-use form." (setq image-dired-widget-list nil) ;; Setup buffer. (let ((files (dired-get-marked-files))) - (switch-to-buffer "*Image-Dired Edit Meta Data*") + (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") (kill-all-local-variables) (make-local-variable 'widget-example-repeat) (let ((inhibit-read-only t)) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 3334d6a823e..f52668536ca 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -372,8 +372,6 @@ call." (defvar image-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map special-mode-map) - (set-keymap-parent map image-map) (define-key map "\C-c\C-c" 'image-toggle-display) (define-key map "\C-c\C-x" 'image-toggle-hex-display) (define-key map (kbd "SPC") 'image-scroll-up) @@ -478,7 +476,7 @@ call." ["Goto Frame..." image-goto-frame :active image-multi-frame :help "Show a specific frame of this image"] )) - map) + (make-composed-keymap (list map image-map) special-mode-map)) "Mode keymap for `image-mode'.") (defvar image-minor-mode-map @@ -786,6 +784,9 @@ Otherwise, display the image by calling `image-mode'" (kill-buffer (current-buffer))) (defun image-after-revert-hook () + ;; Fixes bug#21598 + (when (not (image-get-display-property)) + (image-toggle-display-image)) (when (image-get-display-property) (image-toggle-display-text) ;; Update image display. diff --git a/lisp/image.el b/lisp/image.el index 2ae642a3e32..c34db68a44a 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -1,4 +1,4 @@ -;;; image.el --- image API +;;; image.el --- image API -*- lexical-binding:t -*- ;; Copyright (C) 1998-2016 Free Software Foundation, Inc. @@ -25,7 +25,6 @@ ;;; Code: - (defgroup image () "Image support." :group 'multimedia) @@ -103,7 +102,7 @@ AUTODETECT can be (see `image-type-available-p').") (defvar image-format-suffixes - '((image/x-icon "ico")) + '((image/x-rgb "rgb") (image/x-icon "ico")) "An alist associating image types with file name suffixes. This is used as a hint by the ImageMagick library when detecting the type of image data (that does not have an associated file name). @@ -124,7 +123,7 @@ value is used as a list of directories to search. Subdirectories are not automatically included in the search." :type '(repeat (choice directory variable)) - :initialize 'custom-initialize-delay) + :initialize #'custom-initialize-delay) (defcustom image-scaling-factor 'auto "When displaying images, apply this scaling factor before displaying. @@ -136,8 +135,7 @@ size), or the symbol `auto', which will compute a scaling factor based on the font pixel size." :type '(choice number (const :tag "Automatically compute" auto)) - :group 'image - :version "25.2") + :version "26.1") ;; Map put into text properties on images. (defvar image-map @@ -345,7 +343,7 @@ be determined." "Determine the type of image file FILE from its name. Value is a symbol specifying the image type, or nil if type cannot be determined." - (let (type first) + (let (type first (case-fold-search t)) (catch 'found (dolist (elem image-type-file-name-regexps first) (when (string-match-p (car elem) file) @@ -461,9 +459,8 @@ If VALUE is nil, PROPERTY is removed from IMAGE." (defun image-compute-scaling-factor (scaling) (cond - ((numberp image-scaling-factor) - image-scaling-factor) - ((eq image-scaling-factor 'auto) + ((numberp scaling) scaling) + ((eq scaling 'auto) (let ((width (/ (float (window-width nil t)) (window-width)))) ;; If we assume that a typical character is 10 pixels in width, ;; then we should scale all images according to how wide they @@ -472,7 +469,7 @@ If VALUE is nil, PROPERTY is removed from IMAGE." 1 (/ (float width) 10)))) (t - (error "Invalid scaling factor %s" image-scaling-factor)))) + (error "Invalid scaling factor %s" scaling)))) ;;;###autoload (defun put-image (image pos &optional string area) @@ -729,9 +726,9 @@ number, play until that number of seconds has elapsed." (if (setq timer (image-animate-timer image)) (cancel-timer timer)) (plist-put (cdr image) :animate-buffer (current-buffer)) - (run-with-timer 0.2 nil 'image-animate-timeout + (run-with-timer 0.2 nil #'image-animate-timeout image (or index 0) (car animation) - 0 limit)))) + 0 limit (+ (float-time) 0.2))))) (defun image-animate-timer (image) "Return the animation timer for image IMAGE." @@ -740,7 +737,7 @@ number, play until that number of seconds has elapsed." (while tail (setq timer (car tail) tail (cdr tail)) - (if (and (eq (timer--function timer) 'image-animate-timeout) + (if (and (eq (timer--function timer) #'image-animate-timeout) (eq (car-safe (timer--args timer)) image)) (setq tail nil) (setq timer nil))) @@ -780,7 +777,7 @@ multiplication factor for the current value." ;; hence we need to call image-multi-frame-p to return it. ;; But it also returns count, so why do we bother passing that as an ;; argument? -(defun image-animate-timeout (image n count time-elapsed limit) +(defun image-animate-timeout (image n count time-elapsed limit target-time) "Display animation frame N of IMAGE. N=0 refers to the initial animation frame. COUNT is the total number of frames in the animation. @@ -793,7 +790,12 @@ The minimum delay between successive frames is `image-minimum-frame-delay'. If the image has a non-nil :speed property, it acts as a multiplier for the animation speed. A negative value means to animate in reverse." - (when (buffer-live-p (plist-get (cdr image) :animate-buffer)) + (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer)) + ;; Delayed more than two seconds more than expected. + (or (<= (- (float-time) target-time) 2) + (progn + (message "Stopping animation; animation possibly too big") + nil))) (image-show-frame image n t) (let* ((speed (image-animate-get-speed image)) (time (float-time)) @@ -816,8 +818,9 @@ for the animation speed. A negative value means to animate in reverse." (if (numberp limit) (setq done (>= time-elapsed limit))) (unless done - (run-with-timer delay nil 'image-animate-timeout - image n count time-elapsed limit))))) + (run-with-timer delay nil #'image-animate-timeout + image n count time-elapsed limit + (+ (float-time) delay)))))) (defvar imagemagick-types-inhibit) @@ -903,12 +906,11 @@ has no effect." :type '(choice (const :tag "Support all ImageMagick types" nil) (const :tag "Disable all ImageMagick types" t) (repeat symbol)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.3" - :group 'image) + :version "24.3") (defcustom imagemagick-enabled-types '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW @@ -941,12 +943,11 @@ has no effect." (repeat :tag "List of types" (choice (symbol :tag "type") (regexp :tag "regexp")))) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.3" - :group 'image) + :version "24.3") (imagemagick-register-types) @@ -956,7 +957,7 @@ If N is 3, then the image size will be increased by 30%. The default is 20%." (interactive "P") (image--change-size (if n - (1+ (/ n 10)) + (1+ (/ n 10.0)) 1.2))) (defun image-decrease-size (n) @@ -965,18 +966,12 @@ If N is 3, then the image size will be decreased by 30%. The default is 20%." (interactive "P") (image--change-size (if n - (- 1 (/ n 10)) + (- 1 (/ n 10.0)) 0.8))) (defun image--get-image () - (let ((image (or (get-text-property (point) 'display) - ;; `put-image' uses overlays, so find an image in - ;; the overlays. - (seq-find (lambda (overlay) - (overlay-get overlay 'display)) - (overlays-at (point)))))) - (when (or (not (consp image)) - (not (eq (car image) 'image))) + (let ((image (get-text-property (point) 'display))) + (unless (eq (car-safe image) 'image) (error "No image under point")) image)) @@ -1018,7 +1013,11 @@ default is 20%." (interactive) (let ((image (image--get-imagemagick-and-warn))) (plist-put (cdr image) :rotation - (float (+ (or (plist-get (cdr image) :rotation) 0) 90))))) + (float (mod (+ (or (plist-get (cdr image) :rotation) 0) 90) + ;; We don't want to exceed 360 degrees + ;; rotation, because it's not seen as valid + ;; in exif data. + 360))))) (defun image-save () "Save the image under point." diff --git a/lisp/imenu.el b/lisp/imenu.el index 44bae2dd3b4..48257b892db 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -462,12 +462,15 @@ Don't move point." Simple elements in the alist look like (INDEX-NAME . POSITION). POSITION is the buffer position of the item; to go to the item is simply to move point to that position. -POSITION is passed to `imenu-default-goto-function', so it can be a non-number -if that variable has been changed (e.g. Semantic uses overlays for POSITIONs). -Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...). -To \"go to\" a special element means applying FUNCTION -to INDEX-NAME, POSITION, and the ARGUMENTS. +POSITION is passed to `imenu-default-goto-function', so it can be +a non-number if that variable has been changed (e.g. Semantic +uses overlays for POSITIONs). + +Special elements look like +\(INDEX-NAME POSITION FUNCTION ARGUMENTS...). +To \"go to\" a special element means applying FUNCTION to +INDEX-NAME, POSITION, and the ARGUMENTS. A nested sub-alist element looks like (INDEX-NAME . SUB-ALIST). The function `imenu--subalist-p' tests an element and returns t diff --git a/lisp/indent.el b/lisp/indent.el index 0bbb5209e8a..952a05af274 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -218,7 +218,7 @@ indentation by specifying a large negative ARG." (message (substitute-command-keys "Indent region with \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop].")) - (set-transient-map indent-rigidly-map t)) + (set-transient-map indent-rigidly-map t #'deactivate-mark)) (save-excursion (goto-char end) (setq end (point-marker)) @@ -559,26 +559,32 @@ column to indent to; if it is nil, use one of the three methods above." ;; by hand. (setq deactivate-mark t)) -(defun indent-relative-maybe () - "Indent a new line like previous nonblank line. -If the previous nonblank line has no indent points beyond the -column point starts at, this command does nothing. +(define-obsolete-function-alias 'indent-relative-maybe + 'indent-relative-first-indent-point "26.1") + +(defun indent-relative-first-indent-point () + "Indent the current line like the previous nonblank line. +Indent to the first indentation position in the previous nonblank +line if that position is greater than the current column. See also `indent-relative'." (interactive) (indent-relative t)) -(defun indent-relative (&optional unindented-ok) +(defun indent-relative (&optional first-only unindented-ok) "Space out to under next indent point in previous nonblank line. An indent point is a non-whitespace character following whitespace. The following line shows the indentation points in this line. ^ ^ ^ ^ ^ ^ ^ ^ ^ +If FIRST-ONLY is non-nil, then only the first indent point is +considered. + If the previous nonblank line has no indent points beyond the -column point starts at, `tab-to-tab-stop' is done instead, unless -this command is invoked with a numeric argument, in which case it -does nothing. +column point starts at, then `tab-to-tab-stop' is done, if both +FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done +in this case. -See also `indent-relative-maybe'." +See also `indent-relative-first-indent-point'." (interactive "P") (if (and abbrev-mode (eq (char-syntax (preceding-char)) ?w)) @@ -594,17 +600,18 @@ See also `indent-relative-maybe'." (if (> (current-column) start-column) (backward-char 1)) (or (looking-at "[ \t]") - unindented-ok + first-only (skip-chars-forward "^ \t" end)) (skip-chars-forward " \t" end) (or (= (point) end) (setq indent (current-column)))))) - (if indent - (let ((opoint (point-marker))) - (indent-to indent 0) - (if (> opoint (point)) - (goto-char opoint)) - (move-marker opoint nil)) - (tab-to-tab-stop)))) + (cond (indent + (let ((opoint (point-marker))) + (indent-to indent 0) + (if (> opoint (point)) + (goto-char opoint)) + (move-marker opoint nil))) + (unindented-ok nil) + (t (tab-to-tab-stop))))) (defcustom tab-stop-list nil "List of tab stop positions used by `tab-to-tab-stop'. diff --git a/lisp/info-look.el b/lisp/info-look.el index 70d2756dfc7..899f41e850d 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -912,7 +912,9 @@ Return nil if there is nothing appropriate in the buffer near point." ;; for things that should go to Function: etc, and those latter ;; are much more important. Perhaps this could change if some ;; sort of fallback match scheme existed. - ("(elisp)Index" nil "^ -+ .*: " "\\( \\|$\\)"))) + ("(elisp)Index" nil "^ -+ .*: " "\\( \\|$\\)") + ("(cl)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") + ("(cl)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) ;; docstrings talk about elisp, so have apropos-mode follow emacs-lisp-mode (info-lookup-maybe-add-help diff --git a/lisp/info-xref.el b/lisp/info-xref.el index cafc0e4b06a..81a2a5a0167 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -1,4 +1,4 @@ -;;; info-xref.el --- check external references in an Info document +;;; info-xref.el --- check external references in an Info document -*- lexical-binding: t -*- ;; Copyright (C) 2003-2016 Free Software Foundation, Inc. diff --git a/lisp/info.el b/lisp/info.el index 6426cfcf9ed..c8b8002e0cb 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -81,28 +81,24 @@ The Lisp code is executed when the node is selected.") (t :height 1.2 :inherit info-title-2)) "Face for info titles at level 1." :group 'info) -(define-obsolete-face-alias 'Info-title-1-face 'info-title-1 "22.1") (defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) (t :height 1.2 :inherit info-title-3)) "Face for info titles at level 2." :group 'info) -(define-obsolete-face-alias 'Info-title-2-face 'info-title-2 "22.1") (defface info-title-3 '((((type tty pc) (class color)) :weight bold) (t :height 1.2 :inherit info-title-4)) "Face for info titles at level 3." :group 'info) -(define-obsolete-face-alias 'Info-title-3-face 'info-title-3 "22.1") (defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) "Face for info titles at level 4." :group 'info) -(define-obsolete-face-alias 'Info-title-4-face 'info-title-4 "22.1") (defface info-menu-header '((((type tty pc)) @@ -119,7 +115,6 @@ The Lisp code is executed when the node is selected.") (t :underline t)) "Face for every third `*' in an Info menu." :group 'info) -(define-obsolete-face-alias 'info-menu-5 'info-menu-star "22.1") (defface info-xref '((t :inherit link)) @@ -189,15 +184,11 @@ A header-line does not scroll with the rest of the buffer." configure-info-directory))) (prefixes ;; Directory trees in which to look for info subdirectories - (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) + (prune-directory-list '("/usr/local/" "/usr/" "/opt/"))) (suffixes ;; Subdirectories in each directory tree that may contain info - ;; directories. Most of these are rather outdated. - ;; It ought to be fine to stop checking the "emacs" ones now, - ;; since this is Emacs and we have not installed info files - ;; into such directories for a looong time... - '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" - "emacs/" "lib/" "lib/emacs/")) + ;; directories. + '("share/" "")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) @@ -4236,9 +4227,12 @@ With a zero prefix arg, put the name inside a function call to `info'." "Syntax table used in `Info-mode'.") (defface Info-quoted - '((t :family "courier")) + '((t :inherit fixed-pitch-serif)) "Face used for quoted elements.") +;; We deliberately fontify only ‘..’ quoting, and not `..', because +;; the former can be done much more reliably, i.e. without risking +;; false positives. (defvar Info-mode-font-lock-keywords '(("‘\\([^’]*\\)’" (1 'Info-quoted)))) @@ -5010,17 +5004,29 @@ first line or header line, and for breadcrumb links.") ;; Fontify footnotes (goto-char (point-min)) (when (and not-fontified-p (re-search-forward "^[ \t]*-+ Footnotes -+$" nil t)) - (let ((limit (point))) + (let ((limit (point)) + (fncount 0)) + ;; How many footnotes do we have in this node? + (while (re-search-forward "^ [ \t]*([0-9]+) " nil t) + (setq fncount (1+ fncount))) (goto-char (point-min)) - (while (re-search-forward "\\(([0-9]+)\\)" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - `(font-lock-face info-xref - link t - mouse-face highlight - help-echo - ,(if (< (point) limit) - "mouse-2: go to footnote definition" - "mouse-2: go to footnote reference")))))) + (while (re-search-forward "\\((\\([0-9]+\\))\\)" nil t) + (let ((footnote-num (string-to-number (match-string 2)))) + ;; Don't fontify parenthesized numbers that cannot + ;; possibly be one of this node's footnotes. This still + ;; doesn't catch unrelated numbers that happen to be + ;; small enough, but in that case they should use + ;; "@footnotestyle separate" in the Texinfo sources. + (when (and (> footnote-num 0) + (<= footnote-num fncount)) + (add-text-properties (match-beginning 0) (match-end 0) + `(font-lock-face info-xref + link t + mouse-face highlight + help-echo + ,(if (< (point) limit) + "mouse-2: go to footnote definition" + "mouse-2: go to footnote reference")))))))) ;; Hide empty lines at the end of the node. (goto-char (point-max)) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 56f6c80fe81..5085e637e39 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -141,10 +141,10 @@ with L, LRE, or LRO Unicode bidi character type.") ;; Chinese characters (Unicode) (modify-category-entry '(#x2E80 . #x312F) ?|) (modify-category-entry '(#x3190 . #x33FF) ?|) -(modify-category-entry '(#x3400 . #x4DBF) ?C) -(modify-category-entry '(#x4E00 . #x9FAF) ?C) -(modify-category-entry '(#x3400 . #x9FAF) ?c) -(modify-category-entry '(#x3400 . #x9FAF) ?|) +(modify-category-entry '(#x3400 . #x4DB5) ?C) +(modify-category-entry '(#x4E00 . #x9FD5) ?C) +(modify-category-entry '(#x3400 . #x9FD5) ?c) +(modify-category-entry '(#x3400 . #x9FD5) ?|) (modify-category-entry '(#xF900 . #xFAFF) ?C) (modify-category-entry '(#xF900 . #xFAFF) ?c) (modify-category-entry '(#xF900 . #xFAFF) ?|) @@ -194,6 +194,7 @@ with L, LRE, or LRO Unicode bidi character type.") (dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212 japanese-jisx0213-1 japanese-jisx0213-2 + japanese-jisx0213.2004-1 cp932-2-byte)) (map-charset-chars #'modify-category-entry l ?j)) @@ -290,6 +291,7 @@ with L, LRE, or LRO Unicode bidi character type.") (map-charset-chars #'modify-category-entry (car charsets) ?b) (setq charsets (cdr charsets)))) (modify-category-entry '(#x600 . #x6ff) ?b) +(modify-category-entry '(#x8a0 . #x8ff) ?b) (modify-category-entry '(#xfb50 . #xfdff) ?b) (modify-category-entry '(#xfe70 . #xfefe) ?b) @@ -621,16 +623,19 @@ with L, LRE, or LRO Unicode bidi character type.") (set-case-syntax-pair ?Ʊ ?ʊ tbl) (set-case-syntax-pair ?Ʋ ?ʋ tbl) (set-case-syntax-pair ?Ʒ ?ʒ tbl) + ;; We use set-downcase-syntax below, since we want upcase of dž + ;; return DŽ, not Dž, and the same for the rest. (set-case-syntax-pair ?DŽ ?dž tbl) - (set-case-syntax-pair ?Dž ?dž tbl) + (set-downcase-syntax ?Dž ?dž tbl) (set-case-syntax-pair ?LJ ?lj tbl) - (set-case-syntax-pair ?Lj ?lj tbl) + (set-downcase-syntax ?Lj ?lj tbl) (set-case-syntax-pair ?NJ ?nj tbl) - (set-case-syntax-pair ?Nj ?nj tbl) + (set-downcase-syntax ?Nj ?nj tbl) ;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON + (set-case-syntax-pair ?DZ ?dz tbl) - (set-case-syntax-pair ?Dz ?dz tbl) + (set-downcase-syntax ?Dz ?dz tbl) (set-case-syntax-pair ?Ƕ ?ƕ tbl) (set-case-syntax-pair ?Ƿ ?ƿ tbl) (set-case-syntax-pair ?Ⱥ ?ⱥ tbl) @@ -700,6 +705,7 @@ with L, LRE, or LRO Unicode bidi character type.") (set-case-syntax-pair ?Ɜ ?ɜ tbl) (set-case-syntax-pair ?Ɡ ?ɡ tbl) (set-case-syntax-pair ?Ɬ ?ɬ tbl) + (set-case-syntax-pair ?Ɪ ?ɪ tbl) (set-case-syntax-pair ?Ʞ ?ʞ tbl) (set-case-syntax-pair ?Ʇ ?ʇ tbl) (set-case-syntax-pair ?Ʝ ?ʝ tbl) @@ -810,6 +816,9 @@ with L, LRE, or LRO Unicode bidi character type.") (set-case-syntax-pair c (+ c #x1C60) tbl) (setq c (1+ c))) + ;; Cyrillic Extended-C + (modify-category-entry '(#x1C80 . #x1C8F) ?y) + ;; general punctuation (setq c #x2000) (while (<= c #x200b) @@ -903,6 +912,12 @@ with L, LRE, or LRO Unicode bidi character type.") (set-case-syntax-pair c (+ c 28) tbl) (setq c (1+ c))) + ;; Osage + (setq c #x104B0) + (while (<= c #x104D3) + (set-case-syntax-pair c (+ c 40) tbl) + (setq c (1+ c))) + ;; Old Hungarian (setq c #x10c80) (while (<= c #x10cb2) @@ -915,6 +930,12 @@ with L, LRE, or LRO Unicode bidi character type.") (set-case-syntax-pair c (+ c #x20) tbl) (setq c (1+ c))) + ;; Adlam + (setq c #x1e900) + (while (<= c #x1e921) + (set-case-syntax-pair c (+ c #x22) tbl) + (setq c (1+ c))) + ;; Combining diacritics (modify-category-entry '(#x300 . #x362) ?^) ;; Combining marks @@ -1183,14 +1204,72 @@ with L, LRE, or LRO Unicode bidi character type.") ;; 2: East Asian Wide and Full-width characters. (let ((l '((#x1100 . #x115F) + (#x231A . #x231B) (#x2329 . #x232A) + (#x23E9 . #x23EC) + (#x23F0 . #x23F0) + (#x23F3 . #x23F3) + (#x25FD . #x25FE) + (#x2614 . #x2615) + (#x2648 . #x2653) + (#x267F . #x267F) + (#x2693 . #x2693) + (#x26A1 . #x26A1) + (#x26AA . #x26AB) + (#x26BD . #x26BE) + (#x26C4 . #x26C5) + (#x26CE . #x26CE) + (#x26D4 . #x26D4) + (#x26EA . #x26EA) + (#x26F2 . #x26F3) + (#x26F5 . #x26F5) + (#x26FA . #x26FA) + (#x26FD . #x26FD) + (#x2705 . #x2705) + (#x270A . #x270B) + (#x2728 . #x2728) + (#x274C . #x274C) + (#x274E . #x274E) + (#x2753 . #x2755) + (#x2757 . #x2757) + (#x2795 . #x2797) + (#x27B0 . #x27B0) + (#x27BF . #x27BF) + (#x2B1B . #x2B1C) + (#x2B50 . #x2B50) + (#x2B55 . #x2B55) (#x2E80 . #x303E) - (#x3040 . #xA4CF) + (#x3040 . #x4DBF) + (#x4E00 . #xA4CF) + (#xA960 . #xA97F) (#xAC00 . #xD7A3) (#xF900 . #xFAFF) + (#xFE10 . #xFE19) (#xFE30 . #xFE6F) (#xFF01 . #xFF60) (#xFFE0 . #xFFE6) + (#x16FE0 . #x16FE0) + (#x17000 . #x187EC) + (#x18800 . #x18AF2) + (#x1B000 . #x1B001) + (#x1F18E . #x1F18E) + (#x1F191 . #x1F19A) + (#x1F200 . #x1F2FF) + (#x1F300 . #x1F5FF) + (#x1F600 . #x1F64F) + (#x1F680 . #x1F6C5) + (#x1F6CC . #x1F6CC) + (#x1F6D0 . #x1F6D2) + (#x1F6EB . #x1F6EC) + (#x1F6F4 . #x1F6F6) + (#x1F910 . #x1F91E) + (#x1F920 . #x1F927) + (#x1F930 . #x1F930) + (#x1F933 . #x1F93E) + (#x1F940 . #x1F94B) + (#x1F950 . #x1F95E) + (#x1F980 . #x1F991) + (#x1F9C0 . #x1F9C0) (#x20000 . #x2FFFF) (#x30000 . #x3FFFF)))) (dolist (elt l) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 2ecfa7e53af..659f03a2a67 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -205,6 +205,7 @@ (deseret #x10400) (shavian #x10450) (osmanya #x10480) + (osage #x104B0) (elbasan #x10500) (caucasian-albanian #x10530) (linear-a #x10600) @@ -220,17 +221,22 @@ (khojki #x11200) (khudawadi #x112B0) (grantha #x11305) + (newa #x11400) (tirhuta #x11481) (siddham #x11580) (modi #x11600) (takri #x11680) (warang-citi #x118A1) (pau-cin-hau #x11AC0) + (bhaiksuki #x11C00) + (marchen #x11C72) (cuneiform #x12000) (cuneiform-numbers-and-punctuation #x12400) (mro #x16A40) (bassa-vah #x16AD0) (pahawh-hmong #x16B11) + (tangut #x17000) + (tangut-components #x18800) (duployan-shorthand #x1BC20) (byzantine-musical-symbol #x1D000) (musical-symbol #x1D100) @@ -238,31 +244,38 @@ (tai-xuan-jing-symbol #x1D300) (counting-rod-numeral #x1D360) (mende-kikakui #x1E810) + (adlam #x1E900) (mahjong-tile #x1F000) (domino-tile #x1F030))) (defvar otf-script-alist) -;; The below was synchronized with the latest Jan 3, 2013 version of +;; The below was synchronized with the latest Feb 25, 2016 version of ;; https://www.microsoft.com/typography/otspec/scripttags.htm. (setq otf-script-alist - '((arab . arabic) + '((adlm . adlam) + (ahom . ahom) + (hluw . anatolian) + (arab . arabic) (armi . aramaic) (armn . armenian) (avst . avestan) (bali . balinese) (bamu . bamum) + (bass . bassa-vah) (batk . batak) (bng2 . bengali) (beng . bengali) + (bhks . bhaiksuki) (bopo . bopomofo) - (brai . braille) (brah . brahmi) + (brai . braille) (bugi . buginese) (buhd . buhid) (byzm . byzantine-musical-symbol) (cans . canadian-aboriginal) (cari . carian) + (aghb . caucasian-albanian) (cakm . chakma) (cham . cham) (cher . cherokee) @@ -273,11 +286,14 @@ (dsrt . deseret) (deva . devanagari) (dev2 . devanagari) + (dupl . duployan-shorthand) (egyp . egyptian) + (elba . elbasan) (ethi . ethiopic) (geor . georgian) (glag . glagolitic) (goth . gothic) + (gran . grantha) (grek . greek) (gujr . gujarati) (gjr2 . gujarati) @@ -287,6 +303,7 @@ (hang . hangul) (jamo . hangul) (hano . hanunoo) + (hatr . hatran) (hebr . hebrew) (phli . inscriptional-pahlavi) (prti . inscriptional-parthian) @@ -298,43 +315,67 @@ (kali . kayah-li) (khar . kharoshthi) (khmr . khmer) + (khoj . khojki) + (sind . khudawadi) (lao\ . lao) (latn . latin) (lepc . lepcha) (limb . limbu) + (lina . linear_a) (linb . linear_b) (lisu . lisu) (lyci . lycian) (lydi . lydian) + (mahj . mahajani) + (marc . marchen) (mlym . malayalam) (mlm2 . malayalam) (mand . mandaic) + (mani . manichaean) (math . mathematical) (mtei . meetei-mayek) + (mend . mende-kikakui) (merc . meroitic) (mero . meroitic) + (plrd . miao) + (modi . modi) (mong . mongolian) + (mroo . mro) + (mult . multani) (musc . musical-symbol) (mym2 . burmese) (mymr . burmese) + (nbat . nabataean) + (newa . newa) (nko\ . nko) (ogam . ogham) (olck . ol-chiki) (ital . old_italic) (xpeo . old_persian) + (narb . old-north-arabian) + (perm . old-permic) (sarb . old-south-arabian) (orkh . old-turkic) (orya . oriya) (ory2 . oriya) + (osge . osage) (osma . osmanya) + (hmng . pahawh-hmong) + (palm . palmyrene) + (pauc . pau-cin-hau) (phag . phags-pa) + (phli . inscriptional-pahlavi) (phnx . phoenician) + (phlp . psalter-pahlavi) + (prti . inscriptional-parthian) (rjng . rejang) (runr . runic) (samr . samaritan) (saur . saurashtra) (shrd . sharada) (shaw . shavian) + (sidd . siddham) + (sgnw . sutton-sign-writing) (sinh . sinhala) (sora . sora-sompeng) (sund . sundanese) @@ -349,14 +390,17 @@ (takr . takri) (taml . tamil) (tml2 . tamil) + (tang . tangut) (telu . telugu) (tel2 . telugu) (thaa . thaana) (thai . thai) (tibt . tibetan) (tfng . tifinagh) + (tirh . tirhuta) (ugar . ugaritic) (vai\ . vai) + (wara . warang-citi) (yi\ \ . yi))) ;; Set standard fontname specification of characters in the default @@ -768,10 +812,11 @@ (#x1F700 . #x1F77F) ;; Alchemical Symbols (#x1F780 . #x1F7FF) ;; Geometric Shapes Extended (#x1F800 . #x1F8FF))) ;; Supplemental Arrows-C - (set-fontset-font "fontset-default" symbol-subgroup "Symbola" nil 'prepend)) + (set-fontset-font "fontset-default" symbol-subgroup + '("Symbola" . "iso10646-1") nil 'prepend)) ;; Box Drawing and Block Elements (set-fontset-font "fontset-default" '(#x2500 . #x259F) - "FreeMono" nil 'prepend) + '("FreeMono" . "iso10646-1") nil 'prepend) ;; Since standard-fontset-spec on X uses fixed-medium font, which ;; gets mapped to a iso8859-1 variant, we would like to prefer its @@ -1215,7 +1260,7 @@ to map charsets to scripts.") &optional _style-variant _noerror) "Create a fontset from fontset specification string FONTSET-SPEC. FONTSET-SPEC is a string of the format: - FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ... + FONTSET-NAME[,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1] ... Any number of SPACE, TAB, and NEWLINE can be put before and after commas. When a frame uses the fontset as the `font' parameter, the frame's diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el index e9609f493b7..f5824d486bf 100644 --- a/lisp/international/kinsoku.el +++ b/lisp/international/kinsoku.el @@ -104,10 +104,10 @@ The value 0 means there's no limitation.") ;; JISX0201 Katakana "(I"(B" ;; Japanese JISX0208 - "$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!n!w!x(B\ -$A!.!0#"#(!2!4!6!8!:!<!>!c!d!e#@!f!l(B" + "$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!n!w!x(B" ;; Chinese GB2312 - "$A(E(F(G(H(I(J(K(L(M(N(O(P(Q(R(S(T(U(V(W(X(Y(h(B\ + "$A!.!0#"#(!2!4!6!8!:!<!>!c!d!e#@!f!l(B\ +$A(E(F(G(H(I(J(K(L(M(N(O(P(Q(R(S(T(U(V(W(X(Y(h(B\ \$(0!>!@!B!D!F!H!J!L!N!P!R!T!V!X!Z!\!^!`!b(B" ;; Chinese BIG5 "$(0!d!f!h!j!k!q!p"i"j"k"n"x$u$v$w$x$y$z${(B\ diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index dc9699099e8..7672edc0443 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -72,7 +72,7 @@ (let ((map (make-sparse-keymap "Set Coding System"))) (bindings--define-key map [set-buffer-process-coding-system] '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system - :visible (fboundp 'start-process) + :visible (fboundp 'make-process) :enable (get-buffer-process (current-buffer)) :help "How to en/decode I/O from/to subprocess connected to this buffer")) (bindings--define-key map [set-next-selection-coding-system] @@ -2235,7 +2235,7 @@ See `set-language-info-alist' for use in programs." ("br" . "Latin-1") ; Breton ("bs" . "Latin-2") ; Bosnian ("byn" . "UTF-8") ; Bilin; Blin - ("ca" . "Latin-1") ; Catalan + ("ca" "Catalan" iso-8859-1) ; Catalan ; co Corsican ("cs" "Czech" iso-8859-2) ("cy" "Welsh" iso-8859-14) @@ -2704,10 +2704,12 @@ See also `locale-charset-language-names', `locale-language-names', ;; terminal-coding-system with the ANSI or console codepage. (when (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page)) - (let* ((code-page-coding - (intern (format "cp%d" (if noninteractive - (w32-get-console-codepage) - w32-ansi-code-page)))) + (let* ((ansi-code-page-coding + (intern (format "cp%d" w32-ansi-code-page))) + (code-page-coding + (if noninteractive + (intern (format "cp%d" (w32-get-console-codepage))) + ansi-code-page-coding)) (output-coding (if noninteractive (intern (format "cp%d" (w32-get-console-output-codepage))) @@ -2717,13 +2719,13 @@ See also `locale-charset-language-names', `locale-language-names', (unless frame (setq locale-coding-system code-page-coding)) (set-keyboard-coding-system code-page-coding frame) (set-terminal-coding-system output-coding frame) - (setq default-file-name-coding-system code-page-coding)))) + (setq default-file-name-coding-system ansi-code-page-coding)))) (when (eq system-type 'darwin) ;; On Darwin, file names are always encoded in utf-8, no matter ;; the locale. (setq default-file-name-coding-system 'utf-8) - ;; Mac OS X's Terminal.app by default uses utf-8 regardless of + ;; macOS's Terminal.app by default uses utf-8 regardless of ;; the locale. (when (and (null window-system) (equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal")) @@ -2733,8 +2735,8 @@ See also `locale-charset-language-names', `locale-language-names', ;; Default to A4 paper if we're not in a C, POSIX or US locale. ;; (See comments in Flocale_info.) (unless frame - (let ((locale locale) - (paper (locale-info 'paper))) + (let ((paper (locale-info 'paper)) + locale) (if paper ;; This will always be null at the time of writing. (cond @@ -2939,7 +2941,10 @@ on encoding." (#x14400 . #x14646) ;; (#x14647 . #x167FF) unused (#x16800 . #x16F9F) - ;; (#x16FA0 . #x1AFFF) unused + (#x16FE0 . #x16FE0) + ;; (#x17000 . #x187FF) Tangut Ideographs + ;; (#x18800 . #x18AFF) Tangut Components + ;; (#x18B00 . #x1AFFF) unused (#x1B000 . #x1B0FF) ;; (#x1B100 . #x1BBFF) unused (#x1BC00 . #x1BCAF) @@ -2975,6 +2980,27 @@ on encoding." (let ((char (assoc name ucs-names))) (when char (format " (%c)" (cdr char))))) +(defun char-from-name (string &optional ignore-case) + "Return a character as a number from its Unicode name STRING. +If optional IGNORE-CASE is non-nil, ignore case in STRING. +Return nil if STRING does not name a character." + (or (cdr (assoc-string string (ucs-names) ignore-case)) + (let ((minus (string-match-p "-[0-9A-F]+\\'" string))) + (when minus + ;; Parse names like "VARIATION SELECTOR-17" and "CJK + ;; COMPATIBILITY IDEOGRAPH-F900" that are not in ucs-names. + (ignore-errors + (let* ((case-fold-search ignore-case) + (vs (string-match-p "\\`VARIATION SELECTOR-" string)) + (minus-num (string-to-number (substring string minus) + (if vs 10 16))) + (vs-offset (if vs (if (< minus-num -16) #xE00EF #xFDFF) 0)) + (code (- vs-offset minus-num)) + (name (get-char-code-property code 'name))) + (when (eq t (compare-strings string nil nil name nil nil + ignore-case)) + code))))))) + (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its @@ -2988,9 +3014,11 @@ preceded by an asterisk `*' and use completion, it will show all the characters whose names include that substring, not necessarily at the beginning of the name. -This function also accepts a hexadecimal number of Unicode code -point or a number in hash notation, e.g. #o21430 for octal, -#x2318 for hex, or #10r8984 for decimal." +Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal +number like \"2A10\", or a number in hash notation (e.g., +\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for +octal). Treat otherwise-ambiguous strings like \"BED\" (U+1F6CF) +as names, not numbers." (let* ((enable-recursive-minibuffers t) (completion-ignore-case t) (input @@ -3003,13 +3031,13 @@ point or a number in hash notation, e.g. #o21430 for octal, (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char - (cond - ((string-match-p "\\`[0-9a-fA-F]+\\'" input) - (string-to-number input 16)) - ((string-match-p "\\`#" input) - (read input)) - (t - (cdr (assoc-string input (ucs-names) t)))))) + (cond + ((char-from-name input t)) + ((string-match-p "\\`[0-9a-fA-F]+\\'" input) + (ignore-errors (string-to-number input 16))) + ((string-match-p "\\`#\\([bBoOxX]\\|[0-9]+[rR]\\)[0-9a-zA-Z]+\\'" + input) + (ignore-errors (read input)))))) (unless (characterp char) (error "Invalid character")) char)) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index fbb0e0cb96f..f543083b8c5 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -204,13 +204,6 @@ Character sets for defining other charsets, or for backward compatibility "Obsolete.") (make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1") -(defun decode-codepage-char (codepage code) - "Decode a character that has code CODE in CODEPAGE. -Return a decoded character string. Each CODEPAGE corresponds to a -coding system cpCODEPAGE." - (declare (obsolete decode-char "23.1")) - (decode-char (intern (format "cp%d" codepage)) code)) - ;; A variable to hold charset input history. (defvar charset-history nil) @@ -1121,7 +1114,7 @@ system which uses fontsets)." (insert "\n\n") (if window-system - (let ((font (cdr (assq 'font (frame-parameters))))) + (let ((font (frame-parameter nil 'font))) (insert "The font and fontset of the selected frame are:\n" " font: " font "\n" " fontset: " (face-attribute 'default :fontset) "\n")) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 60a90ae15a4..5bc0e9c4c34 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1445,42 +1445,35 @@ graphical terminals." (let ((coding-type (coding-system-type coding-system)) (saved-meta-mode (terminal-parameter terminal 'keyboard-coding-saved-meta-mode))) - (if (not (eq coding-type 'raw-text)) - (let (accept-8-bit) - (if (not (or (coding-system-get coding-system :suitable-for-keyboard) - (coding-system-get coding-system :ascii-compatible-p))) - (error "Unsuitable coding system for keyboard: %s" coding-system)) - (cond ((memq coding-type '(charset utf-8 shift-jis big5 ccl)) - (setq accept-8-bit t)) - ((eq coding-type 'iso-2022) - (let ((flags (coding-system-get coding-system :flags))) - (or (memq '7-bit flags) - (setq accept-8-bit t)))) - (t - (error "Unsupported coding system for keyboard: %s" - coding-system))) - (if accept-8-bit - (progn - (or saved-meta-mode - (set-terminal-parameter terminal - 'keyboard-coding-saved-meta-mode - (cons (nth 2 (current-input-mode)) - nil))) - (set-input-meta-mode 8 terminal)) - (when saved-meta-mode - (set-input-meta-mode (car saved-meta-mode) terminal) - (set-terminal-parameter terminal - 'keyboard-coding-saved-meta-mode - nil))) - ;; Avoid end-of-line conversion. - (setq coding-system - (coding-system-change-eol-conversion coding-system 'unix))) - - (when saved-meta-mode - (set-input-meta-mode (car saved-meta-mode) terminal) - (set-terminal-parameter terminal - 'keyboard-coding-saved-meta-mode - nil)))) + (let (accept-8-bit) + (if (not (or (coding-system-get coding-system :suitable-for-keyboard) + (coding-system-get coding-system :ascii-compatible-p))) + (error "Unsuitable coding system for keyboard: %s" coding-system)) + (cond ((memq coding-type '(raw-text charset utf-8 shift-jis big5 ccl)) + (setq accept-8-bit t)) + ((eq coding-type 'iso-2022) + (let ((flags (coding-system-get coding-system :flags))) + (or (memq '7-bit flags) + (setq accept-8-bit t)))) + (t + (error "Unsupported coding system for keyboard: %s" + coding-system))) + (if accept-8-bit + (progn + (or saved-meta-mode + (set-terminal-parameter terminal + 'keyboard-coding-saved-meta-mode + (cons (nth 2 (current-input-mode)) + nil))) + (set-input-meta-mode 8 terminal)) + (when saved-meta-mode + (set-input-meta-mode (car saved-meta-mode) terminal) + (set-terminal-parameter terminal + 'keyboard-coding-saved-meta-mode + nil))) + ;; Avoid end-of-line conversion. + (setq coding-system + (coding-system-change-eol-conversion coding-system 'unix)))) (set-keyboard-coding-system-internal coding-system terminal) (setq keyboard-coding-system coding-system)) @@ -1871,7 +1864,7 @@ files.") (defun auto-coding-alist-lookup (filename) "Return the coding system specified by `auto-coding-alist' for FILENAME." (let ((alist auto-coding-alist) - (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))) + (case-fold-search (file-name-case-insensitive-p filename)) coding-system) (while (and alist (not coding-system)) (if (string-match (car (car alist)) filename) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index f5e390278ca..320d783d410 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1333,7 +1333,15 @@ If STR has `advice' text property, append the following special event: (defun quail-input-method (key) (if (or buffer-read-only - overriding-terminal-local-map + (and overriding-terminal-local-map + ;; If the overriding map is `universal-argument-map', that + ;; must mean the user has pressed 'C-u KEY'. If KEY has a + ;; binding in `universal-argument-map' just return + ;; (list KEY), otherwise act as if there was no + ;; overriding map. + (or (not (eq (cadr overriding-terminal-local-map) + universal-argument-map)) + (lookup-key overriding-terminal-local-map (vector key)))) overriding-local-map) (list key) (quail-setup-overlays (quail-conversion-keymap)) diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index 74978ce38a3..b2bc622858d 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -227,7 +227,7 @@ table)) (defvar ucs-normalize-decomposition-pair-to-primary-composite nil - "Hashtable of decomposed pair to primary composite. + "Hash table of decomposed pair to primary composite. Note that Hangul are excluded.") (setq ucs-normalize-decomposition-pair-to-primary-composite (ucs-normalize-make-hash-table-from-alist @@ -263,7 +263,7 @@ Note that Hangul are excluded.") (defvar ucs-normalize-combining-chars-regexp nil "Regular expression to match sequence of combining characters.") (setq ucs-normalize-combining-chars-regexp - (eval-when-compile (concat (regexp-opt (mapcar 'char-to-string combining-chars)) "+"))) + (eval-when-compile (concat (regexp-opt-charset combining-chars) "+"))) (declare-function decomposition-translation-alist "ucs-normalize" (decomposition-function)) @@ -396,20 +396,22 @@ If COMPOSITION-PREDICATE is not given, then do nothing." It includes Singletons, CompositionExclusions, and Non-Starter decomposition." (let (entries decomposition composition) - (mapc - (lambda (start-end) - (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) - (setq decomposition - (string-to-list - (with-temp-buffer - (insert i) - (translate-region 1 2 decomposition-translation) - (buffer-string)))) - (setq composition - (ucs-normalize-block-compose-chars decomposition composition-predicate)) - (when (not (equal composition (list i))) - (setq entries (cons i entries))))) - check-range) + (with-temp-buffer + (mapc + (lambda (start-end) + (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) + (setq decomposition + (string-to-list + (progn + (erase-buffer) + (insert i) + (translate-region 1 2 decomposition-translation) + (buffer-string)))) + (setq composition + (ucs-normalize-block-compose-chars decomposition composition-predicate)) + (when (not (equal composition (list i))) + (setq entries (cons i entries))))) + check-range)) ;;(remove-duplicates (append entries ucs-normalize-composition-exclusions @@ -431,7 +433,7 @@ decomposition." (setq hfs-nfc-quick-check-list (quick-check-list 'ucs-normalize-hfs-nfd-table t )) (defun quick-check-list-to-regexp (quick-check-list) - (regexp-opt (mapcar 'char-to-string (append quick-check-list combining-chars)))) + (regexp-opt-charset (append quick-check-list combining-chars))) (defun quick-check-decomposition-list-to-regexp (quick-check-list) (concat (quick-check-list-to-regexp quick-check-list) "\\|[가-힣]")) @@ -613,18 +615,13 @@ COMPOSITION-PREDICATE will be used to compose region." (- (point-max) (point-min))))) ;; Pre-write conversion for `utf-8-hfs'. -(defun ucs-normalize-hfs-nfd-pre-write-conversion (from to) - (let ((old-buf (current-buffer))) - (set-buffer (generate-new-buffer " *temp*")) - (if (stringp from) - (insert from) - (insert-buffer-substring old-buf from to)) - (ucs-normalize-HFS-NFD-region (point-min) (point-max)) - nil)) +;; _from and _to are legacy arguments (see `define-coding-system'). +(defun ucs-normalize-hfs-nfd-pre-write-conversion (_from _to) + (ucs-normalize-HFS-NFD-region (point-min) (point-max))) ;;; coding-system definition (define-coding-system 'utf-8-hfs - "UTF-8 based coding system for MacOS HFS file names. + "UTF-8 based coding system for macOS HFS file names. The singleton characters in HFS normalization exclusion will not be decomposed." :coding-type 'utf-8 diff --git a/lisp/isearch.el b/lisp/isearch.el index b8ada2c766a..9846f0b7206 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1,4 +1,4 @@ -;;; isearch.el --- incremental search minor mode +;;; isearch.el --- incremental search minor mode -*- lexical-binding: t -*- ;; Copyright (C) 1992-1997, 1999-2016 Free Software Foundation, Inc. @@ -222,7 +222,7 @@ It is nil if none yet.") Default value, nil, means edit the string instead." :type 'boolean) -(autoload 'character-fold-to-regexp "character-fold") +(autoload 'char-fold-to-regexp "char-fold") (defcustom search-default-mode nil "Default mode to use when starting isearch. @@ -236,7 +236,7 @@ isearch). If a function, use that function as an `isearch-regexp-function'. Example functions (and the keys to toggle them during isearch) are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp' -\(`\\[isearch-toggle-symbol]'), and `character-fold-to-regexp' \(`\\[isearch-toggle-character-fold]')." +\(`\\[isearch-toggle-symbol]'), and `char-fold-to-regexp' \(`\\[isearch-toggle-char-fold]')." ;; :type is set below by `isearch-define-mode-toggle'. :type '(choice (const :tag "Literal search" nil) (const :tag "Regexp search" t) @@ -354,11 +354,7 @@ A value of nil means highlight all matches." "Face for lazy highlighting of matches other than the current one." :group 'lazy-highlight :group 'basic-faces) -(define-obsolete-face-alias 'isearch-lazy-highlight-face 'lazy-highlight "22.1") -(define-obsolete-variable-alias 'isearch-lazy-highlight-face - 'lazy-highlight-face - "22.1") -(defvar lazy-highlight-face 'lazy-highlight) + ;; Define isearch help map. @@ -510,6 +506,7 @@ This is like `describe-bindings', but displays only Isearch keys." ;; People expect to be able to paste with the mouse. (define-key map [mouse-2] #'isearch-mouse-2) (define-key map [down-mouse-2] nil) + (define-key map [xterm-paste] #'isearch-xterm-paste) ;; Some bindings you may want to put in your isearch-mode-hook. ;; Suggest some alternates... @@ -561,7 +558,7 @@ The symbol property `isearch-message-prefix' put on this function specifies the prefix string displayed in the search message. This variable is set and changed during isearch. To change the -default behaviour used for searches, see `search-default-mode' +default behavior used for searches, see `search-default-mode' instead.") ;; We still support setting this to t for backwards compatibility. (define-obsolete-variable-alias 'isearch-word @@ -718,7 +715,7 @@ Type \\[isearch-toggle-invisible] to toggle search in invisible text. Type \\[isearch-toggle-regexp] to toggle regular-expression mode. Type \\[isearch-toggle-word] to toggle word mode. Type \\[isearch-toggle-symbol] to toggle symbol mode. -Type \\[isearch-toggle-character-fold] to toggle character folding. +Type \\[isearch-toggle-char-fold] to toggle character folding. Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching. In incremental searches, a space or spaces normally matches any whitespace @@ -837,10 +834,10 @@ See the command `isearch-forward-symbol' for more information." (buffer-substring-no-properties (car bounds) (cdr bounds)))) (t (setq isearch-error "No symbol at point") + (isearch-push-state) (isearch-update))))) -(defvar cursor-sensor-inhibit) ;; isearch-mode only sets up incremental search for the minor mode. ;; All the work is done by the isearch-mode commands. @@ -973,8 +970,6 @@ The last thing is to trigger a new round of lazy highlighting." (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit)))) (setq isearch--current-buffer (current-buffer)) (make-local-variable 'cursor-sensor-inhibit) - (unless (boundp 'cursor-sensor-inhibit) - (setq cursor-sensor-inhibit nil)) ;; Suspend things like cursor-intangible during Isearch so we can search ;; even within intangible text. (push 'isearch cursor-sensor-inhibit)) @@ -1013,7 +1008,8 @@ The last thing is to trigger a new round of lazy highlighting." ;; pos-visible-in-window-group-p returns non-nil, but ;; the X coordinate it returns is 1 pixel beyond ;; the last visible one. - (>= (car visible-p) (window-body-width nil t))) + (>= (car visible-p) + (* (window-max-chars-per-line) (frame-char-width)))) (set-window-hscroll (selected-window) current-scroll)))) (if isearch-other-end (if (< isearch-other-end (point)) ; isearch-forward? @@ -1050,9 +1046,10 @@ NOPUSH is t and EDIT is t." (remove-hook 'mouse-leave-buffer-hook 'isearch-done) (remove-hook 'kbd-macro-termination-hook 'isearch-done) (setq isearch-lazy-highlight-start nil) - (with-current-buffer isearch--current-buffer - (setq isearch--current-buffer nil) - (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit))) + (when (buffer-live-p isearch--current-buffer) + (with-current-buffer isearch--current-buffer + (setq isearch--current-buffer nil) + (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit)))) ;; Called by all commands that terminate isearch-mode. ;; If NOPUSH is non-nil, we don't push the string on the search ring. @@ -1148,18 +1145,18 @@ REGEXP if non-nil says use the regexp search ring." (case-fold-search isearch-case-fold-search) (pop-fun (if isearch-push-state-function (funcall isearch-push-state-function)))))) - (string :read-only t) - (message :read-only t) - (point :read-only t) - (success :read-only t) - (forward :read-only t) - (other-end :read-only t) - (word :read-only t) - (error :read-only t) - (wrapped :read-only t) - (barrier :read-only t) - (case-fold-search :read-only t) - (pop-fun :read-only t)) + (string nil :read-only t) + (message nil :read-only t) + (point nil :read-only t) + (success nil :read-only t) + (forward nil :read-only t) + (other-end nil :read-only t) + (word nil :read-only t) + (error nil :read-only t) + (wrapped nil :read-only t) + (barrier nil :read-only t) + (case-fold-search nil :read-only t) + (pop-fun nil :read-only t)) (defun isearch--set-state (cmd) (setq isearch-string (isearch--state-string cmd) @@ -1260,6 +1257,11 @@ You can update the global isearch variables by setting new values to (isearch-adjusted isearch-adjusted) (isearch-yank-flag isearch-yank-flag) (isearch-error isearch-error) + + (multi-isearch-file-list-new multi-isearch-file-list) + (multi-isearch-buffer-list-new multi-isearch-buffer-list) + (multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function) + (multi-isearch-current-buffer-new multi-isearch-current-buffer) ;;; Don't bind this. We want isearch-search, below, to set it. ;;; And the old value won't matter after that. ;;; (isearch-other-end isearch-other-end) @@ -1314,7 +1316,10 @@ You can update the global isearch variables by setting new values to isearch-message isearch-new-message isearch-forward isearch-new-forward isearch-regexp-function isearch-new-regexp-function - isearch-case-fold-search isearch-new-case-fold) + isearch-case-fold-search isearch-new-case-fold + multi-isearch-current-buffer multi-isearch-current-buffer-new + multi-isearch-file-list multi-isearch-file-list-new + multi-isearch-buffer-list multi-isearch-buffer-list-new) ;; Restore the minibuffer message before moving point. (funcall (or isearch-message-function #'isearch-message) nil t) @@ -1548,9 +1553,9 @@ The command then executes BODY and updates the isearch prompt." Turning on word search turns off regexp mode.") (isearch-define-mode-toggle symbol "_" isearch-symbol-regexp "\ Turning on symbol search turns off regexp mode.") -(isearch-define-mode-toggle character-fold "'" character-fold-to-regexp "\ +(isearch-define-mode-toggle char-fold "'" char-fold-to-regexp "\ Turning on character-folding turns off regexp mode.") -(put 'character-fold-to-regexp 'isearch-message-prefix "char-fold ") +(put 'char-fold-to-regexp 'isearch-message-prefix "char-fold ") (isearch-define-mode-toggle regexp "r" nil nil (setq isearch-regexp (not isearch-regexp)) @@ -1625,10 +1630,17 @@ Used in `word-search-forward', `word-search-backward', "Search backward from point for STRING, ignoring differences in punctuation. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. -The match found must not extend before that position. + The match found must not begin before that position. A value of nil + means search to the beginning of the accessible portion of the buffer. Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, move to limit of search and return nil. -Optional fourth argument is repeat count--search for successive occurrences. + If not nil and not t, position at limit of search and return nil. +Optional fourth argument COUNT, if a positive number, means to search + for COUNT successive occurrences. If COUNT is negative, search + forward, instead of backward, for -COUNT occurrences. A value of + nil means the same as 1. +With COUNT positive, the match found is the COUNTth to last one (or + last, if COUNT is 1 or nil) in the buffer located entirely before + the origin of the search; correspondingly with COUNT negative. Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard @@ -1642,10 +1654,17 @@ has no effect on it." "Search forward from point for STRING, ignoring differences in punctuation. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. -The match found must not extend after that position. + The match found must not end after that position. A value of nil + means search to the end of the accessible portion of the buffer. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. -Optional fourth argument is repeat count--search for successive occurrences. +Optional fourth argument COUNT, if a positive number, means to search + for COUNT successive occurrences. If COUNT is negative, search + backward, instead of forward, for -COUNT occurrences. A value of + nil means the same as 1. +With COUNT positive, the match found is the COUNTth one (or first, + if COUNT is 1 or nil) in the buffer located entirely after the + origin of the search; correspondingly with COUNT negative. Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard @@ -1663,10 +1682,17 @@ Unlike `word-search-backward', the end of STRING need not match a word boundary, unless STRING ends in whitespace. An optional second argument bounds the search; it is a buffer position. -The match found must not extend before that position. + The match found must not begin before that position. A value of nil + means search to the beginning of the accessible portion of the buffer. Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, move to limit of search and return nil. -Optional fourth argument is repeat count--search for successive occurrences. + If not nil and not t, position at limit of search and return nil. +Optional fourth argument COUNT, if a positive number, means to search + for COUNT successive occurrences. If COUNT is negative, search + forward, instead of backward, for -COUNT occurrences. A value of + nil means the same as 1. +With COUNT positive, the match found is the COUNTth to last one (or + last, if COUNT is 1 or nil) in the buffer located entirely before + the origin of the search; correspondingly with COUNT negative. Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard @@ -1684,10 +1710,17 @@ Unlike `word-search-forward', the end of STRING need not match a word boundary, unless STRING ends in whitespace. An optional second argument bounds the search; it is a buffer position. -The match found must not extend after that position. + The match found must not end after that position. A value of nil + means search to the end of the accessible portion of the buffer. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. -Optional fourth argument is repeat count--search for successive occurrences. +Optional fourth argument COUNT, if a positive number, means to search + for COUNT successive occurrences. If COUNT is negative, search + backward, instead of forward, for -COUNT occurrences. A value of + nil means the same as 1. +With COUNT positive, the match found is the COUNTth one (or first, + if COUNT is 1 or nil) in the buffer located entirely after the + origin of the search; correspondingly with COUNT negative. Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard @@ -2003,6 +2036,13 @@ is bound to outside of Isearch." (when (functionp binding) (call-interactively binding))))) +(declare-function xterm--pasted-text "term/xterm" ()) + +(defun isearch-xterm-paste () + "Pull terminal paste into search string." + (interactive) + (isearch-yank-string (xterm--pasted-text))) + (defun isearch-yank-internal (jumpform) "Pull the text from point to the point reached by JUMPFORM. JUMPFORM is a lambda expression that takes no arguments and returns @@ -2574,16 +2614,30 @@ the word mode." (when (eq regexp-function t) (setq regexp-function #'word-search-regexp)) (let ((description - ;; Don't use a description on the default search mode. - (cond ((equal regexp-function search-default-mode) "") - (regexp-function - (and (symbolp regexp-function) - (or (get regexp-function 'isearch-message-prefix) - ""))) - (isearch-regexp "regexp ") - ;; We're in literal mode. If the default mode is not - ;; literal, then describe it. - ((functionp search-default-mode) "literal ")))) + (cond + ;; 1. Do not use a description on the default search mode, + ;; but only if the default search mode is non-nil. + ((or (and search-default-mode + (equal search-default-mode regexp-function)) + ;; Special case where `search-default-mode' is t + ;; (defaults to regexp searches). + (and (eq search-default-mode t) + (eq search-default-mode isearch-regexp))) "") + ;; 2. Use the `isearch-message-prefix' set for + ;; `regexp-function' if available. + (regexp-function + (and (symbolp regexp-function) + (or (get regexp-function 'isearch-message-prefix) + ""))) + ;; 3. Else if `isearch-regexp' is non-nil, set description + ;; to "regexp ". + (isearch-regexp "regexp ") + ;; 4. Else if we're in literal mode (and if the default + ;; mode is also not literal), describe it. + ((functionp search-default-mode) "literal ") + ;; 5. And finally, if none of the above is true, set the + ;; description to an empty string. + (t "")))) (if space-before ;; Move space from the end to the beginning. (replace-regexp-in-string "\\(.*\\) \\'" " \\1" description) @@ -2651,8 +2705,9 @@ the word mode." "Non-default value overrides the behavior of `isearch-search-fun-default'. This variable's value should be a function, which will be called with no arguments, and should return a function that takes three -arguments: STRING, BOUND, and NOERROR. See `re-search-forward' -for the meaning of BOUND and NOERROR arguments. +arguments: STRING, BOUND, and NOERROR. STRING is the string to +be searched for. See `re-search-forward' for the meaning of +BOUND and NOERROR arguments. This returned function will be used by `isearch-search-string' to search for the first occurrence of STRING.") @@ -3230,7 +3285,7 @@ Attempt to do the search exactly the way the pending Isearch would." ;; 1000 is higher than ediff's 100+, ;; but lower than isearch main overlay's 1001 (overlay-put ov 'priority 1000) - (overlay-put ov 'face lazy-highlight-face))) + (overlay-put ov 'face 'lazy-highlight))) ;(overlay-put ov 'window (selected-window)))) ;; Remember the current position of point for ;; the next call of `isearch-lazy-highlight-update' @@ -3273,4 +3328,6 @@ CASE-FOLD non-nil means the search was case-insensitive." (isearch-search) (isearch-update)) +(provide 'isearch) + ;;; isearch.el ends here diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 810c2205160..0d9abbc1feb 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -195,9 +195,11 @@ the variable `jit-lock-stealth-nice'. If you need to debug code run from jit-lock, see `jit-lock-debug-mode'." (setq jit-lock-mode arg) (cond - ((buffer-base-buffer) - ;; We're in an indirect buffer. This doesn't work because jit-lock relies - ;; on the `fontified' text-property which is shared with the base buffer. + ((and (buffer-base-buffer) + jit-lock-mode) + ;; We're in an indirect buffer, and we're turning the mode on. + ;; This doesn't work because jit-lock relies on the `fontified' + ;; text-property which is shared with the base buffer. (setq jit-lock-mode nil) (message "Not enabling jit-lock: it does not work in indirect buffer")) @@ -392,58 +394,62 @@ Defaults to the whole buffer. END can be out of bounds." (setq next (or (text-property-any start end 'fontified t) end)) - ;; Fontify the chunk, and mark it as fontified. - ;; We mark it first, to make sure that we don't indefinitely - ;; re-execute this fontification if an error occurs. - (put-text-property start next 'fontified t) - (pcase-let - ;; `tight' is the part we've fully refontified, and `loose' - ;; is the part we've partly refontified (some of the - ;; functions have refontified it but maybe not all). - ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end) - (condition-case err - (jit-lock--run-functions start next) - ;; If the user quits (which shouldn't happen in normal - ;; on-the-fly jit-locking), make sure the fontification - ;; will be performed before displaying the block again. - (quit (put-text-property start next 'fontified nil) - (signal (car err) (cdr err)))))) - - ;; In case we fontified more than requested, take advantage of the - ;; good news. - (when (or (< tight-beg start) (> tight-end next)) - (put-text-property tight-beg tight-end 'fontified t)) - - ;; Make sure the contextual refontification doesn't re-refontify - ;; what's already been refontified. - (when (and jit-lock-context-unfontify-pos - (< jit-lock-context-unfontify-pos tight-end) - (>= jit-lock-context-unfontify-pos tight-beg) - ;; Don't move boundary forward if we have to - ;; refontify previous text. Otherwise, we risk moving - ;; it past the end of the multiline property and thus - ;; forget about this multiline region altogether. - (not (get-text-property tight-beg - 'jit-lock-defer-multiline))) - (setq jit-lock-context-unfontify-pos tight-end)) - - ;; The redisplay engine has already rendered the buffer up-to - ;; `orig-start' and won't notice if the above jit-lock-functions - ;; changed the appearance of any part of the buffer prior - ;; to that. So if `loose-beg' is before `orig-start', we need to - ;; cause a new redisplay cycle after this one so that the changes - ;; are properly reflected on screen. - ;; To make such repeated redisplay happen less often, we can - ;; eagerly extend the refontified region with - ;; jit-lock-after-change-extend-region-functions. - (when (< loose-beg orig-start) - (run-with-timer 0 nil #'jit-lock-force-redisplay - (copy-marker loose-beg) - (copy-marker orig-start))) - - ;; Find the start of the next chunk, if any. - (setq start - (text-property-any tight-end end 'fontified nil))))))))) + ;; Avoid unnecessary work if the chunk is empty (bug#23278). + (when (> next start) + ;; Fontify the chunk, and mark it as fontified. + ;; We mark it first, to make sure that we don't indefinitely + ;; re-execute this fontification if an error occurs. + (put-text-property start next 'fontified t) + (pcase-let + ;; `tight' is the part we've fully refontified, and `loose' + ;; is the part we've partly refontified (some of the + ;; functions have refontified it but maybe not all). + ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end) + (condition-case err + (jit-lock--run-functions start next) + ;; If the user quits (which shouldn't happen in normal + ;; on-the-fly jit-locking), make sure the fontification + ;; will be performed before displaying the block again. + (quit (put-text-property start next 'fontified nil) + (signal (car err) (cdr err)))))) + + ;; In case we fontified more than requested, take advantage of the + ;; good news. + (when (or (< tight-beg start) (> tight-end next)) + (put-text-property tight-beg tight-end 'fontified t)) + + ;; Make sure the contextual refontification doesn't re-refontify + ;; what's already been refontified. + (when (and jit-lock-context-unfontify-pos + (< jit-lock-context-unfontify-pos tight-end) + (>= jit-lock-context-unfontify-pos tight-beg) + ;; Don't move boundary forward if we have to + ;; refontify previous text. Otherwise, we risk moving + ;; it past the end of the multiline property and thus + ;; forget about this multiline region altogether. + (not (get-text-property tight-beg + 'jit-lock-defer-multiline))) + (setq jit-lock-context-unfontify-pos tight-end)) + + ;; The redisplay engine has already rendered the buffer up-to + ;; `orig-start' and won't notice if the above jit-lock-functions + ;; changed the appearance of any part of the buffer prior + ;; to that. So if `loose-beg' is before `orig-start', we need to + ;; cause a new redisplay cycle after this one so that the changes + ;; are properly reflected on screen. + ;; To make such repeated redisplay happen less often, we can + ;; eagerly extend the refontified region with + ;; jit-lock-after-change-extend-region-functions. + (when (< loose-beg orig-start) + (run-with-timer 0 nil #'jit-lock-force-redisplay + (copy-marker loose-beg) + (copy-marker orig-start))) + + ;; Skip to the end of the fully refontified part. + (setq start tight-end))) + ;; Find the start of the next chunk, if any. + (setq start + (text-property-any start end 'fontified nil)))))))) (defun jit-lock-force-redisplay (start end) "Force the display engine to re-render START's buffer from START to END. diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 39302f028e9..b023bcd601a 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -244,7 +244,15 @@ options through Custom does this automatically." ["\\.dz\\'" nil nil nil "uncompressing" "gzip" ("-c" "-q" "-d") - nil t "\037\213"])) + nil t "\037\213"] + ["\\.zst\\'" + "zstd compressing" "zstd" ("-c" "-q") + "zstd uncompressing" "zstd" ("-c" "-q" "-d") + t t "\050\265\057\375"] + ["\\.tzst\\'" + "zstd compressing" "zstd" ("-c" "-q") + "zstd uncompressing" "zstd" ("-c" "-q" "-d") + t nil "\050\265\057\375"])) "List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of @@ -308,7 +316,8 @@ variables. Setting this through Custom does that automatically." (defcustom jka-compr-mode-alist-additions (purecopy '(("\\.tgz\\'" . tar-mode) ("\\.tbz2?\\'" . tar-mode) - ("\\.txz\\'" . tar-mode))) + ("\\.txz\\'" . tar-mode) + ("\\.tzst\\'" . tar-mode))) "List of pairs added to `auto-mode-alist' when installing jka-compr. Uninstalling jka-compr removes all pairs from `auto-mode-alist' that installing added. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index a5556743eb3..d8137b10528 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -444,17 +444,18 @@ There should be no more than seven characters after the final `/'." ;; If the file we wanted to uncompress does not exist, ;; handle that according to VISIT as `insert-file-contents' ;; would, maybe signaling the same error it normally would. - (if (and (eq (car error-code) 'file-error) + (if (and (eq (car error-code) 'file-missing) (eq (nth 3 error-code) local-file)) (if visit (setq notfound error-code) - (signal 'file-error + (signal 'file-missing (cons "Opening input file" (nthcdr 2 error-code)))) ;; If the uncompression program can't be found, ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. - (if (and (eq (car error-code) 'file-error) + (if (and (memq 'file-error (get (car error-code) + 'error-conditions)) (equal (cadr error-code) "Searching for program")) (error "Uncompression program `%s' not found" (nth 3 error-code))) @@ -487,7 +488,7 @@ There should be no more than seven characters after the final `/'." (and visit notfound - (signal 'file-error + (signal 'file-missing (cons "Opening input file" (nth 2 notfound)))) ;; This is done in insert-file-contents after we return. diff --git a/lisp/json.el b/lisp/json.el index bd1ee531656..fdac8d9a826 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -1,4 +1,4 @@ -;;; json.el --- JavaScript Object Notation parser / generator +;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*- ;; Copyright (C) 2006-2016 Free Software Foundation, Inc. @@ -296,14 +296,14 @@ KEYWORD is the keyword expected." (unless (char-equal char (json-peek)) (signal 'json-unknown-keyword (list (save-excursion - (backward-word 1) + (backward-word-strictly 1) (thing-at-point 'word))))) (json-advance)) keyword) (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") (signal 'json-unknown-keyword (list (save-excursion - (backward-word 1) + (backward-word-strictly 1) (thing-at-point 'word))))) (cond ((string-equal keyword "true") t) ((string-equal keyword "false") json-false) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index a3683738fc6..2e743b4c383 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -478,7 +478,7 @@ without repeating the prefix." "Display the current head of the keyboard macro ring." (interactive) (unless (kmacro-ring-empty-p) - (kmacro-display (car (car kmacro-ring)) "2nd macro"))) + (kmacro-display (car (car kmacro-ring)) nil "2nd macro"))) (defun kmacro-cycle-ring-next (&optional _arg) diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el index e5316409326..6505fb8c3d8 100644 --- a/lisp/language/china-util.el +++ b/lisp/language/china-util.el @@ -88,43 +88,34 @@ Return the length of resulting text." (let (pos ch) (narrow-to-region beg end) - ;; We, at first, convert HZ/ZW to `euc-china', + ;; We, at first, convert HZ/ZW to `iso-2022-7bit', ;; then decode it. - ;; "~\n" -> "\n", "~~" -> "~" + ;; "~\n" -> "", "~~" -> "~" (goto-char (point-min)) (while (search-forward "~" nil t) (setq ch (following-char)) - (if (or (= ch ?\n) (= ch ?~)) (delete-char -1))) + (cond ((= ch ?{) + (delete-region (1- (point)) (1+ (point))) + (setq pos (point)) + (insert iso2022-gb-designation) + (if (looking-at "\\([!-}][!-~]\\)*") + (goto-char (match-end 0))) + (if (looking-at hz-ascii-designation) + (delete-region (match-beginning 0) (match-end 0))) + (insert iso2022-ascii-designation) + (decode-coding-region pos (point) 'iso-2022-7bit)) + + ((= ch ?~) + (delete-char 1)) + + ((and (= ch ?\n) + decode-hz-line-continuation) + (delete-region (1- (point)) (1+ (point)))) + + (t + (forward-char 1))))) - ;; "^zW...\n" -> Chinese GB2312 - ;; "~{...~}" -> Chinese GB2312 - (goto-char (point-min)) - (setq beg nil) - (while (re-search-forward hz/zw-start-gb nil t) - (setq pos (match-beginning 0) - ch (char-after pos)) - ;; Record the first position to start conversion. - (or beg (setq beg pos)) - (end-of-line) - (setq end (point)) - (if (>= ch 128) ; 8bit GB2312 - nil - (goto-char pos) - (delete-char 2) - (setq end (- end 2)) - (if (= ch ?z) ; ZW -> euc-china - (progn - (translate-region (point) end hz-set-msb-table) - (goto-char end)) - (if (search-forward hz-ascii-designation - (if decode-hz-line-continuation nil end) - t) - (delete-char -2)) - (setq end (point)) - (translate-region pos (point) hz-set-msb-table)))) - (if beg - (decode-coding-region beg end 'euc-china))) (- (point-max) (point-min))))) ;;;###autoload @@ -133,33 +124,57 @@ Return the length of resulting text." (interactive) (decode-hz-region (point-min) (point-max))) +(defvar hz-category-table nil) + ;;;###autoload (defun encode-hz-region (beg end) "Encode the text in the current region to HZ. Return the length of resulting text." (interactive "r") + (unless hz-category-table + (setq hz-category-table (make-category-table)) + (with-category-table hz-category-table + (define-category ?c "hz encodable") + (map-charset-chars #'modify-category-entry 'ascii ?c) + (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?c))) (save-excursion (save-restriction (narrow-to-region beg end) + (with-category-table hz-category-table + ;; ~ -> ~~ + (goto-char (point-min)) + (while (search-forward "~" nil t) (insert ?~)) + + ;; ESC -> ESC ESC + (goto-char (point-min)) + (while (search-forward "\e" nil t) (insert ?\e)) - ;; "~" -> "~~" - (goto-char (point-min)) - (while (search-forward "~" nil t) (insert ?~)) - - ;; Chinese GB2312 -> "~{...~}" - (goto-char (point-min)) - (if (re-search-forward "\\cc" nil t) - (let (pos) - (goto-char (setq pos (match-beginning 0))) - (encode-coding-region pos (point-max) 'iso-2022-7bit) - (goto-char pos) - (while (search-forward iso2022-gb-designation nil t) - (delete-char -3) - (insert hz-gb-designation)) - (goto-char pos) - (while (search-forward iso2022-ascii-designation nil t) - (delete-char -3) - (insert hz-ascii-designation)))) + ;; Non-ASCII-GB2312 -> \uXXXX + (goto-char (point-min)) + (while (re-search-forward "\\Cc" nil t) + (let ((ch (preceding-char))) + (delete-char -1) + (insert (format (if (< ch #x10000) "\\u%04X" "\\U%08X") ch)))) + + ;; Prefer chinese-gb2312 for Chinese characters. + (put-text-property (point-min) (point-max) 'charset 'chinese-gb2312) + (encode-coding-region (point-min) (point-max) 'iso-2022-7bit) + + ;; ESC $ B ... ESC ( B -> ~{ ... ~} + ;; ESC ESC -> ESC + (goto-char (point-min)) + (while (search-forward "\e" nil t) + (if (= (following-char) ?\e) + ;; ESC ESC -> ESC + (delete-char 1) + (forward-char -1) + (if (looking-at iso2022-gb-designation) + (progn + (delete-region (match-beginning 0) (match-end 0)) + (insert hz-gb-designation) + (search-forward iso2022-ascii-designation nil 'move) + (delete-region (match-beginning 0) (match-end 0)) + (insert hz-ascii-designation)))))) (- (point-max) (point-min))))) ;;;###autoload diff --git a/lisp/language/european.el b/lisp/language/european.el index a939719ec42..11c5e03c97f 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el @@ -614,6 +614,28 @@ method and applying Turkish case rules for the characters i, I, ı, İ."))) (documentation . "Support for Brazilian Portuguese.")) '("European")) +(set-language-info-alist + "Catalan" '((charset iso-8859-1) + (coding-system iso-8859-1 iso-8859-15) + (coding-priority iso-8859-1) + (input-method . "catalan-prefix") + (nonascii-translation . iso-8859-1) + (unibyte-display . iso-8859-1) + (setup-function + . (lambda () + (modify-syntax-entry ?· "w" (standard-syntax-table)))) + (exit-function + . (lambda () + (modify-syntax-entry ?· "_" (standard-syntax-table)))) + (sample-text . "\ +Catalan (Català) Avui demà i ahir s'esfullarà una rosa.") + (documentation . "\ +This language environment uses the ISO-8859-1 character set, +sets the default input method to \"catalan-prefix\", and sets +the syntax of the middle dot character `·' to word.")) + '("European")) + + (define-coding-system 'mac-roman "Mac Roman Encoding (MIME:MACINTOSH)." diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index deea48933c8..f7424ecd84f 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -39,7 +39,7 @@ (eval-and-compile (defun indian-regexp-of-hashtbl-keys (hashtbl) - "Returns the regular expression of hashtable keys." + "Return the regular expression of hash table keys." (let (keys) (maphash (lambda (key val) (push key keys)) hashtbl) (regexp-opt keys))) diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index f0d817b8b5e..939b70ab911 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -57,6 +57,7 @@ (?$B$C(B ?$B%C(B ?(I/(B) (?$B$c(B ?$B%c(B ?(I,(B) (?$B$e(B ?$B%e(B ?(I-(B) (?$B$g(B ?$B%g(B ?(I.(B) (?$B$n(B ?$B%n(B "(I\(B") + (?$B!5(B ?$B!3(B) (?$B!6(B ?$B!4(B) ("$B$&!+(B" ?$B%t(B "(I3^(B") (nil ?$B%u(B "(I6(B") (nil ?$B%v(B "(I9(B")) "Japanese JISX0208 Kana character table. Each element is of the form (HIRAGANA KATAKANA HANKAKU-KATAKANA), where @@ -146,7 +147,7 @@ and HANKAKU belongs to `japanese-jisx0201-kana'.") (?$B#p(B . ?p) (?$B#q(B . ?q) (?$B#r(B . ?r) (?$B#s(B . ?s) (?$B#t(B . ?t) (?$B#u(B . ?u) (?$B#v(B . ?v) (?$B#w(B . ?w) (?$B#x(B . ?x) (?$B#y(B . ?y) (?$B#z(B . ?z)) "Japanese JISX0208 alpha numeric character table. -Each element is of the form (ALPHA-NUMERIC ASCII), where ALPHA-NUMERIC +Each element is of the form (ALPHA-NUMERIC . ASCII), where ALPHA-NUMERIC belongs to `japanese-jisx0208', ASCII belongs to `ascii'.") ;; Put properties 'jisx0208 and 'ascii to each Japanese alpha numeric diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el index 6103860a84a..a42904f5de4 100644 --- a/lisp/language/lao-util.el +++ b/lisp/language/lao-util.el @@ -38,100 +38,100 @@ (define-category ?v "Lao upper/lower vowel" lao-category-table) (define-category ?t "Lao tone" lao-category-table) -(let ((l '((?ກ consonant "LETTER KOR KAI'" "CHICKEN") - (?ຂ consonant "LETTER KHOR KHAI'" "EGG") - (? invalid nil) - (?ຄ consonant "LETTER QHOR QHWARGN" "BUFFALO") - (? invalid nil) - (? invalid nil) - (?ງ consonant "LETTER NGOR NGUU" "SNAKE") - (?ຈ consonant "LETTER JOR JUA" "BUDDHIST NOVICE") - (?ຉ invalid nil) - (?ຊ consonant "LETTER XOR X\"ARNG" "ELEPHANT") - (? invalid nil) - (?ຌ invalid nil) - (?ຍ consonant "LETTER YOR YUNG" "MOSQUITO") - (?ຎ invalid nil) - (?ຎ invalid nil) - (?ຎ invalid nil) - (?ຎ invalid nil) - (?ຎ invalid nil) - (?ຎ invalid nil) - (?ດ consonant "LETTER DOR DANG" "NOSE") - (?ຕ consonant "LETTER TOR TAR" "EYE") - (?ຖ consonant "LETTER THOR THUNG" "TO ASK,QUESTION") - (?ທ consonant "LETTER DHOR DHARM" "FLAG") - (?ຘ invalid nil) - (?ນ consonant "LETTER NOR NOK" "BIRD") - (?ບ consonant "LETTER BOR BED" "FISHHOOK") - (?ປ consonant "LETTER POR PAR" "FISH") - (?ຜ consonant "LETTER HPOR HPER\"" "BEE") - (?ຝ consonant "LETTER FHOR FHAR" "WALL") - (?ພ consonant "LETTER PHOR PHUU" "MOUNTAIN") - (?ຟ consonant "LETTER FOR FAI" "FIRE") - (?ຠ invalid nil) - (?ມ consonant "LETTER MOR MAR\"" "HORSE") - (?ຢ consonant "LETTER GNOR GNAR" "MEDICINE") - (?ຣ consonant "LETTER ROR ROD" "CAR") - (? invalid nil) - (?ລ consonant "LETTER LOR LIING" "MONKEY") - (? invalid nil) - (?ວ consonant "LETTER WOR WII" "HAND FAN") - (?ຨ invalid nil) - (?ຩ invalid nil) - (?ສ consonant "LETTER SOR SEA" "TIGER") - (?ຫ consonant "LETTER HHOR HHAI" "JAR") - (?ຬ invalid nil) - (?ອ consonant "LETTER OR OOW" "TAKE") - (?ຮ consonant "LETTER HOR HEA" "BOAT") - (?ຯ special "ELLIPSIS") - (?ະ vowel-base "VOWEL SIGN SARA A") - (?ັ vowel-upper "VOWEL SIGN MAI KAN") - (?າ vowel-base "VOWEL SIGN SARA AR") - (?ຳ vowel-base "VOWEL SIGN SARA AM") - (?ິ vowel-upper "VOWEL SIGN SARA I") - (?ີ vowel-upper "VOWEL SIGN SARA II") - (?ຶ vowel-upper "VOWEL SIGN SARA EU") - (?ື vowel-upper "VOWEL SIGN SARA UR") - (?ຸ vowel-lower "VOWEL SIGN SARA U") - (?ູ vowel-lower "VOWEL SIGN SARA UU") - (?຺ invalid nil) - (?ົ vowel-upper "VOWEL SIGN MAI KONG") - (?ຼ semivowel-lower "SEMIVOWEL SIGN LO") - (?ຽ vowel-base "SEMIVOWEL SIGN SARA IA") - (? invalid nil) - (? invalid nil) - (?ເ vowel-base "VOWEL SIGN SARA EE") - (?ແ vowel-base "VOWEL SIGN SARA AA") - (?ໂ vowel-base "VOWEL SIGN SARA OO") - (?ໃ vowel-base "VOWEL SIGN SARA EI MAI MUAN\"") - (?ໄ vowel-base "VOWEL SIGN SARA AI MAI MAY") - (? invalid nil) - (?ໆ special "KO LA (REPETITION)") - (? invalid nil) - (?່ tone "TONE MAI EK") - (?້ tone "TONE MAI THO") - (?໊ tone "TONE MAI TI") - (?໋ tone "TONE MAI JADTAWAR") - (?໌ tone "CANCELLATION MARK") - (?ໍ vowel-upper "VOWEL SIGN SARA OR") - (?໎ invalid nil) - (? invalid nil) - (?໐ special "DIGIT ZERO") - (?໑ special "DIGIT ONE") - (?໒ special "DIGIT TWO") - (?໓ special "DIGIT THREE") - (?໔ special "DIGIT FOUR") - (?໕ special "DIGIT FIVE") - (?໖ special "DIGIT SIX") - (?໗ special "DIGIT SEVEN") - (?໘ special "DIGIT EIGHT") - (?໙ special "DIGIT NINE") - (? invalid nil) - (? invalid nil) - (?ໜ consonant "LETTER NHOR NHUU" "MOUSE") - (?ໝ consonant "LETTER MHOR MHAR" "DOG") - (?ໞ invalid nil))) +(let ((l '((?ກ consonant "CHICKEN") + (?ຂ consonant "EGG") + (? invalid) + (?ຄ consonant "BUFFALO") + (? invalid) + (? invalid) + (?ງ consonant "SNAKE") + (?ຈ consonant "BUDDHIST NOVICE") + (?ຉ invalid) + (?ຊ consonant "ELEPHANT") + (? invalid) + (?ຌ invalid) + (?ຍ consonant "MOSQUITO") + (?ຎ invalid) + (?ຎ invalid) + (?ຎ invalid) + (?ຎ invalid) + (?ຎ invalid) + (?ຎ invalid) + (?ດ consonant "NOSE") + (?ຕ consonant "EYE") + (?ຖ consonant "TO ASK,QUESTION") + (?ທ consonant "FLAG") + (?ຘ invalid) + (?ນ consonant "BIRD") + (?ບ consonant "FISHHOOK") + (?ປ consonant "FISH") + (?ຜ consonant "BEE") + (?ຝ consonant "WALL") + (?ພ consonant "MOUNTAIN") + (?ຟ consonant "FIRE") + (?ຠ invalid) + (?ມ consonant "HORSE") + (?ຢ consonant "MEDICINE") + (?ຣ consonant "CAR") + (? invalid) + (?ລ consonant "MONKEY") + (? invalid) + (?ວ consonant "HAND FAN") + (?ຨ invalid) + (?ຩ invalid) + (?ສ consonant "TIGER") + (?ຫ consonant "JAR") + (?ຬ invalid) + (?ອ consonant "TAKE") + (?ຮ consonant "BOAT") + (?ຯ special) + (?ະ vowel-base) + (?ັ vowel-upper) + (?າ vowel-base) + (?ຳ vowel-base) + (?ິ vowel-upper) + (?ີ vowel-upper) + (?ຶ vowel-upper) + (?ື vowel-upper) + (?ຸ vowel-lower) + (?ູ vowel-lower) + (?຺ invalid) + (?ົ vowel-upper) + (?ຼ semivowel-lower) + (?ຽ vowel-base) + (? invalid) + (? invalid) + (?ເ vowel-base) + (?ແ vowel-base) + (?ໂ vowel-base) + (?ໃ vowel-base) + (?ໄ vowel-base) + (? invalid) + (?ໆ special) + (? invalid) + (?່ tone) + (?້ tone) + (?໊ tone) + (?໋ tone) + (?໌ tone) + (?ໍ vowel-upper) + (?໎ invalid) + (? invalid) + (?໐ special) + (?໑ special) + (?໒ special) + (?໓ special) + (?໔ special) + (?໕ special) + (?໖ special) + (?໗ special) + (?໘ special) + (?໙ special) + (? invalid) + (? invalid) + (?ໜ consonant "MOUSE") + (?ໝ consonant "DOG") + (?ໞ invalid))) elm) (while l (setq elm (car l) l (cdr l)) @@ -146,8 +146,7 @@ ((eq ptype 'tone) (modify-category-entry char ?t lao-category-table))) (put-char-code-property char 'phonetic-type ptype) - (put-char-code-property char 'name (nth 2 elm)) - (put-char-code-property char 'meaning (nth 3 elm))))) + (put-char-code-property char 'meaning (nth 2 elm))))) ;; The general composing rules are as follows: ;; diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el index a9af5cf9beb..618af572434 100644 --- a/lisp/language/thai-util.el +++ b/lisp/language/thai-util.el @@ -55,100 +55,100 @@ "\\cc\\(\\cu\\|\\cI\\cU\\|\\cv\\ct?\\)\\|\\cv\\ct\\|\\cI\\cU" "Regular expression matching a Thai composite sequence.") -(let ((l '((?ก consonant "LETTER KO KAI") ; 0xA1 - (?ข consonant "LETTER KHO KHAI") ; 0xA2 - (?ฃ consonant "LETTER KHO KHUAT") ; 0xA3 - (?ค consonant "LETTER KHO KHWAI") ; 0xA4 - (?ฅ consonant "LETTER KHO KHON") ; 0xA5 - (?ฆ consonant "LETTER KHO RAKHANG") ; 0xA6 - (?ง consonant "LETTER NGO NGU") ; 0xA7 - (?จ consonant "LETTER CHO CHAN") ; 0xA8 - (?ฉ consonant "LETTER CHO CHING") ; 0xA9 - (?ช consonant "LETTER CHO CHANG") ; 0xAA - (?ซ consonant "LETTER SO SO") ; 0xAB - (?ฌ consonant "LETTER CHO CHOE") ; 0xAC - (?ญ consonant "LETTER YO YING") ; 0xAD - (?ฎ consonant "LETTER DO CHADA") ; 0xAE - (?ฏ consonant "LETTER TO PATAK") ; 0xAF - (?ฐ consonant "LETTER THO THAN") ; 0xB0 - (?ฑ consonant "LETTER THO NANGMONTHO") ; 0xB1 - (?ฒ consonant "LETTER THO PHUTHAO") ; 0xB2 - (?ณ consonant "LETTER NO NEN") ; 0xB3 - (?ด consonant "LETTER DO DEK") ; 0xB4 - (?ต consonant "LETTER TO TAO") ; 0xB5 - (?ถ consonant "LETTER THO THUNG") ; 0xB6 - (?ท consonant "LETTER THO THAHAN") ; 0xB7 - (?ธ consonant "LETTER THO THONG") ; 0xB8 - (?น consonant "LETTER NO NU") ; 0xB9 - (?บ consonant "LETTER BO BAIMAI") ; 0xBA - (?ป consonant "LETTER PO PLA") ; 0xBB - (?ผ consonant "LETTER PHO PHUNG") ; 0xBC - (?ฝ consonant "LETTER FO FA") ; 0xBD - (?พ consonant "LETTER PHO PHAN") ; 0xBE - (?ฟ consonant "LETTER FO FAN") ; 0xBF - (?ภ consonant "LETTER PHO SAMPHAO") ; 0xC0 - (?ม consonant "LETTER MO MA") ; 0xC1 - (?ย consonant "LETTER YO YAK") ; 0xC2 - (?ร consonant "LETTER RO RUA") ; 0xC3 - (?ฤ vowel-base "LETTER RU (Pali vowel letter)") ; 0xC4 - (?ล consonant "LETTER LO LING") ; 0xC5 - (?ฦ vowel-base "LETTER LU (Pali vowel letter)") ; 0xC6 - (?ว consonant "LETTER WO WAEN") ; 0xC7 - (?ศ consonant "LETTER SO SALA") ; 0xC8 - (?ษ consonant "LETTER SO RUSI") ; 0xC9 - (?ส consonant "LETTER SO SUA") ; 0xCA - (?ห consonant "LETTER HO HIP") ; 0xCB - (?ฬ consonant "LETTER LO CHULA") ; 0xCC - (?อ consonant "LETTER O ANG") ; 0xCD - (?ฮ consonant "LETTER HO NOK HUK") ; 0xCE - (?ฯ special "PAI YAN NOI (abbreviation)") ; 0xCF - (?ะ vowel-base "VOWEL SIGN SARA A") ; 0xD0 - (?ั vowel-upper "VOWEL SIGN MAI HAN-AKAT N/S-T") ; 0xD1 - (?า vowel-base "VOWEL SIGN SARA AA") ; 0xD2 - (?ำ vowel-base "VOWEL SIGN SARA AM") ; 0xD3 - (?ิ vowel-upper "VOWEL SIGN SARA I N/S-T") ; 0xD4 - (?ี vowel-upper "VOWEL SIGN SARA II N/S-T") ; 0xD5 - (?ึ vowel-upper "VOWEL SIGN SARA UE N/S-T") ; 0xD6 - (?ื vowel-upper "VOWEL SIGN SARA UEE N/S-T") ; 0xD7 - (?ุ vowel-lower "VOWEL SIGN SARA U N/S-B") ; 0xD8 - (?ู vowel-lower "VOWEL SIGN SARA UU N/S-B") ; 0xD9 - (?ฺ vowel-lower "VOWEL SIGN PHINTHU N/S-B (Pali virama)") ; 0xDA - (? invalid nil) ; 0xDA - (? invalid nil) ; 0xDC - (? invalid nil) ; 0xDC - (? invalid nil) ; 0xDC - (?฿ special "BAHT SIGN (currency symbol)") ; 0xDF - (?เ vowel-base "VOWEL SIGN SARA E") ; 0xE0 - (?แ vowel-base "VOWEL SIGN SARA AE") ; 0xE1 - (?โ vowel-base "VOWEL SIGN SARA O") ; 0xE2 - (?ใ vowel-base "VOWEL SIGN SARA MAI MUAN") ; 0xE3 - (?ไ vowel-base "VOWEL SIGN SARA MAI MALAI") ; 0xE4 - (?ๅ vowel-base "LAK KHANG YAO") ; 0xE5 - (?ๆ special "MAI YAMOK (repetition)") ; 0xE6 - (?็ sign-upper "VOWEL SIGN MAI TAI KHU N/S-T") ; 0xE7 - (?่ tone "TONE MAI EK N/S-T") ; 0xE8 - (?้ tone "TONE MAI THO N/S-T") ; 0xE9 - (?๊ tone "TONE MAI TRI N/S-T") ; 0xEA - (?๋ tone "TONE MAI CHATTAWA N/S-T") ; 0xEB - (?์ sign-upper "THANTHAKHAT N/S-T (cancellation mark)") ; 0xEC - (?ํ sign-upper "NIKKHAHIT N/S-T (final nasal)") ; 0xED - (?๎ sign-upper "YAMAKKAN N/S-T") ; 0xEE - (?๏ special "FONRMAN") ; 0xEF - (?๐ special "DIGIT ZERO") ; 0xF0 - (?๑ special "DIGIT ONE") ; 0xF1 - (?๒ special "DIGIT TWO") ; 0xF2 - (?๓ special "DIGIT THREE") ; 0xF3 - (?๔ special "DIGIT FOUR") ; 0xF4 - (?๕ special "DIGIT FIVE") ; 0xF5 - (?๖ special "DIGIT SIX") ; 0xF6 - (?๗ special "DIGIT SEVEN") ; 0xF7 - (?๘ special "DIGIT EIGHT") ; 0xF8 - (?๙ special "DIGIT NINE") ; 0xF9 - (?๚ special "ANGKHANKHU (ellipsis)") ; 0xFA - (?๛ special "KHOMUT (beginning of religious texts)") ; 0xFB - (? invalid nil) ; 0xFC - (? invalid nil) ; 0xFD - (? invalid nil) ; 0xFE +(let ((l '((?ก consonant) ; 0xA1 + (?ข consonant) ; 0xA2 + (?ฃ consonant) ; 0xA3 + (?ค consonant) ; 0xA4 + (?ฅ consonant) ; 0xA5 + (?ฆ consonant) ; 0xA6 + (?ง consonant) ; 0xA7 + (?จ consonant) ; 0xA8 + (?ฉ consonant) ; 0xA9 + (?ช consonant) ; 0xAA + (?ซ consonant) ; 0xAB + (?ฌ consonant) ; 0xAC + (?ญ consonant) ; 0xAD + (?ฎ consonant) ; 0xAE + (?ฏ consonant) ; 0xAF + (?ฐ consonant) ; 0xB0 + (?ฑ consonant) ; 0xB1 + (?ฒ consonant) ; 0xB2 + (?ณ consonant) ; 0xB3 + (?ด consonant) ; 0xB4 + (?ต consonant) ; 0xB5 + (?ถ consonant) ; 0xB6 + (?ท consonant) ; 0xB7 + (?ธ consonant) ; 0xB8 + (?น consonant) ; 0xB9 + (?บ consonant) ; 0xBA + (?ป consonant) ; 0xBB + (?ผ consonant) ; 0xBC + (?ฝ consonant) ; 0xBD + (?พ consonant) ; 0xBE + (?ฟ consonant) ; 0xBF + (?ภ consonant) ; 0xC0 + (?ม consonant) ; 0xC1 + (?ย consonant) ; 0xC2 + (?ร consonant) ; 0xC3 + (?ฤ vowel-base) ; 0xC4 + (?ล consonant) ; 0xC5 + (?ฦ vowel-base) ; 0xC6 + (?ว consonant) ; 0xC7 + (?ศ consonant) ; 0xC8 + (?ษ consonant) ; 0xC9 + (?ส consonant) ; 0xCA + (?ห consonant) ; 0xCB + (?ฬ consonant) ; 0xCC + (?อ consonant) ; 0xCD + (?ฮ consonant) ; 0xCE + (?ฯ special) ; 0xCF + (?ะ vowel-base) ; 0xD0 + (?ั vowel-upper) ; 0xD1 + (?า vowel-base) ; 0xD2 + (?ำ vowel-base) ; 0xD3 + (?ิ vowel-upper) ; 0xD4 + (?ี vowel-upper) ; 0xD5 + (?ึ vowel-upper) ; 0xD6 + (?ื vowel-upper) ; 0xD7 + (?ุ vowel-lower) ; 0xD8 + (?ู vowel-lower) ; 0xD9 + (?ฺ vowel-lower) ; 0xDA + (? invalid) ; 0xDA + (? invalid) ; 0xDC + (? invalid) ; 0xDC + (? invalid) ; 0xDC + (?฿ special) ; 0xDF + (?เ vowel-base) ; 0xE0 + (?แ vowel-base) ; 0xE1 + (?โ vowel-base) ; 0xE2 + (?ใ vowel-base) ; 0xE3 + (?ไ vowel-base) ; 0xE4 + (?ๅ vowel-base) ; 0xE5 + (?ๆ special) ; 0xE6 + (?็ sign-upper) ; 0xE7 + (?่ tone) ; 0xE8 + (?้ tone) ; 0xE9 + (?๊ tone) ; 0xEA + (?๋ tone) ; 0xEB + (?์ sign-upper) ; 0xEC + (?ํ sign-upper) ; 0xED + (?๎ sign-upper) ; 0xEE + (?๏ special) ; 0xEF + (?๐ special) ; 0xF0 + (?๑ special) ; 0xF1 + (?๒ special) ; 0xF2 + (?๓ special) ; 0xF3 + (?๔ special) ; 0xF4 + (?๕ special) ; 0xF5 + (?๖ special) ; 0xF6 + (?๗ special) ; 0xF7 + (?๘ special) ; 0xF8 + (?๙ special) ; 0xF9 + (?๚ special) ; 0xFA + (?๛ special) ; 0xFB + (? invalid) ; 0xFC + (? invalid) ; 0xFD + (? invalid) ; 0xFE )) elm) (while l @@ -170,8 +170,7 @@ (modify-category-entry char ?u thai-category-table) (if (= char ?์) ;; Give category `U' to "THANTHAKHAT". - (modify-category-entry char ?U thai-category-table)))) - (put-char-code-property char 'name (nth 2 elm))))) + (modify-category-entry char ?U thai-category-table))))))) (defun thai-compose-syllable (beg end &optional category-set string) (or category-set diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 30cfa1330c5..406f0456662 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,7 +3,7 @@ ;;; Code: -;;;### (autoloads nil "5x5" "play/5x5.el" (22164 57535 263192 607000)) +;;;### (autoloads nil "5x5" "play/5x5.el" (0 0 0 0)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -63,10 +63,11 @@ should return a grid vector array that is the new solution. \(fn BREEDER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "5x5" '("5x5-"))) + ;;;*** -;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (22164 57535 -;;;;;; 323192 607000)) +;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -83,10 +84,18 @@ Ada mode is the major mode for editing Ada code. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-mode" '("ada-"))) + ;;;*** -;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (22164 57535 -;;;;;; 327192 607000)) +;;;### (autoloads nil "ada-prj" "progmodes/ada-prj.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ada-prj.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-prj" '("ada-"))) + +;;;*** + +;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -94,10 +103,11 @@ Insert a descriptive header at the top of the file. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-stmt" '("ada-"))) + ;;;*** -;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (22164 57535 -;;;;;; 327192 607000)) +;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -106,10 +116,11 @@ Completion is available. \(fn FILENAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-xref" '("ada-"))) + ;;;*** -;;;### (autoloads nil "add-log" "vc/add-log.el" (22221 37190 92505 -;;;;;; 663000)) +;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -240,10 +251,11 @@ old-style time formats for entries are supported. \(fn OTHER-LOG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "add-log" '("change-log-" "add-log-"))) + ;;;*** -;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (22164 57534 -;;;;;; 115192 607000)) +;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -376,9 +388,11 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (function-put 'defadvice 'lisp-indent-function '2) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "advice" '("ad-"))) + ;;;*** -;;;### (autoloads nil "align" "align.el" (22226 55133 144211 947000)) +;;;### (autoloads nil "align" "align.el" (0 0 0 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -476,12 +490,16 @@ Remove any highlighting that was added by `align-highlight-rule'. (autoload 'align-newline-and-indent "align" "\ A replacement function for `newline-and-indent', aligning as it goes. +The alignment is done by calling `align' on the region that was +indented. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "align" '("align-"))) + ;;;*** -;;;### (autoloads nil "allout" "allout.el" (22195 13277 771727 967000)) +;;;### (autoloads nil "allout" "allout.el" (0 0 0 0)) ;;; Generated autoloads from allout.el (push (purecopy '(allout 2 3)) package--builtin-versions) @@ -839,10 +857,12 @@ for details on preparing Emacs for automatic allout activation. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout" '("allout-"))) + ;;;*** -;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (22164 -;;;;;; 57533 763192 607000)) +;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from allout-widgets.el (push (purecopy '(allout-widgets 1 0)) package--builtin-versions) @@ -898,10 +918,11 @@ outline hot-spot navigation (see `allout-mode'). \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout-widgets" '("allout-"))) + ;;;*** -;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (22164 57534 919192 -;;;;;; 607000)) +;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (0 0 0 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -920,10 +941,11 @@ directory, so that Emacs will know its current contents. \(fn OPERATION &rest ARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ange-ftp" '("ange-ftp-" "internal-ange-ftp-mode" "ftp-error"))) + ;;;*** -;;;### (autoloads nil "animate" "play/animate.el" (22164 57535 263192 -;;;;;; 607000)) +;;;### (autoloads nil "animate" "play/animate.el" (0 0 0 0)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -953,10 +975,11 @@ the buffer *Birthday-Present-for-Name*. \(fn &optional NAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "animate" '("animat"))) + ;;;*** -;;;### (autoloads nil "ansi-color" "ansi-color.el" (22164 57533 771192 -;;;;;; 607000)) +;;;### (autoloads nil "ansi-color" "ansi-color.el" (0 0 0 0)) ;;; Generated autoloads from ansi-color.el (push (purecopy '(ansi-color 3 4 2)) package--builtin-versions) @@ -980,10 +1003,12 @@ This is a good function to put in `comint-output-filter-functions'. \(fn IGNORED)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ansi-color" '("ansi-color-"))) + ;;;*** -;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (22189 -;;;;;; 60739 45741 19000)) +;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/antlr-mode.el (push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions) @@ -1017,10 +1042,11 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "antlr-mode" '("antlr-"))) + ;;;*** -;;;### (autoloads nil "appt" "calendar/appt.el" (22220 16330 579423 -;;;;;; 271000)) +;;;### (autoloads nil "appt" "calendar/appt.el" (0 0 0 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1039,10 +1065,11 @@ ARG is positive, otherwise off. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "appt" '("appt-"))) + ;;;*** -;;;### (autoloads nil "apropos" "apropos.el" (22164 57533 771192 -;;;;;; 607000)) +;;;### (autoloads nil "apropos" "apropos.el" (0 0 0 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1069,8 +1096,9 @@ variables, not just user options. (autoload 'apropos-variable "apropos" "\ Show variables that match PATTERN. -When DO-NOT-ALL is non-nil, show user options only, i.e. behave -like `apropos-user-option'. +With the optional argument DO-NOT-ALL non-nil (or when called +interactively with the prefix \\[universal-argument]), show user +options only, i.e. behave like `apropos-user-option'. \(fn PATTERN &optional DO-NOT-ALL)" t nil) @@ -1155,10 +1183,11 @@ Returns list of symbols and documentation found. \(fn PATTERN &optional DO-ALL)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "apropos" '("apropos-"))) + ;;;*** -;;;### (autoloads nil "arc-mode" "arc-mode.el" (22164 57533 775192 -;;;;;; 607000)) +;;;### (autoloads nil "arc-mode" "arc-mode.el" (0 0 0 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1176,9 +1205,11 @@ archive. \(fn &optional FORCE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "arc-mode" '("archive-"))) + ;;;*** -;;;### (autoloads nil "array" "array.el" (22164 57533 775192 607000)) +;;;### (autoloads nil "array" "array.el" (0 0 0 0)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1247,10 +1278,11 @@ Entering array mode calls the function `array-mode-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "untabify-backward" "move-to-column-untabify" "current-line" "xor" "limit-index"))) + ;;;*** -;;;### (autoloads nil "artist" "textmodes/artist.el" (22164 57535 -;;;;;; 795192 607000)) +;;;### (autoloads nil "artist" "textmodes/artist.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/artist.el (push (purecopy '(artist 1 2 6)) package--builtin-versions) @@ -1454,10 +1486,11 @@ Keymap summary \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "artist" '("artist-"))) + ;;;*** -;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (22164 57535 -;;;;;; 331192 607000)) +;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1482,10 +1515,11 @@ Special commands: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "asm-mode" '("asm-"))) + ;;;*** -;;;### (autoloads nil "auth-source" "auth-source.el" (22221 37189 -;;;;;; 844505 663000)) +;;;### (autoloads nil "auth-source" "auth-source.el" (0 0 0 0)) ;;; Generated autoloads from auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1495,15 +1529,17 @@ let-binding.") (custom-autoload 'auth-source-cache-expiry "auth-source" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "auth-source" '("auth-source"))) + ;;;*** -;;;### (autoloads nil "autoarg" "autoarg.el" (22164 57533 775192 -;;;;;; 607000)) +;;;### (autoloads nil "autoarg" "autoarg.el" (0 0 0 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ Non-nil if Autoarg mode is enabled. -See the command `autoarg-mode' for a description of this minor mode.") +See the `autoarg-mode' command +for a description of this minor mode.") (custom-autoload 'autoarg-mode "autoarg" nil) @@ -1535,7 +1571,8 @@ then invokes the normal binding of \\[autoarg-terminate]. (defvar autoarg-kp-mode nil "\ Non-nil if Autoarg-Kp mode is enabled. -See the command `autoarg-kp-mode' for a description of this minor mode. +See the `autoarg-kp-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `autoarg-kp-mode'.") @@ -1556,10 +1593,11 @@ This is similar to `autoarg-mode' but rebinds the keypad keys \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoarg" '("autoarg-"))) + ;;;*** -;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (22164 57535 -;;;;;; 331192 607000)) +;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1567,10 +1605,11 @@ Major mode for editing Autoconf configure.ac files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoconf" '("autoconf-"))) + ;;;*** -;;;### (autoloads nil "autoinsert" "autoinsert.el" (22195 13277 787727 -;;;;;; 967000)) +;;;### (autoloads nil "autoinsert" "autoinsert.el" (0 0 0 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1588,7 +1627,8 @@ or if CONDITION had no actions, after all other CONDITIONs. (defvar auto-insert-mode nil "\ Non-nil if Auto-Insert mode is enabled. -See the command `auto-insert-mode' for a description of this minor mode. +See the `auto-insert-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `auto-insert-mode'.") @@ -1606,9 +1646,12 @@ insert a template for the file depending on the mode of the buffer. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoinsert" '("auto-insert"))) + ;;;*** -;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" t) +;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1657,19 +1700,20 @@ should be non-nil). \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoload" '("autoload-" "generate" "no-update-autoloads" "make-autoload"))) + ;;;*** -;;;### (autoloads nil "autorevert" "autorevert.el" (22189 60737 941741 -;;;;;; 19000)) +;;;### (autoloads nil "autorevert" "autorevert.el" (0 0 0 0)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ -Toggle reverting buffer when the file changes (Auto Revert mode). -With a prefix argument ARG, enable Auto Revert mode if ARG is +Toggle reverting buffer when the file changes (Auto-Revert Mode). +With a prefix argument ARG, enable Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Auto Revert mode is a minor mode that affects only the current +Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on disk changes. @@ -1689,11 +1733,11 @@ This function is designed to be added to hooks, for example: (autoload 'auto-revert-tail-mode "autorevert" "\ Toggle reverting tail of buffer when the file grows. -With a prefix argument ARG, enable Auto-Revert Tail mode if ARG +With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -When Auto Revert Tail mode is enabled, the tail of the file is +When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This means that whenever the file grows on disk (presumably because some background process is appending to it from time to time), @@ -1708,7 +1752,7 @@ Use `auto-revert-mode' for changes other than appends! \(fn &optional ARG)" t nil) (autoload 'turn-on-auto-revert-tail-mode "autorevert" "\ -Turn on Auto-Revert Tail mode. +Turn on Auto-Revert Tail Mode. This function is designed to be added to hooks, for example: (add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode) @@ -1717,7 +1761,8 @@ This function is designed to be added to hooks, for example: (defvar global-auto-revert-mode nil "\ Non-nil if Global Auto-Revert mode is enabled. -See the command `global-auto-revert-mode' for a description of this minor mode. +See the `global-auto-revert-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-auto-revert-mode'.") @@ -1725,12 +1770,12 @@ or call the function `global-auto-revert-mode'.") (custom-autoload 'global-auto-revert-mode "autorevert" nil) (autoload 'global-auto-revert-mode "autorevert" "\ -Toggle Global Auto Revert mode. -With a prefix argument ARG, enable Global Auto Revert mode if ARG +Toggle Global Auto-Revert Mode. +With a prefix argument ARG, enable Global Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Global Auto Revert mode is a global minor mode that reverts any +Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use `auto-revert-mode' to revert a particular buffer. @@ -1746,9 +1791,19 @@ specifies in the mode line. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-"))) + ;;;*** -;;;### (autoloads nil "avoid" "avoid.el" (22164 57533 775192 607000)) +;;;### (autoloads nil "avl-tree" "emacs-lisp/avl-tree.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emacs-lisp/avl-tree.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avl-tree" '("avl-tree-"))) + +;;;*** + +;;;### (autoloads nil "avoid" "avoid.el" (0 0 0 0)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1784,10 +1839,11 @@ definition of \"random distance\".) \(fn &optional MODE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avoid" '("mouse-avoidance-"))) + ;;;*** -;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (22164 57535 -;;;;;; 331192 607000)) +;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/bat-mode.el (add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode)) @@ -1803,10 +1859,11 @@ Run script using `bat-run' and `bat-run-args'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bat-mode" '("bat-"))) + ;;;*** -;;;### (autoloads nil "battery" "battery.el" (22220 16330 563423 -;;;;;; 271000)) +;;;### (autoloads nil "battery" "battery.el" (0 0 0 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1819,7 +1876,8 @@ The text being displayed in the echo area is controlled by the variables (defvar display-battery-mode nil "\ Non-nil if Display-Battery mode is enabled. -See the command `display-battery-mode' for a description of this minor mode. +See the `display-battery-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `display-battery-mode'.") @@ -1839,10 +1897,12 @@ seconds. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "battery" '("battery-"))) + ;;;*** -;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (22164 -;;;;;; 57534 119192 607000)) +;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1876,10 +1936,18 @@ For non-interactive use see also `benchmark-run' and \(fn REPETITIONS FORM)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "benchmark" '("benchmark-elapse"))) + ;;;*** -;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (22164 57535 -;;;;;; 799192 607000)) +;;;### (autoloads nil "bib-mode" "textmodes/bib-mode.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/bib-mode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bib-mode" '("bib-" "unread-bib" "mark-bib" "return-key-bib" "addbib"))) + +;;;*** + +;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1968,10 +2036,12 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. \(fn KEY &optional GLOBAL START DISPLAY)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex" '("bibtex-"))) + ;;;*** ;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (22164 57535 795192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1979,10 +2049,18 @@ Major mode for editing BibTeX style files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex-style" '("bibtex-style-"))) + +;;;*** + +;;;### (autoloads nil "bindat" "emacs-lisp/bindat.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/bindat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bindat" '("bindat-"))) + ;;;*** -;;;### (autoloads nil "binhex" "mail/binhex.el" (22164 57534 803192 -;;;;;; 607000)) +;;;### (autoloads nil "binhex" "mail/binhex.el" (0 0 0 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -2004,10 +2082,11 @@ Binhex decode region between START and END. \(fn START END)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "binhex" '("binhex-"))) + ;;;*** -;;;### (autoloads nil "blackbox" "play/blackbox.el" (22164 57535 -;;;;;; 263192 607000)) +;;;### (autoloads nil "blackbox" "play/blackbox.el" (0 0 0 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2124,10 +2203,11 @@ a reflection. \(fn NUM)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "blackbox" '("blackbox-" "bb-"))) + ;;;*** -;;;### (autoloads nil "bookmark" "bookmark.el" (22164 57533 779192 -;;;;;; 607000)) +;;;### (autoloads nil "bookmark" "bookmark.el" (0 0 0 0)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2318,9 +2398,9 @@ while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first -place. Your own personal bookmark file, `~/.emacs.bmk', is -maintained automatically by Emacs; you shouldn't need to load it -explicitly. +place. Your own personal bookmark file, specified by the variable +`bookmark-default-file', is maintained automatically by Emacs; you +shouldn't need to load it explicitly. If you load a file containing bookmarks with the same names as bookmarks already present in your Emacs, the new bookmarks will get @@ -2349,10 +2429,11 @@ Incremental search of bookmarks, hiding the non-matches as we go. (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bookmark" '("bookmark" "with-buffer-modified-unmodified"))) + ;;;*** -;;;### (autoloads nil "browse-url" "net/browse-url.el" (22195 13278 -;;;;;; 155727 967000)) +;;;### (autoloads nil "browse-url" "net/browse-url.el" (0 0 0 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2698,9 +2779,11 @@ from `browse-url-elinks-wrapper'. \(fn URL &optional NEW-WINDOW)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "browse-url" '("browse-url-"))) + ;;;*** -;;;### (autoloads nil "bs" "bs.el" (22164 57533 783192 607000)) +;;;### (autoloads nil "bs" "bs.el" (0 0 0 0)) ;;; Generated autoloads from bs.el (push (purecopy '(bs 1 17)) package--builtin-versions) @@ -2739,10 +2822,11 @@ name of buffer configuration. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bs" '("bs-"))) + ;;;*** -;;;### (autoloads nil "bubbles" "play/bubbles.el" (22164 57535 263192 -;;;;;; 607000)) +;;;### (autoloads nil "bubbles" "play/bubbles.el" (0 0 0 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2761,10 +2845,12 @@ columns on its right towards the left. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bubbles" '("bubbles-"))) + ;;;*** ;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el" -;;;;;; (22164 57535 331192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/bug-reference.el (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) @@ -2782,10 +2868,20 @@ Like `bug-reference-mode', but only buttonize in comments and strings. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-"))) + ;;;*** -;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (22195 -;;;;;; 13277 943727 967000)) +;;;### (autoloads nil "byte-opt" "emacs-lisp/byte-opt.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emacs-lisp/byte-opt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset"))) + +;;;*** + +;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2903,18 +2999,37 @@ and corresponding effects. \(fn &optional ARG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "no-byte-compile" "displaying-byte-compile-warnings" "emacs-lisp-file-regexp"))) + +;;;*** + +;;;### (autoloads nil "cal-bahai" "calendar/cal-bahai.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from calendar/cal-bahai.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-bahai" '("diary-bahai-" "calendar-bahai-" "holiday-bahai"))) + ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (22195 -;;;;;; 13277 815727 967000)) +;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-china" '("diary-chinese-" "calendar-chinese-" "holiday-chinese"))) + +;;;*** + +;;;### (autoloads nil "cal-coptic" "calendar/cal-coptic.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from calendar/cal-coptic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-coptic" '("diary-" "calendar-"))) + ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (22164 57533 -;;;;;; 835192 607000)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (0 0 0 0)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2923,10 +3038,20 @@ and corresponding effects. (put 'calendar-current-time-zone-cache 'risky-local-variable t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-dst" '("dst-" "calendar-"))) + ;;;*** -;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (22164 -;;;;;; 57533 839192 607000)) +;;;### (autoloads nil "cal-french" "calendar/cal-french.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from calendar/cal-french.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-french" '("diary-french-date" "calendar-french-"))) + +;;;*** + +;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2936,9 +3061,85 @@ from the cursor position. \(fn DEATH-DATE START-YEAR END-YEAR)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-hebrew" '("diary-hebrew-" "calendar-hebrew-" "holiday-hebrew"))) + ;;;*** -;;;### (autoloads nil "calc" "calc/calc.el" (22164 57533 823192 607000)) +;;;### (autoloads nil "cal-html" "calendar/cal-html.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-html.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-html" '("cal-html-"))) + +;;;*** + +;;;### (autoloads nil "cal-islam" "calendar/cal-islam.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from calendar/cal-islam.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-islam" '("diary-islamic-" "calendar-islamic-" "holiday-islamic"))) + +;;;*** + +;;;### (autoloads nil "cal-iso" "calendar/cal-iso.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-iso.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-iso" '("diary-iso-date" "calendar-iso-"))) + +;;;*** + +;;;### (autoloads nil "cal-julian" "calendar/cal-julian.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from calendar/cal-julian.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-julian" '("diary-" "calendar-" "holiday-julian"))) + +;;;*** + +;;;### (autoloads nil "cal-mayan" "calendar/cal-mayan.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from calendar/cal-mayan.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-mayan" '("diary-mayan-date" "calendar-mayan-"))) + +;;;*** + +;;;### (autoloads nil "cal-menu" "calendar/cal-menu.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-menu.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-menu" '("cal"))) + +;;;*** + +;;;### (autoloads nil "cal-move" "calendar/cal-move.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-move.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-move" '("calendar-"))) + +;;;*** + +;;;### (autoloads nil "cal-persia" "calendar/cal-persia.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from calendar/cal-persia.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-persia" '("diary-persian-date" "calendar-persian-"))) + +;;;*** + +;;;### (autoloads nil "cal-tex" "calendar/cal-tex.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-tex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-tex" '("cal-tex-"))) + +;;;*** + +;;;### (autoloads nil "cal-x" "calendar/cal-x.el" (0 0 0 0)) +;;; Generated autoloads from calendar/cal-x.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-x" '("calendar-" "diary-frame"))) + +;;;*** + +;;;### (autoloads nil "calc" "calc/calc.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -3022,10 +3223,252 @@ See Info node `(calc)Defining Functions'. (function-put 'defmath 'doc-string-elt '3) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc" '("math-" "calc" "var-" "inexact-result" "defcalcmodevar"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "calc-aent" "calc/calc-aent.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from calc/calc-aent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-aent" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-alg" "calc/calc-alg.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-alg.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-alg" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-arith" "calc/calc-arith.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-arith.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-arith" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-bin" "calc/calc-bin.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-bin.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-bin" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-comb" "calc/calc-comb.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-comb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-comb" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-cplx" "calc/calc-cplx.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-cplx.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-cplx" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "calc-embed" "calc/calc-embed.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from calc/calc-embed.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-embed" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-ext" "calc/calc-ext.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-ext.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-ext" '("calc" "math-" "var-"))) + +;;;*** + +;;;### (autoloads nil "calc-fin" "calc/calc-fin.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-fin.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-fin" '("calc" "math-c"))) + +;;;*** + +;;;### (autoloads nil "calc-forms" "calc/calc-forms.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-forms.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-forms" '("math-" "calc" "var-TimeZone"))) + ;;;*** -;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (22164 57533 -;;;;;; 807192 607000)) +;;;### (autoloads nil "calc-frac" "calc/calc-frac.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-frac.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-frac" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-funcs" "calc/calc-funcs.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-funcs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-funcs" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-graph" "calc/calc-graph.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-graph.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-graph" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-help" "calc/calc-help.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-help.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-help" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-incom" "calc/calc-incom.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-incom.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-incom" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-keypd" "calc/calc-keypd.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-keypd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-keypd" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-lang" "calc/calc-lang.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-lang.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-lang" '("math-" "calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-macs" "calc/calc-macs.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-macs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-map" "calc/calc-map.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-map.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-map" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-math" "calc/calc-math.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-math.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-math" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-menu" "calc/calc-menu.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-menu.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-menu" '("calc-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "calc-misc" "calc/calc-misc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from calc/calc-misc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-misc" '("math-iipow"))) + +;;;*** + +;;;### (autoloads nil "calc-mode" "calc/calc-mode.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-mode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec"))) + +;;;*** + +;;;### (autoloads nil "calc-mtx" "calc/calc-mtx.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-mtx.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mtx" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-nlfit" "calc/calc-nlfit.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-nlfit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-"))) + +;;;*** + +;;;### (autoloads nil "calc-poly" "calc/calc-poly.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-poly.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-poly" '("calcFunc-" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-prog" "calc/calc-prog.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-prog.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-prog" '("math-" "calc" "var-q"))) + +;;;*** + +;;;### (autoloads nil "calc-rewr" "calc/calc-rewr.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-rewr.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rewr" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-rules" "calc/calc-rules.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-rules.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rules" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-sel" "calc/calc-sel.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-sel.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-sel" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calc-stat" "calc/calc-stat.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-stat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stat" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-store" "calc/calc-store.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-store.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-store" '("calc"))) + +;;;*** + +;;;### (autoloads nil "calc-stuff" "calc/calc-stuff.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-stuff.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stuff" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calc-trail" "calc/calc-trail.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-trail.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-trail" '("calc-trail-"))) + +;;;*** + +;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -3033,10 +3476,61 @@ See Info node `(calc)Defining Functions'. \(fn N)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-undo" '("calc-"))) + ;;;*** -;;;### (autoloads nil "calculator" "calculator.el" (22164 57533 831192 -;;;;;; 607000)) +;;;### (autoloads nil "calc-units" "calc/calc-units.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-units.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-units" '("calc" "math-"))) + +;;;*** + +;;;### (autoloads nil "calc-vec" "calc/calc-vec.el" (0 0 0 0)) +;;; Generated autoloads from calc/calc-vec.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-vec" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "calc-yank" "calc/calc-yank.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from calc/calc-yank.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp"))) + +;;;*** + +;;;### (autoloads nil "calcalg2" "calc/calcalg2.el" (0 0 0 0)) +;;; Generated autoloads from calc/calcalg2.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit"))) + +;;;*** + +;;;### (autoloads nil "calcalg3" "calc/calcalg3.el" (0 0 0 0)) +;;; Generated autoloads from calc/calcalg3.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg3" '("math-" "calc"))) + +;;;*** + +;;;### (autoloads nil "calccomp" "calc/calccomp.el" (0 0 0 0)) +;;; Generated autoloads from calc/calccomp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calccomp" '("math-" "calcFunc-c"))) + +;;;*** + +;;;### (autoloads nil "calcsel2" "calc/calcsel2.el" (0 0 0 0)) +;;; Generated autoloads from calc/calcsel2.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcsel2" '("calc-"))) + +;;;*** + +;;;### (autoloads nil "calculator" "calculator.el" (0 0 0 0)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -3045,10 +3539,11 @@ See the documentation for `calculator-mode' for more information. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calculator" '("calculator-"))) + ;;;*** -;;;### (autoloads nil "calendar" "calendar/calendar.el" (22195 13277 -;;;;;; 823727 967000)) +;;;### (autoloads nil "calendar" "calendar/calendar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3089,10 +3584,11 @@ This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calendar" '("calendar-" "solar-sunrises-buffer" "lunar-phases-buffer" "diary-" "holiday-buffer"))) + ;;;*** -;;;### (autoloads nil "canlock" "gnus/canlock.el" (22207 4296 604349 -;;;;;; 691000)) +;;;### (autoloads nil "canlock" "gnus/canlock.el" (0 0 0 0)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3107,9 +3603,48 @@ it fails. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "canlock" '("canlock-"))) + +;;;*** + +;;;### (autoloads nil "cc-align" "progmodes/cc-align.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-align.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-align" '("c-"))) + +;;;*** + +;;;### (autoloads nil "cc-awk" "progmodes/cc-awk.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-awk.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-awk" '("c-awk-" "awk-"))) + +;;;*** + +;;;### (autoloads nil "cc-bytecomp" "progmodes/cc-bytecomp.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from progmodes/cc-bytecomp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-bytecomp" '("cc-"))) + ;;;*** -;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" t) +;;;### (autoloads nil "cc-cmds" "progmodes/cc-cmds.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-cmds.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-cmds" '("c-"))) + +;;;*** + +;;;### (autoloads nil "cc-defs" "progmodes/cc-defs.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-defs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-defs" '("cc-bytecomp-compiling-or-loading" "c-"))) + +;;;*** + +;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3117,10 +3652,18 @@ Return the syntactic context of the current line. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-engine" '("c-"))) + +;;;*** + +;;;### (autoloads nil "cc-fonts" "progmodes/cc-fonts.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-fonts.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-fonts" '("autodoc-" "java" "gtkdoc-font-lock-" "c++-font-lock-keywords" "c-" "pike-font-lock-keywords" "idl-font-lock-keywords" "objc-font-lock-keywords"))) + ;;;*** -;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (22164 57535 -;;;;;; 387192 607000)) +;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cc-guess.el (defvar c-guess-guessed-offsets-alist nil "\ @@ -3216,9 +3759,25 @@ the absolute file name of the file if STYLE-NAME is nil. \(fn &optional STYLE-NAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-guess" '("c-guess-"))) + +;;;*** + +;;;### (autoloads nil "cc-langs" "progmodes/cc-langs.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-langs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-langs" '("c-"))) + +;;;*** + +;;;### (autoloads nil "cc-menus" "progmodes/cc-menus.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/cc-menus.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-menus" '("cc-imenu-"))) + ;;;*** -;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" t) +;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3233,7 +3792,8 @@ control). See \"cc-mode.el\" for more info. (add-to-list 'auto-mode-alist '("\\.\\(cc\\|hh\\)\\'" . c++-mode)) (add-to-list 'auto-mode-alist '("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)) (add-to-list 'auto-mode-alist '("\\.\\(CC?\\|HH?\\)\\'" . c++-mode)) - (add-to-list 'auto-mode-alist '("\\.[ch]\\'" . c-mode)) + (add-to-list 'auto-mode-alist '("\\.c\\'" . c-mode)) + (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-mode)) (add-to-list 'auto-mode-alist '("\\.y\\(acc\\)?\\'" . c-mode)) (add-to-list 'auto-mode-alist '("\\.lex\\'" . c-mode)) (add-to-list 'auto-mode-alist '("\\.i\\'" . c-mode)) @@ -3257,6 +3817,20 @@ Key bindings: \(fn)" t nil) +(autoload 'c-or-c++-mode "cc-mode" "\ +Analyse buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-mode' or `c++-mode'. + +\(fn)" nil nil) + (autoload 'c++-mode "cc-mode" "\ Major mode for editing C++ code. To submit a problem report, enter `\\[c-submit-bug-report]' from a @@ -3374,10 +3948,12 @@ Key bindings: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-mode" '("c++-mode-" "c-" "awk-mode-map" "pike-mode-" "idl-mode-" "java-mode-" "objc-mode-"))) + ;;;*** -;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (22164 -;;;;;; 57535 395192 607000)) +;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3426,18 +4002,21 @@ and exists only for compatibility reasons. \(fn SYMBOL OFFSET &optional IGNORED)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode"))) + ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" t) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) (put 'c-file-style 'safe-local-variable 'string-or-null-p) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-vars" '("c++-" "c-" "pike-" "idl-" "java-" "objc-" "awk-mode-hook" "defcustom-c-stylevar"))) + ;;;*** -;;;### (autoloads nil "ccl" "international/ccl.el" (22164 57534 739192 -;;;;;; 607000)) +;;;### (autoloads nil "ccl" "international/ccl.el" (0 0 0 0)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3728,10 +4307,11 @@ See the documentation of `define-ccl-program' for the detail of CCL program. \(fn CCL-PROG &rest ARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ccl" '("ccl-"))) + ;;;*** -;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (22164 57534 -;;;;;; 135192 607000)) +;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3748,17 +4328,58 @@ Add the warnings that closure conversion would encounter. \(fn FORM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cconv" '("cconv-"))) + +;;;*** + +;;;### (autoloads nil "cdl" "cdl.el" (0 0 0 0)) +;;; Generated autoloads from cdl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cdl" '("cdl-"))) + ;;;*** -;;;### (autoloads nil "cedet" "cedet/cedet.el" (22164 57533 915192 -;;;;;; 607000)) +;;;### (autoloads nil "cedet" "cedet/cedet.el" (0 0 0 0)) ;;; Generated autoloads from cedet/cedet.el (push (purecopy '(cedet 2 0)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet" '("cedet-"))) + +;;;*** + +;;;### (autoloads nil "cedet-cscope" "cedet/cedet-cscope.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/cedet-cscope.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-cscope" '("cedet-cscope-"))) + +;;;*** + +;;;### (autoloads nil "cedet-files" "cedet/cedet-files.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cedet/cedet-files.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-files" '("cedet-"))) + +;;;*** + +;;;### (autoloads nil "cedet-global" "cedet/cedet-global.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/cedet-global.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-global" '("cedet-g"))) + ;;;*** -;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (22164 57535 -;;;;;; 399192 607000)) +;;;### (autoloads nil "cedet-idutils" "cedet/cedet-idutils.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/cedet-idutils.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-idutils" '("cedet-idutils-"))) + +;;;*** + +;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cfengine.el (push (purecopy '(cfengine 1 4)) package--builtin-versions) @@ -3785,16 +4406,17 @@ Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cfengine" '("cfengine"))) + ;;;*** -;;;### (autoloads nil "character-fold" "character-fold.el" (22164 -;;;;;; 57534 19192 607000)) -;;; Generated autoloads from character-fold.el +;;;### (autoloads nil "char-fold" "char-fold.el" (0 0 0 0)) +;;; Generated autoloads from char-fold.el -(autoload 'character-fold-to-regexp "character-fold" "\ -Return a regexp matching anything that character-folds into STRING. +(autoload 'char-fold-to-regexp "char-fold" "\ +Return a regexp matching anything that char-folds into STRING. Any character in STRING that has an entry in -`character-fold-table' is replaced with that entry (which is a +`char-fold-table' is replaced with that entry (which is a regexp) and other characters are `regexp-quote'd. If the resulting regexp would be too long for Emacs to handle, @@ -3805,17 +4427,20 @@ from which to start. \(fn STRING &optional LAX FROM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "char-fold" '("char-fold-"))) + ;;;*** -;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (22164 57534 -;;;;;; 135192 607000)) +;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/chart.el (push (purecopy '(chart 0 2)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chart" '("chart"))) + ;;;*** ;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el" -;;;;;; (22174 6972 464792 520000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3830,10 +4455,12 @@ Returns non-nil if any false statements are found. \(fn ROOT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "check-declare" '("check-declare-"))) + ;;;*** -;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (22222 -;;;;;; 58051 697213 356000)) +;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (push (purecopy '(checkdoc 0 6 2)) package--builtin-versions) (put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp) @@ -4041,10 +4668,12 @@ Find package keywords that aren't in `finder-known-keywords'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "checkdoc" '("checkdoc-"))) + ;;;*** -;;;### (autoloads nil "china-util" "language/china-util.el" (22164 -;;;;;; 57534 767192 607000)) +;;;### (autoloads nil "china-util" "language/china-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -4079,10 +4708,11 @@ Encode the text in the current buffer to HZ. \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "china-util" '("hz/zw-start-gb" "hz-" "decode-hz-line-continuation" "zw-start-gb" "iso2022-"))) + ;;;*** -;;;### (autoloads nil "chistory" "chistory.el" (22164 57534 23192 -;;;;;; 607000)) +;;;### (autoloads nil "chistory" "chistory.el" (0 0 0 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4095,7 +4725,7 @@ editing and the result is evaluated. \(fn &optional PATTERN)" t nil) (autoload 'list-command-history "chistory" "\ -List history of commands typed to minibuffer. +List history of commands that used the minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. @@ -4119,10 +4749,27 @@ and runs the normal hook `command-history-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chistory" '("command-history-" "list-command-history-" "default-command-history-filter"))) + ;;;*** -;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (22164 -;;;;;; 57534 155192 607000)) +;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/cl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl" '("cl-" "def" "lexical-let" "labels" "flet"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/cl-extra.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-extra" '("cl-"))) + +;;;*** + +;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4203,10 +4850,11 @@ instead. \(fn INDENT-POINT STATE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-indent" '("lisp-" "common-lisp-"))) + ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (22164 57534 -;;;;;; 155192 607000)) +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cl-lib.el (push (purecopy '(cl-lib 1 0)) package--builtin-versions) @@ -4222,10 +4870,27 @@ printer proceeds to the next function on the list. This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it.") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "cl-macs" "emacs-lisp/cl-macs.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/cl-macs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-macs" '("cl-"))) + ;;;*** -;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (22164 57535 -;;;;;; 399192 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "cl-seq" "emacs-lisp/cl-seq.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/cl-seq.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-seq" '("cl--"))) + +;;;*** + +;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4243,10 +4908,11 @@ For use inside Lisp programs, see also `c-macro-expansion'. \(fn START END SUBST)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmacexp" '("c-macro-"))) + ;;;*** -;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (22164 57534 23192 -;;;;;; 607000)) +;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (0 0 0 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4264,9 +4930,11 @@ is run). \(fn CMD)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "switch-to-scheme" "scheme-" "inferior-scheme-"))) + ;;;*** -;;;### (autoloads nil "color" "color.el" (22164 57534 23192 607000)) +;;;### (autoloads nil "color" "color.el" (0 0 0 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4283,9 +4951,11 @@ If FRAME cannot display COLOR, return nil. \(fn COLOR &optional FRAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "color" '("color-"))) + ;;;*** -;;;### (autoloads nil "comint" "comint.el" (22203 7237 314647 107000)) +;;;### (autoloads nil "comint" "comint.el" (0 0 0 0)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4384,10 +5054,11 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. \(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-" "shell-strip-ctrl-m" "send-invisible"))) + ;;;*** -;;;### (autoloads nil "compare-w" "vc/compare-w.el" (22164 57535 -;;;;;; 851192 607000)) +;;;### (autoloads nil "compare-w" "vc/compare-w.el" (0 0 0 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4421,10 +5092,18 @@ on third call it again advances points to the next difference and so on. \(fn IGNORE-WHITESPACE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compare-w" '("compare-"))) + +;;;*** + +;;;### (autoloads nil "compface" "image/compface.el" (0 0 0 0)) +;;; Generated autoloads from image/compface.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compface" '("uncompface"))) + ;;;*** -;;;### (autoloads nil "compile" "progmodes/compile.el" (22164 57535 -;;;;;; 419192 607000)) +;;;### (autoloads nil "compile" "progmodes/compile.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4603,15 +5282,17 @@ This is the value of `next-error-function' in Compilation buffers. \(fn N &optional RESET)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "kill-compilation" "define-compilation-mode" "recompile"))) + ;;;*** -;;;### (autoloads nil "completion" "completion.el" (22164 57534 47192 -;;;;;; 607000)) +;;;### (autoloads nil "completion" "completion.el" (0 0 0 0)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ Non-nil if Dynamic-Completion mode is enabled. -See the command `dynamic-completion-mode' for a description of this minor mode. +See the `dynamic-completion-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `dynamic-completion-mode'.") @@ -4626,10 +5307,12 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "completion" '("inside-locate-completion-entry" "interactive-completion-string-reader" "initialize-completions" "current-completion-source" "cdabbrev-" "clear-all-completions" "check-completion-length" "complet" "cmpl-" "use-completion-" "list-all-completions" "symbol-" "set-c" "save" "kill-" "accept-completion" "add-" "*lisp-def-regexp*" "*c-def-regexp*" "delete-completion" "find-" "make-c" "num-cmpl-sources" "next-cdabbrev" "reset-cdabbrev" "enable-completion"))) + ;;;*** -;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (22164 -;;;;;; 57535 799192 607000)) +;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4782,10 +5465,11 @@ For details see `conf-mode'. Example: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "conf-mode" '("conf-"))) + ;;;*** -;;;### (autoloads nil "cookie1" "play/cookie1.el" (22164 57535 263192 -;;;;;; 607000)) +;;;### (autoloads nil "cookie1" "play/cookie1.el" (0 0 0 0)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4811,10 +5495,12 @@ and subsequent calls on the same file won't go to disk. \(fn PHRASE-FILE &optional STARTMSG ENDMSG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cookie1" '("cookie"))) + ;;;*** -;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (22164 -;;;;;; 57534 163192 607000)) +;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/copyright.el (put 'copyright-at-end-flag 'safe-local-variable 'booleanp) (put 'copyright-names-regexp 'safe-local-variable 'stringp) @@ -4850,10 +5536,12 @@ If FIX is non-nil, run `copyright-fix-years' instead. \(fn DIRECTORY MATCH &optional FIX)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "copyright" '("copyright-"))) + ;;;*** -;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (22164 -;;;;;; 57535 427192 607000)) +;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -5049,10 +5737,11 @@ Run a `perldoc' on the word around point. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program"))) + ;;;*** -;;;### (autoloads nil "cpp" "progmodes/cpp.el" (22164 57535 431192 -;;;;;; 607000)) +;;;### (autoloads nil "cpp" "progmodes/cpp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -5068,10 +5757,11 @@ Edit display information for cpp conditionals. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cpp" '("cpp-"))) + ;;;*** -;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (22164 57534 163192 -;;;;;; 607000)) +;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5095,10 +5785,11 @@ with empty strings removed. \(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "crm" '("crm-"))) + ;;;*** -;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (22228 10440 -;;;;;; 255428 995000)) +;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5112,15 +5803,17 @@ Major mode to edit \"Sassy CSS\" files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "css-mode" '("scss-" "css-"))) + ;;;*** -;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (22164 57534 -;;;;;; 223192 607000)) +;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (0 0 0 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ Non-nil if Cua mode is enabled. -See the command `cua-mode' for a description of this minor mode. +See the `cua-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `cua-mode'.") @@ -5158,10 +5851,18 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-base" '("cua-"))) + ;;;*** -;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (22164 57534 -;;;;;; 223192 607000)) +;;;### (autoloads nil "cua-gmrk" "emulation/cua-gmrk.el" (0 0 0 0)) +;;; Generated autoloads from emulation/cua-gmrk.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-gmrk" '("cua-"))) + +;;;*** + +;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (0 0 0 0)) ;;; Generated autoloads from emulation/cua-rect.el (autoload 'cua-rectangle-mark-mode "cua-rect" "\ @@ -5170,12 +5871,16 @@ Activates the region if needed. Only lasts until the region is deactivated. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-"))) + ;;;*** ;;;### (autoloads nil "cursor-sensor" "emacs-lisp/cursor-sensor.el" -;;;;;; (22174 6972 468792 520000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cursor-sensor.el +(defvar cursor-sensor-inhibit nil) + (autoload 'cursor-intangible-mode "cursor-sensor" "\ Keep cursor outside of any `cursor-intangible' text property. @@ -5191,10 +5896,18 @@ is entering the area covered by the text-property property or leaving it. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))) + ;;;*** -;;;### (autoloads nil "cus-edit" "cus-edit.el" (22164 57534 63192 -;;;;;; 607000)) +;;;### (autoloads nil "cus-dep" "cus-dep.el" (0 0 0 0)) +;;; Generated autoloads from cus-dep.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file"))) + +;;;*** + +;;;### (autoloads nil "cus-edit" "cus-edit.el" (0 0 0 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5279,9 +5992,10 @@ are shown; the contents of those subgroups are initially hidden. \(fn)" t nil) (autoload 'customize-mode "cus-edit" "\ -Customize options related to the current major mode. -If a prefix \\[universal-argument] was given (or if the current major mode has no known group), -then prompt for the MODE to customize. +Customize options related to a major or minor mode. +By default the current major mode is used. With a prefix +argument or if the current major mode has no known group, prompt +for the MODE to customize. \(fn MODE)" t nil) @@ -5444,6 +6158,7 @@ Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option. +DESCRIPTION is unused. \(fn OPTIONS &optional NAME DESCRIPTION)" nil nil) @@ -5511,10 +6226,11 @@ The format is suitable for use with `easy-menu-define'. \(fn SYMBOL &optional NAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-edit" '("Custom-" "custom" "widget-"))) + ;;;*** -;;;### (autoloads nil "cus-theme" "cus-theme.el" (22164 57534 67192 -;;;;;; 607000)) +;;;### (autoloads nil "cus-theme" "cus-theme.el" (0 0 0 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5545,10 +6261,11 @@ omitted, a buffer named *Custom Themes* is used. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1"))) + ;;;*** -;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (22164 57535 -;;;;;; 851192 607000)) +;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (0 0 0 0)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5556,10 +6273,11 @@ Mode used for cvs status output. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cvs-status" '("cvs-"))) + ;;;*** -;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (22164 57535 431192 -;;;;;; 607000)) +;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cwarn.el (push (purecopy '(cwarn 1 3 1)) package--builtin-versions) @@ -5582,7 +6300,8 @@ if ARG is omitted or nil. (defvar global-cwarn-mode nil "\ Non-nil if Global Cwarn mode is enabled. -See the command `global-cwarn-mode' for a description of this minor mode. +See the `global-cwarn-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-cwarn-mode'.") @@ -5601,10 +6320,12 @@ See `cwarn-mode' for more information on Cwarn mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cwarn" '("turn-on-cwarn-mode-if-enabled" "cwarn-"))) + ;;;*** -;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (22164 -;;;;;; 57534 767192 607000)) +;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5630,9 +6351,11 @@ If the argument is nil, we return the display table to its standard state. \(fn &optional CYRILLIC-LANGUAGE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cyril-util" '("cyrillic-language-alist"))) + ;;;*** -;;;### (autoloads nil "dabbrev" "dabbrev.el" (22164 57534 67192 607000)) +;;;### (autoloads nil "dabbrev" "dabbrev.el" (0 0 0 0)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5660,7 +6383,10 @@ Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable -`dabbrev-friend-buffer-function'. +`dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' +says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in +all the other buffers, subject to constraints specified +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. @@ -5676,10 +6402,11 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dabbrev" '("dabbrev-"))) + ;;;*** -;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (22164 57533 -;;;;;; 927192 607000)) +;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (0 0 0 0)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5687,9 +6414,11 @@ Create a new data-debug buffer with NAME. \(fn NAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "data-debug" '("data-debug-"))) + ;;;*** -;;;### (autoloads nil "dbus" "net/dbus.el" (22164 57534 919192 607000)) +;;;### (autoloads nil "dbus" "net/dbus.el" (0 0 0 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5700,10 +6429,11 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. \(fn EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dbus" '("dbus-"))) + ;;;*** -;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (22164 57535 -;;;;;; 431192 607000)) +;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5827,10 +6557,11 @@ There is some minimal font-lock support (see vars \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dcl-mode" '("dcl-"))) + ;;;*** -;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (22164 57534 -;;;;;; 167192 607000)) +;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5871,10 +6602,11 @@ To specify a nil argument interactively, exit with an empty minibuffer. \(fn &optional FUNCTION)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry"))) + ;;;*** -;;;### (autoloads nil "decipher" "play/decipher.el" (22164 57535 -;;;;;; 267192 607000)) +;;;### (autoloads nil "decipher" "play/decipher.el" (0 0 0 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5900,10 +6632,11 @@ The most useful commands are: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "decipher" '("decipher-"))) + ;;;*** -;;;### (autoloads nil "delim-col" "delim-col.el" (22164 57534 71192 -;;;;;; 607000)) +;;;### (autoloads nil "delim-col" "delim-col.el" (0 0 0 0)) ;;; Generated autoloads from delim-col.el (push (purecopy '(delim-col 2 1)) package--builtin-versions) @@ -5926,16 +6659,19 @@ START and END delimits the corners of text rectangle. \(fn START END)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delim-col" '("delimit-columns-"))) + ;;;*** -;;;### (autoloads nil "delsel" "delsel.el" (22164 57534 79192 607000)) +;;;### (autoloads nil "delsel" "delsel.el" (0 0 0 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) (defvar delete-selection-mode nil "\ Non-nil if Delete-Selection mode is enabled. -See the command `delete-selection-mode' for a description of this minor mode. +See the `delete-selection-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `delete-selection-mode'.") @@ -5958,10 +6694,11 @@ information on adapting behavior of commands in Delete Selection mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit"))) + ;;;*** -;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (22164 57534 -;;;;;; 167192 607000)) +;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -5989,6 +6726,9 @@ BODY can start with a bunch of keyword arguments. The following keyword :abbrev-table TABLE Use TABLE instead of the default (CHILD-abbrev-table). A nil value means to simply use the same abbrev-table as the parent. +:after-hook FORM + A single lisp form which is evaluated after the mode hooks have been + run. It should not be quoted. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: @@ -6017,8 +6757,6 @@ See Info node `(elisp)Derived Modes' for more details. (function-put 'define-derived-mode 'doc-string-elt '4) -(function-put 'define-derived-mode 'lisp-indent-function '3) - (autoload 'derived-mode-init-mode-variables "derived" "\ Initialize variables for a new MODE. Right now, if they don't already exist, set up a blank keymap, an @@ -6027,10 +6765,11 @@ the first time the mode is used. \(fn MODE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "derived" '("derived-mode-"))) + ;;;*** -;;;### (autoloads nil "descr-text" "descr-text.el" (22174 6972 424792 -;;;;;; 520000)) +;;;### (autoloads nil "descr-text" "descr-text.el" (0 0 0 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6077,15 +6816,17 @@ This function is meant to be used as a value of \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "descr-text" '("describe-"))) + ;;;*** -;;;### (autoloads nil "desktop" "desktop.el" (22195 13277 895727 -;;;;;; 967000)) +;;;### (autoloads nil "desktop" "desktop.el" (0 0 0 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ Non-nil if Desktop-Save mode is enabled. -See the command `desktop-save-mode' for a description of this minor mode. +See the `desktop-save-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `desktop-save-mode'.") @@ -6115,7 +6856,7 @@ For further details, see info node `(emacs)Saving Emacs Sessions'. \(fn &optional ARG)" t nil) -(defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\ +(defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\ List of local variables to save for each buffer. The variables are saved only when they really are local. Conventional minor modes are restored automatically; they should not be listed here.") @@ -6305,10 +7046,11 @@ Revert to the last loaded desktop. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "desktop" '("desktop-"))) + ;;;*** -;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (22164 57534 -;;;;;; 447192 607000)) +;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (0 0 0 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6338,10 +7080,19 @@ Deuglify broken Outlook (Express) articles and redisplay. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "deuglify" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "dframe" "dframe.el" (0 0 0 0)) +;;; Generated autoloads from dframe.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dframe" '("dframe-"))) + ;;;*** -;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (22195 -;;;;;; 13277 891727 967000)) +;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6381,9 +7132,11 @@ Major mode for editing the diary file. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diary-lib" '("diary-" "calendar-mark-"))) + ;;;*** -;;;### (autoloads nil "diff" "vc/diff.el" (22164 57535 851192 607000)) +;;;### (autoloads nil "diff" "vc/diff.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-u") "\ @@ -6429,10 +7182,11 @@ This requires the external program `diff' to be in your `exec-path'. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff" '("diff-"))) + ;;;*** -;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (22164 57535 -;;;;;; 851192 607000)) +;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6462,9 +7216,11 @@ the mode if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff-mode" '("diff-"))) + ;;;*** -;;;### (autoloads nil "dig" "net/dig.el" (22164 57534 919192 607000)) +;;;### (autoloads nil "dig" "net/dig.el" (0 0 0 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6473,9 +7229,11 @@ Optional arguments are passed to `dig-invoke'. \(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dig" '("query-dig" "dig-"))) + ;;;*** -;;;### (autoloads nil "dired" "dired.el" (22174 6972 440792 520000)) +;;;### (autoloads nil "dired" "dired.el" (0 0 0 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6599,10 +7357,27 @@ Keybindings: \(fn &optional DIRNAME SWITCHES)" nil nil) (put 'dired-find-alternate-file 'disabled t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired" '("dired-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "dired-aux" "dired-aux.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from dired-aux.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "dired-x" "dired-x.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from dired-x.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-x" '("dired-" "virtual-dired"))) + ;;;*** -;;;### (autoloads nil "dirtrack" "dirtrack.el" (22164 57534 103192 -;;;;;; 607000)) +;;;### (autoloads nil "dirtrack" "dirtrack.el" (0 0 0 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6630,10 +7405,11 @@ from `default-directory'. \(fn INPUT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dirtrack" '("dirtrack-"))) + ;;;*** -;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (22164 57534 -;;;;;; 167192 607000)) +;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6645,10 +7421,11 @@ redefine OBJECT if it is a symbol. \(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disass" '("disassemble-"))) + ;;;*** -;;;### (autoloads nil "disp-table" "disp-table.el" (22164 57534 103192 -;;;;;; 607000)) +;;;### (autoloads nil "disp-table" "disp-table.el" (0 0 0 0)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6767,10 +7544,11 @@ in `.emacs'. \(fn ARG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disp-table" '("display-table-print-array"))) + ;;;*** -;;;### (autoloads nil "dissociate" "play/dissociate.el" (22164 57535 -;;;;;; 267192 607000)) +;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6786,7 +7564,7 @@ Default is 2. ;;;*** -;;;### (autoloads nil "dnd" "dnd.el" (22164 57534 103192 607000)) +;;;### (autoloads nil "dnd" "dnd.el" (0 0 0 0)) ;;; Generated autoloads from dnd.el (defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\ @@ -6804,10 +7582,18 @@ if some action was made, or nil if the URL is ignored.") (custom-autoload 'dnd-protocol-alist "dnd" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dnd" '("dnd-"))) + ;;;*** -;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (22164 57535 -;;;;;; 799192 607000)) +;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0)) +;;; Generated autoloads from net/dns.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns" '("dns-"))) + +;;;*** + +;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6828,10 +7614,11 @@ Locate SOA record and increment the serial field. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns-mode" '("dns-mode-"))) + ;;;*** -;;;### (autoloads nil "doc-view" "doc-view.el" (22220 16330 635423 -;;;;;; 271000)) +;;;### (autoloads nil "doc-view" "doc-view.el" (0 0 0 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6875,10 +7662,11 @@ See the command `doc-view-mode' for more information on this mode. \(fn BMK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doc-view" '("doc-view-"))) + ;;;*** -;;;### (autoloads nil "doctor" "play/doctor.el" (22164 57535 267192 -;;;;;; 607000)) +;;;### (autoloads nil "doctor" "play/doctor.el" (0 0 0 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6886,9 +7674,39 @@ Switch to *doctor* buffer and start giving psychotherapy. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doctor" '("doc" "make-doctor-variables"))) + +;;;*** + +;;;### (autoloads nil "dom" "dom.el" (0 0 0 0)) +;;; Generated autoloads from dom.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dom" '("dom-"))) + ;;;*** -;;;### (autoloads nil "double" "double.el" (22164 57534 107192 607000)) +;;;### (autoloads nil "dos-fns" "dos-fns.el" (0 0 0 0)) +;;; Generated autoloads from dos-fns.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-fns" '("dos"))) + +;;;*** + +;;;### (autoloads nil "dos-vars" "dos-vars.el" (0 0 0 0)) +;;; Generated autoloads from dos-vars.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells"))) + +;;;*** + +;;;### (autoloads nil "dos-w32" "dos-w32.el" (0 0 0 0)) +;;; Generated autoloads from dos-w32.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-w32" '("w32-" "file-name-buffer-file-type-alist" "find-"))) + +;;;*** + +;;;### (autoloads nil "double" "double.el" (0 0 0 0)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6902,10 +7720,11 @@ strings when pressed twice. See `double-map' for details. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "double" '("double-"))) + ;;;*** -;;;### (autoloads nil "dunnet" "play/dunnet.el" (22164 57535 295192 -;;;;;; 607000)) +;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0)) ;;; Generated autoloads from play/dunnet.el (push (purecopy '(dunnet 2 2)) package--builtin-versions) @@ -6914,10 +7733,20 @@ Switch to *dungeon* buffer and start game. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dunnet" '("down" "dun" "out" "obj-special" "south" "north" "west" "east"))) + +;;;*** + +;;;### (autoloads nil "dynamic-setting" "dynamic-setting.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from dynamic-setting.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font"))) + ;;;*** -;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (22211 -;;;;;; 1352 168084 927000)) +;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6946,9 +7775,10 @@ Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), or an expression that returns either a keymap or a list of - arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP - argument that is not a symbol, this macro defines the variable - MODE-map and gives it the value that KEYMAP specifies. + (KEY . BINDING) pairs where KEY and BINDING are suitable for + `define-key'. If you supply a KEYMAP argument that is not a + symbol, this macro defines the variable MODE-map and gives it + the value that KEYMAP specifies. BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. @@ -7057,10 +7887,12 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). \(fn ST CSS DOC &rest ARGS)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easy-mmode" '("easy-mmode-"))) + ;;;*** -;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (22164 -;;;;;; 57534 175192 607000)) +;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7196,10 +8028,60 @@ To implement dynamic menus, either call this from \(fn PATH NAME ITEMS &optional BEFORE MAP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easymenu" '("easy-menu-" "add-submenu"))) + +;;;*** + +;;;### (autoloads nil "ebnf-abn" "progmodes/ebnf-abn.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-abn.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-abn" '("ebnf-abn-"))) + +;;;*** + +;;;### (autoloads nil "ebnf-bnf" "progmodes/ebnf-bnf.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-bnf.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-bnf" '("ebnf-"))) + +;;;*** + +;;;### (autoloads nil "ebnf-dtd" "progmodes/ebnf-dtd.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-dtd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-"))) + +;;;*** + +;;;### (autoloads nil "ebnf-ebx" "progmodes/ebnf-ebx.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-ebx.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-"))) + +;;;*** + +;;;### (autoloads nil "ebnf-iso" "progmodes/ebnf-iso.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-iso.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-iso" '("ebnf-"))) + +;;;*** + +;;;### (autoloads nil "ebnf-otz" "progmodes/ebnf-otz.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-otz.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-otz" '("ebnf-"))) + ;;;*** -;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (22164 57535 -;;;;;; 443192 607000)) +;;;### (autoloads nil "ebnf-yac" "progmodes/ebnf-yac.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/ebnf-yac.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-yac" '("ebnf-yac-"))) + +;;;*** + +;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (push (purecopy '(ebnf2ps 4 4)) package--builtin-versions) @@ -7462,10 +8344,11 @@ See `ebnf-style-database' documentation. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf2ps" '("ebnf-"))) + ;;;*** -;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (22164 57535 -;;;;;; 443192 607000)) +;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7611,10 +8494,11 @@ Display statistics for a class tree. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebrowse" '("electric-buffer-menu-mode-hook" "ebrowse-"))) + ;;;*** -;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (22164 57534 107192 -;;;;;; 607000)) +;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (0 0 0 0)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7639,15 +8523,17 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. \\[Buffer-menu-save] -- mark that buffer to be saved. \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. \\[Buffer-menu-unmark] -- remove all kinds of marks from current line. +\\[Buffer-menu-unmark-all] -- remove all kinds of marks from all lines. \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. \\[Buffer-menu-backup-unmark] -- back up a line and remove marks. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebuff-menu" '("electric-buffer-" "Electric-buffer-menu-"))) + ;;;*** -;;;### (autoloads nil "echistory" "echistory.el" (22164 57534 107192 -;;;;;; 607000)) +;;;### (autoloads nil "echistory" "echistory.el" (0 0 0 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7656,10 +8542,11 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. \(fn &optional NOCONFIRM)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "echistory" '("Electric-history-" "electric-"))) + ;;;*** -;;;### (autoloads nil "ecomplete" "ecomplete.el" (22221 37189 868505 -;;;;;; 663000)) +;;;### (autoloads nil "ecomplete" "ecomplete.el" (0 0 0 0)) ;;; Generated autoloads from ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7667,15 +8554,18 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ecomplete" '("ecomplete-"))) + ;;;*** -;;;### (autoloads nil "ede" "cedet/ede.el" (22195 13277 895727 967000)) +;;;### (autoloads nil "ede" "cedet/ede.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede.el (push (purecopy '(ede 1 2)) package--builtin-versions) (defvar global-ede-mode nil "\ Non-nil if Global Ede mode is enabled. -See the command `global-ede-mode' for a description of this minor mode. +See the `global-ede-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-ede-mode'.") @@ -7693,10 +8583,284 @@ an EDE controlled project. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede" '("project-try-ede" "ede" "global-ede-mode-map"))) + +;;;*** + +;;;### (autoloads nil "ede/auto" "cedet/ede/auto.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/auto.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/auto" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/autoconf-edit" "cedet/ede/autoconf-edit.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/autoconf-edit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/autoconf-edit" '("autoconf-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/base" "cedet/ede/base.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/base.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/base" '("ede-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/config" "cedet/ede/config.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/config.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/config" '("ede-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/cpp-root" +;;;;;; "cedet/ede/cpp-root.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/cpp-root.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/cpp-root" '("ede-c"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/custom" "cedet/ede/custom.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/custom.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/custom" '("eieio-ede-old-variables" "ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/detect" "cedet/ede/detect.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/detect.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/detect" '("ede-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/dired" "cedet/ede/dired.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/dired.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/dired" '("ede-dired-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/emacs" "cedet/ede/emacs.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/emacs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/emacs" '("ede-emacs-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/files" "cedet/ede/files.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/files.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/files" '("ede-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/generic" +;;;;;; "cedet/ede/generic.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/generic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/generic" '("ede-generic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/linux" "cedet/ede/linux.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/linux.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/locate" "cedet/ede/locate.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/locate.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/locate" '("ede-locate-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/make" "cedet/ede/make.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/make.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/make" '("ede-make-"))) + +;;;*** + +;;;### (autoloads nil "ede/makefile-edit" "cedet/ede/makefile-edit.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/makefile-edit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/makefile-edit" '("makefile-"))) + +;;;*** + +;;;### (autoloads nil "ede/pconf" "cedet/ede/pconf.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/pconf.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query"))) + +;;;*** + +;;;### (autoloads nil "ede/pmake" "cedet/ede/pmake.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/pmake.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pmake" '("ede-pmake-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj" "cedet/ede/proj.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/proj.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj" '("ede-proj-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-archive" "cedet/ede/proj-archive.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-archive.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-archive" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-aux" "cedet/ede/proj-aux.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/ede/proj-aux.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-aux" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-comp" "cedet/ede/proj-comp.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-comp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-comp" '("proj-comp-insert-variable-once" "ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-elisp" "cedet/ede/proj-elisp.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-elisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-elisp" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-info" "cedet/ede/proj-info.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-info.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-info" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-misc" "cedet/ede/proj-misc.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-misc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-misc" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-obj" "cedet/ede/proj-obj.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/ede/proj-obj.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-obj" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-prog" "cedet/ede/proj-prog.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-prog.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-scheme" "cedet/ede/proj-scheme.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-scheme.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme"))) + +;;;*** + +;;;### (autoloads nil "ede/proj-shared" "cedet/ede/proj-shared.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/proj-shared.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-shared" '("ede-"))) + +;;;*** + +;;;### (autoloads nil "ede/project-am" "cedet/ede/project-am.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/project-am.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/project-am" '("project-am-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/shell" "cedet/ede/shell.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/shell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/shell" '("ede-shell-run-command"))) + +;;;*** + +;;;### (autoloads nil "ede/simple" "cedet/ede/simple.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/simple.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/simple" '("ede-simple-"))) + +;;;*** + +;;;### (autoloads nil "ede/source" "cedet/ede/source.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/source.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/source" '("ede-source"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/speedbar" +;;;;;; "cedet/ede/speedbar.el" (0 0 0 0)) +;;; Generated autoloads from cedet/ede/speedbar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/speedbar" '("ede-"))) + ;;;*** -;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (22195 13277 -;;;;;; 947727 967000)) +;;;### (autoloads nil "ede/srecode" "cedet/ede/srecode.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cedet/ede/srecode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/srecode" '("ede-srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ede/util" "cedet/ede/util.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/ede/util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/util" '("ede-make-buffer-writable"))) + +;;;*** + +;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7758,9 +8922,11 @@ Toggle edebugging of all forms. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edebug" '("edebug" "get-edebug-spec" "global-edebug-" "cancel-edebug-on-entry"))) + ;;;*** -;;;### (autoloads nil "ediff" "vc/ediff.el" (22220 16330 915423 271000)) +;;;### (autoloads nil "ediff" "vc/ediff.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff.el (push (purecopy '(ediff 2 81 4)) package--builtin-versions) @@ -8030,10 +9196,18 @@ With optional NODE, goes to that node. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff" '("ediff-"))) + ;;;*** -;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (22164 57535 -;;;;;; 851192 607000)) +;;;### (autoloads nil "ediff-diff" "vc/ediff-diff.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-diff.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-diff" '("ediff-"))) + +;;;*** + +;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -8041,10 +9215,25 @@ With optional NODE, goes to that node. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-help" '("ediff-"))) + +;;;*** + +;;;### (autoloads nil "ediff-init" "vc/ediff-init.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-init.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap"))) + +;;;*** + +;;;### (autoloads nil "ediff-merg" "vc/ediff-merg.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-merg.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-merg" '("ediff-"))) + ;;;*** -;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (22195 13278 -;;;;;; 467727 967000)) +;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -8054,10 +9243,18 @@ Display Ediff's registry. (defalias 'eregistry 'ediff-show-registry) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-mult" '("ediff-"))) + +;;;*** + +;;;### (autoloads nil "ediff-ptch" "vc/ediff-ptch.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-ptch.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-ptch" '("ediff-"))) + ;;;*** -;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (22220 16330 -;;;;;; 911423 271000)) +;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -8074,10 +9271,25 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-util" '("ediff-"))) + +;;;*** + +;;;### (autoloads nil "ediff-vers" "vc/ediff-vers.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-vers.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision"))) + +;;;*** + +;;;### (autoloads nil "ediff-wind" "vc/ediff-wind.el" (0 0 0 0)) +;;; Generated autoloads from vc/ediff-wind.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-wind" '("ediff-"))) + ;;;*** -;;;### (autoloads nil "edmacro" "edmacro.el" (22164 57534 107192 -;;;;;; 607000)) +;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0)) ;;; Generated autoloads from edmacro.el (push (purecopy '(edmacro 2 1)) package--builtin-versions) @@ -8124,10 +9336,11 @@ or nil, use a compact 80-column format. \(fn &optional MACRO VERBOSE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edmacro" '("edmacro-"))) + ;;;*** -;;;### (autoloads nil "edt" "emulation/edt.el" (22211 1352 172084 -;;;;;; 927000)) +;;;### (autoloads nil "edt" "emulation/edt.el" (0 0 0 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8142,9 +9355,42 @@ Turn on EDT Emulation. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt" '("edt-"))) + +;;;*** + +;;;### (autoloads nil "edt-lk201" "emulation/edt-lk201.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emulation/edt-lk201.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-lk201" '("*EDT-keys*"))) + +;;;*** + +;;;### (autoloads nil "edt-mapper" "emulation/edt-mapper.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/edt-mapper.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-mapper" '("edt-"))) + ;;;*** -;;;### (autoloads nil "ehelp" "ehelp.el" (22164 57534 111192 607000)) +;;;### (autoloads nil "edt-pc" "emulation/edt-pc.el" (0 0 0 0)) +;;; Generated autoloads from emulation/edt-pc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-pc" '("*EDT-keys*"))) + +;;;*** + +;;;### (autoloads nil "edt-vt100" "emulation/edt-vt100.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emulation/edt-vt100.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))) + +;;;*** + +;;;### (autoloads nil "ehelp" "ehelp.el" (0 0 0 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8178,17 +9424,36 @@ BUFFER is put back into its original major mode. \(fn FUN &optional NAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ehelp" '("electric-" "ehelp-"))) + ;;;*** -;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (22164 57534 -;;;;;; 179192 607000)) +;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eieio.el (push (purecopy '(eieio 1 4)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio" '("eieio-" "oref" "oset" "obj" "find-class" "set-slot-value" "same-class-p" "slot-" "child-of-class-p" "with-slots" "defclass"))) + ;;;*** -;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (22164 -;;;;;; 57534 179192 607000)) +;;;### (autoloads nil "eieio-base" "emacs-lisp/eieio-base.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-base.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-base" '("eieio-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "eieio-compat" +;;;;;; "emacs-lisp/eieio-compat.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-compat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-compat" '("no-" "next-method-p" "generic-p" "eieio--generic-static-symbol-specializers"))) + +;;;*** + +;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/eieio-core.el (push (purecopy '(eieio-core 1 4)) package--builtin-versions) @@ -8202,10 +9467,43 @@ It creates an autoload function for CNAME's constructor. \(fn CNAME SUPERCLASSES FILENAME DOC)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-core" '("eieio-" "invalid-slot-" "inconsistent-class-hierarchy" "unbound-slot" "class-"))) + ;;;*** -;;;### (autoloads nil "elec-pair" "elec-pair.el" (22164 57534 111192 -;;;;;; 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "eieio-custom" +;;;;;; "emacs-lisp/eieio-custom.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-custom.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-custom" '("eieio-"))) + +;;;*** + +;;;### (autoloads nil "eieio-datadebug" "emacs-lisp/eieio-datadebug.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-datadebug.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "eieio-opt" "emacs-lisp/eieio-opt.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-opt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-opt" '("eieio-"))) + +;;;*** + +;;;### (autoloads nil "eieio-speedbar" "emacs-lisp/eieio-speedbar.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/eieio-speedbar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-speedbar" '("eieio-speedbar"))) + +;;;*** + +;;;### (autoloads nil "elec-pair" "elec-pair.el" (0 0 0 0)) ;;; Generated autoloads from elec-pair.el (defvar electric-pair-text-pairs '((34 . 34)) "\ @@ -8219,7 +9517,8 @@ defined in `electric-pair-text-syntax-table'") (defvar electric-pair-mode nil "\ Non-nil if Electric-Pair mode is enabled. -See the command `electric-pair-mode' for a description of this minor mode. +See the `electric-pair-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `electric-pair-mode'.") @@ -8244,10 +9543,11 @@ Toggle `electric-pair-mode' only in this buffer. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-"))) + ;;;*** -;;;### (autoloads nil "elide-head" "elide-head.el" (22164 57534 111192 -;;;;;; 607000)) +;;;### (autoloads nil "elide-head" "elide-head.el" (0 0 0 0)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8260,10 +9560,11 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elide-head" '("elide-head-"))) + ;;;*** -;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (22164 57534 -;;;;;; 179192 607000)) +;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8296,10 +9597,11 @@ optional prefix argument REINIT is non-nil. \(fn &optional REINIT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elint" '("elint-"))) + ;;;*** -;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (22164 57534 183192 -;;;;;; 607000)) +;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8331,10 +9633,147 @@ displayed. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elp" '("elp-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-alias" "eshell/em-alias.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-alias.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-banner" "eshell/em-banner.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-banner.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-banner" '("eshell-banner-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-basic" "eshell/em-basic.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-basic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-basic" '("eshell"))) + ;;;*** -;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (22164 57534 215192 -;;;;;; 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "em-cmpl" "eshell/em-cmpl.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-cmpl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-cmpl" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-dirs" "eshell/em-dirs.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-dirs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-dirs" '("eshell"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-glob" "eshell/em-glob.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-glob.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-glob" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-hist" "eshell/em-hist.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-hist.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-hist" '("eshell"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-ls" "eshell/em-ls.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-ls.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-ls" '("eshell"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-pred" "eshell/em-pred.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-pred.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-pred" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-prompt" "eshell/em-prompt.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-prompt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-prompt" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-rebind" "eshell/em-rebind.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-rebind.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-rebind" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-script" "eshell/em-script.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-script.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-script" '("eshell"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-smart" "eshell/em-smart.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-smart.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-smart" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-term" "eshell/em-term.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-term.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-term" '("eshell-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-tramp" "eshell/em-tramp.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-tramp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-tramp" '("eshell"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-unix" "eshell/em-unix.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-unix.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-unix" '("eshell" "nil-blank-string" "pcomplete/"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "em-xtra" "eshell/em-xtra.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from eshell/em-xtra.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-xtra" '("pcomplete/bcc" "eshell/"))) + +;;;*** + +;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8359,10 +9798,11 @@ Other values are interpreted as usual. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("toggle-emacs-lock" "emacs-lock-"))) + ;;;*** -;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (22164 57534 -;;;;;; 803192 607000)) +;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (0 0 0 0)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8373,10 +9813,11 @@ Prompts for bug subject. Leaves you in a mail buffer. (set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacsbug" '("report-emacs-bug-"))) + ;;;*** -;;;### (autoloads nil "emerge" "vc/emerge.el" (21953 58033 507058 -;;;;;; 929000)) +;;;### (autoloads nil "emerge" "vc/emerge.el" (0 0 0 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8434,10 +9875,11 @@ Emerge two RCS revisions of a file, with another revision as ancestor. \(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emerge" '("emerge-"))) + ;;;*** -;;;### (autoloads nil "enriched" "textmodes/enriched.el" (22164 57535 -;;;;;; 799192 607000)) +;;;### (autoloads nil "enriched" "textmodes/enriched.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8470,9 +9912,11 @@ Commands: \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "enriched" '("enriched-"))) + ;;;*** -;;;### (autoloads nil "epa" "epa.el" (22164 57534 243192 607000)) +;;;### (autoloads nil "epa" "epa.el" (0 0 0 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8658,10 +10102,11 @@ Insert selected KEYS after the point. \(fn KEYS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa" '("epa-"))) + ;;;*** -;;;### (autoloads nil "epa-dired" "epa-dired.el" (22164 57534 239192 -;;;;;; 607000)) +;;;### (autoloads nil "epa-dired" "epa-dired.el" (0 0 0 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8686,8 +10131,7 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-file" "epa-file.el" (22164 57534 239192 -;;;;;; 607000)) +;;;### (autoloads nil "epa-file" "epa-file.el" (0 0 0 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8705,10 +10149,11 @@ Encrypt marked files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-file" '("epa-"))) + ;;;*** -;;;### (autoloads nil "epa-mail" "epa-mail.el" (22164 57534 243192 -;;;;;; 607000)) +;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8768,7 +10213,8 @@ The buffer is expected to contain a mail message. (defvar epa-global-mail-mode nil "\ Non-nil if Epa-Global-Mail mode is enabled. -See the command `epa-global-mail-mode' for a description of this minor mode. +See the `epa-global-mail-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `epa-global-mail-mode'.") @@ -8783,9 +10229,11 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-mail" '("epa-mail-"))) + ;;;*** -;;;### (autoloads nil "epg" "epg.el" (22220 16330 703423 271000)) +;;;### (autoloads nil "epg" "epg.el" (0 0 0 0)) ;;; Generated autoloads from epg.el (push (purecopy '(epg 1 0 0)) package--builtin-versions) @@ -8794,23 +10242,25 @@ Return a context object. \(fn &optional PROTOCOL ARMOR TEXTMODE INCLUDE-CERTS CIPHER-ALGORITHM DIGEST-ALGORITHM COMPRESS-ALGORITHM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg" '("epg-"))) + ;;;*** -;;;### (autoloads nil "epg-config" "epg-config.el" (22220 16330 671423 -;;;;;; 271000)) +;;;### (autoloads nil "epg-config" "epg-config.el" (0 0 0 0)) ;;; Generated autoloads from epg-config.el (autoload 'epg-find-configuration "epg-config" "\ Find or create a usable configuration to handle PROTOCOL. This function first looks at the existing configuration found by -the previous invocation of this function, unless FORCE is non-nil. +the previous invocation of this function, unless NO-CACHE is non-nil. -Then it walks through `epg-config--program-alist'. If -`epg-gpg-program' or `epg-gpgsm-program' is already set with -custom, use it. Otherwise, it tries the programs listed in the -entry until the version requirement is met. +Then it walks through PROGRAM-ALIST or +`epg-config--program-alist'. If `epg-gpg-program' or +`epg-gpgsm-program' is already set with custom, use it. +Otherwise, it tries the programs listed in the entry until the +version requirement is met. -\(fn PROTOCOL &optional FORCE)" nil nil) +\(fn PROTOCOL &optional NO-CACHE PROGRAM-ALIST)" nil nil) (autoload 'epg-configuration "epg-config" "\ Return a list of internal configuration parameters of `epg-gpg-program'. @@ -8829,9 +10279,11 @@ Look at CONFIG and try to expand GROUP. \(fn CONFIG GROUP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg-config" '("epg-"))) + ;;;*** -;;;### (autoloads nil "erc" "erc/erc.el" (22203 7237 350647 107000)) +;;;### (autoloads nil "erc" "erc/erc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 3)) package--builtin-versions) @@ -8878,38 +10330,51 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. \(fn HOST PORT CHANNEL USER PASSWORD)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc" '("erc-" "define-erc-module"))) + ;;;*** -;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (22164 -;;;;;; 57534 255192 607000)) +;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-autoaway" '("erc-auto" "autoaway"))) + +;;;*** + +;;;### (autoloads nil "erc-backend" "erc/erc-backend.el" (0 0 0 0)) +;;; Generated autoloads from erc/erc-backend.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-backend" '("erc-"))) + ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (22195 13277 -;;;;;; 979727 967000)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-button" '("erc-" "button"))) + ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (22164 57534 -;;;;;; 255192 607000)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-capab" '("erc-capab-identify-" "capab-identify"))) + ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (22164 57534 -;;;;;; 255192 607000)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-compat" '("erc-"))) + ;;;*** -;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (22164 57534 255192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8936,17 +10401,21 @@ that subcommand. \(fn PROC NICK LOGIN HOST TO QUERY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/" "dcc"))) + ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (22164 57534 255192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-desktop-notifications" '("notifications" "erc-notifications-"))) + ;;;*** -;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (22164 -;;;;;; 57534 255192 607000)) +;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -9006,10 +10475,11 @@ Add EZBouncer convenience functions to ERC. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ezbounce" '("erc-ezb-"))) + ;;;*** -;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (22164 57534 255192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -9019,10 +10489,25 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-fill" '("erc-"))) + +;;;*** + +;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0)) +;;; Generated autoloads from erc/erc-goodies.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-goodies" '("erc-" "unmorse" "scrolltobottom" "smiley" "irccontrols" "noncommands" "keep-place" "move-to-prompt" "readonly"))) + +;;;*** + +;;;### (autoloads nil "erc-ibuffer" "erc/erc-ibuffer.el" (0 0 0 0)) +;;; Generated autoloads from erc/erc-ibuffer.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ibuffer" '("erc-"))) + ;;;*** -;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (22164 57534 -;;;;;; 255192 607000)) +;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -9041,10 +10526,11 @@ system. \(fn &rest IGNORE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-identd" '("erc-identd-" "identd"))) + ;;;*** -;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (22164 57534 -;;;;;; 259192 607000)) +;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -9052,24 +10538,34 @@ system. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-imenu" '("erc-unfill-notice"))) + ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (22164 57534 259192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-join" '("erc-" "autojoin"))) + +;;;*** + +;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (0 0 0 0)) +;;; Generated autoloads from erc/erc-lang.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "language" "iso-638-languages"))) + ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (22164 57534 259192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-list" '("erc-" "list"))) + ;;;*** -;;;### (autoloads nil "erc-log" "erc/erc-log.el" (22164 57534 259192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-log" "erc/erc-log.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -9096,10 +10592,11 @@ You can save every individual message by putting this function on \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-log" '("erc-" "log"))) + ;;;*** -;;;### (autoloads nil "erc-match" "erc/erc-match.el" (22164 57534 -;;;;;; 259192 607000)) +;;;### (autoloads nil "erc-match" "erc/erc-match.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -9143,17 +10640,20 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-match" '("erc-" "match"))) + ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (22164 57534 259192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-menu" '("erc-menu-" "menu"))) + ;;;*** -;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (22164 -;;;;;; 57534 259192 607000)) +;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9162,10 +10662,12 @@ Show who's gone. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-netsplit" '("erc-" "netsplit"))) + ;;;*** -;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (22195 -;;;;;; 13277 983727 967000)) +;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -9180,10 +10682,11 @@ Interactively select a server to connect to using `erc-server-alist'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-networks" '("erc-" "networks"))) + ;;;*** -;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (22164 57534 -;;;;;; 263192 607000)) +;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9199,38 +10702,45 @@ with args, toggle notify status of people. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-notify" '("erc-" "notify"))) + ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (22164 57534 263192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-page" '("erc-" "page"))) + ;;;*** -;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (22195 -;;;;;; 13277 983727 967000)) +;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-pcomplete" '("pcomplete" "erc-pcomplet"))) + ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (22164 57534 -;;;;;; 263192 607000)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-replace" '("replace" "erc-replace-"))) + ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (22164 57534 263192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ring" '("erc-" "ring"))) + ;;;*** -;;;### (autoloads nil "erc-services" "erc/erc-services.el" (22164 -;;;;;; 57534 263192 607000)) +;;;### (autoloads nil "erc-services" "erc/erc-services.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -9245,17 +10755,20 @@ When called interactively, read the password using `read-passwd'. \(fn PASSWORD)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-services" '("erc-" "services"))) + ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (22164 57534 -;;;;;; 263192 607000)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-sound" '("erc-" "sound"))) + ;;;*** -;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (22164 -;;;;;; 57534 267192 607000)) +;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -9264,29 +10777,34 @@ This will add a speedbar major display mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-speedbar" '("erc-"))) + ;;;*** -;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (22164 -;;;;;; 57534 271192 607000)) +;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-spelling" '("erc-spelling-" "spelling"))) + ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (22164 57534 -;;;;;; 271192 607000)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-stamp" '("erc-" "stamp"))) + ;;;*** -;;;### (autoloads nil "erc-track" "erc/erc-track.el" (22195 13277 -;;;;;; 983727 967000)) +;;;### (autoloads nil "erc-track" "erc/erc-track.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ Non-nil if Erc-Track minor mode is enabled. -See the command `erc-track-minor-mode' for a description of this minor mode.") +See the `erc-track-minor-mode' command +for a description of this minor mode.") (custom-autoload 'erc-track-minor-mode "erc-track" nil) @@ -9304,10 +10822,12 @@ keybindings will not do anything useful. \(fn &optional ARG)" t nil) (autoload 'erc-track-mode "erc-track" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-track" '("erc-" "track"))) + ;;;*** -;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (22164 -;;;;;; 57534 275192 607000)) +;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -9324,10 +10844,11 @@ Meant to be used in hooks, like `erc-insert-post-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-truncate" '("truncate" "erc-max-buffer-size"))) + ;;;*** -;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (22164 57534 275192 -;;;;;; 607000)) +;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -9336,10 +10857,11 @@ Add a file to `erc-xdcc-files'. \(fn FILE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-xdcc" '("erc-" "xdcc"))) + ;;;*** -;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (22189 60738 153741 -;;;;;; 19000)) +;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9406,10 +10928,11 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). \(fn TEST-OR-TEST-NAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert" '("ert-"))) + ;;;*** -;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (22220 16330 -;;;;;; 639423 271000)) +;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9419,10 +10942,39 @@ Kill all test buffers that are still live. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert-x" '("ert-"))) + +;;;*** + +;;;### (autoloads nil "esh-arg" "eshell/esh-arg.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-arg.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-arg" '("eshell-"))) + ;;;*** -;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (22220 16330 -;;;;;; 707423 271000)) +;;;### (autoloads nil "esh-cmd" "eshell/esh-cmd.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-cmd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug"))) + +;;;*** + +;;;### (autoloads nil "esh-ext" "eshell/esh-ext.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-ext.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-ext" '("eshell"))) + +;;;*** + +;;;### (autoloads nil "esh-io" "eshell/esh-io.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-io.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-io" '("eshell-"))) + +;;;*** + +;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (0 0 0 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9430,10 +10982,47 @@ Emacs shell interactive mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-mode" '("eshell"))) + +;;;*** + +;;;### (autoloads nil "esh-module" "eshell/esh-module.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from eshell/esh-module.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-module" '("eshell-"))) + +;;;*** + +;;;### (autoloads nil "esh-opt" "eshell/esh-opt.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-opt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-opt" '("eshell-"))) + +;;;*** + +;;;### (autoloads nil "esh-proc" "eshell/esh-proc.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-proc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-proc" '("eshell"))) + +;;;*** + +;;;### (autoloads nil "esh-util" "eshell/esh-util.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-util" '("eshell-"))) + ;;;*** -;;;### (autoloads nil "eshell" "eshell/eshell.el" (22220 16330 707423 -;;;;;; 271000)) +;;;### (autoloads nil "esh-var" "eshell/esh-var.el" (0 0 0 0)) +;;; Generated autoloads from eshell/esh-var.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/"))) + +;;;*** + +;;;### (autoloads nil "eshell" "eshell/eshell.el" (0 0 0 0)) ;;; Generated autoloads from eshell/eshell.el (push (purecopy '(eshell 2 4 2)) package--builtin-versions) @@ -9466,10 +11055,11 @@ corresponding to a successful execution. (define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eshell" '("eshell-"))) + ;;;*** -;;;### (autoloads nil "etags" "progmodes/etags.el" (22189 60739 125741 -;;;;;; 19000)) +;;;### (autoloads nil "etags" "progmodes/etags.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9737,8 +11327,6 @@ Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. -Fifth and sixth arguments START and END are accepted, for compatibility -with `query-replace-regexp', and ignored. If FILE-LIST-FORM is non-nil, it is a form to evaluate to produce the list of files to search. @@ -9782,10 +11370,12 @@ for \\[find-tag] (which see). \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("xref-" "etags-" "snarf-tag-function" "select-tags-table-" "tag" "file-of-tag" "find-tag-" "list-tags-function" "last-tag" "initialize-new-tags-table" "verify-tags-table-function" "goto-tag-location-function" "next-file-list" "default-tags-table-function"))) + ;;;*** -;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (22164 -;;;;;; 57534 767192 607000)) +;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9951,9 +11541,11 @@ With ARG, insert that many delimiters. \(fn POS TO FONT-OBJECT STRING)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ethio-util" '("exit-ethiopic-environment" "ethio-"))) + ;;;*** -;;;### (autoloads nil "eudc" "net/eudc.el" (22164 57534 923192 607000)) +;;;### (autoloads nil "eudc" "net/eudc.el" (0 0 0 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -10003,12 +11595,13 @@ This does nothing except loading eudc by autoload side-effect. \(fn)" t nil) -(cond ((not (featurep 'xemacs)) (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Search"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) (t (let ((menu '("Directory Search" ["Load Hotlist of Servers" eudc-load-eudc t] ["New Server" eudc-set-server t] ["---" nil nil] ["Query with Form" eudc-query-form t] ["Expand Inline Query" eudc-expand-inline t] ["---" nil nil] ["Get Email" eudc-get-email t] ["Get Phone" eudc-get-phone t]))) (if (not (featurep 'eudc-autoloads)) (if (featurep 'xemacs) (if (and (featurep 'menubar) (not (featurep 'infodock))) (add-submenu '("Tools") menu)) (require 'easymenu) (cond ((fboundp 'easy-menu-add-item) (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) (cdr menu)))) ((fboundp 'easy-menu-create-keymaps) (define-key global-map [menu-bar tools eudc] (cons "Directory Search" (easy-menu-create-keymaps "Directory Search" (cdr menu))))))))))) +(cond ((not (featurep 'xemacs)) (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] `(menu-item ,(purecopy "Get Email") eudc-get-email :help ,(purecopy "Get the email field of NAME from the directory server"))) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] `(menu-item ,(purecopy "Query with Form") eudc-query-form :help ,(purecopy "Display a form to query the directory server"))) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] `(menu-item ,(purecopy "New Server") eudc-set-server :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) (t (let ((menu '("Directory Servers" ["Load Hotlist of Servers" eudc-load-eudc t] ["New Server" eudc-set-server t] ["---" nil nil] ["Query with Form" eudc-query-form t] ["Expand Inline Query" eudc-expand-inline t] ["---" nil nil] ["Get Email" eudc-get-email t] ["Get Phone" eudc-get-phone t]))) (if (not (featurep 'eudc-autoloads)) (if (featurep 'xemacs) (if (and (featurep 'menubar) (not (featurep 'infodock))) (add-submenu '("Tools") menu)) (require 'easymenu) (cond ((fboundp 'easy-menu-add-item) (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) (cdr menu)))) ((fboundp 'easy-menu-create-keymaps) (define-key global-map [menu-bar tools eudc] (cons "Directory Servers" (easy-menu-create-keymaps "Directory Servers" (cdr menu))))))))))) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc" '("eudc-"))) ;;;*** -;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (22164 57534 923192 -;;;;;; 607000)) +;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (0 0 0 0)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -10041,10 +11634,11 @@ Display a button for the JPEG DATA. \(fn DATA)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-bob" '("eudc-"))) + ;;;*** -;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (22164 57534 -;;;;;; 923192 607000)) +;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (0 0 0 0)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -10058,10 +11652,12 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-export" '("eudc-"))) + ;;;*** -;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (22164 -;;;;;; 57534 923192 607000)) +;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -10069,10 +11665,39 @@ Edit the hotlist of directory servers in a specialized buffer. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-"))) + +;;;*** + +;;;### (autoloads nil "eudc-vars" "net/eudc-vars.el" (0 0 0 0)) +;;; Generated autoloads from net/eudc-vars.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-vars" '("eudc-"))) + +;;;*** + +;;;### (autoloads nil "eudcb-bbdb" "net/eudcb-bbdb.el" (0 0 0 0)) +;;; Generated autoloads from net/eudcb-bbdb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))) + +;;;*** + +;;;### (autoloads nil "eudcb-ldap" "net/eudcb-ldap.el" (0 0 0 0)) +;;; Generated autoloads from net/eudcb-ldap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-ldap" '("eudc-"))) + ;;;*** -;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (22164 57534 183192 -;;;;;; 607000)) +;;;### (autoloads nil "eudcb-mab" "net/eudcb-mab.el" (0 0 0 0)) +;;; Generated autoloads from net/eudcb-mab.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-mab" '("eudc-"))) + +;;;*** + +;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -10096,9 +11721,11 @@ fourth arg NOSEP non-nil inhibits this. \(fn PRETTY-PRINTER &optional HEADER FOOTER NOSEP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ewoc" '("ewoc-"))) + ;;;*** -;;;### (autoloads nil "eww" "net/eww.el" t) +;;;### (autoloads nil "eww" "net/eww.el" (0 0 0 0)) ;;; Generated autoloads from net/eww.el (defvar eww-suggest-uris '(eww-links-at-point url-get-url-at-point eww-current-url) "\ @@ -10143,10 +11770,12 @@ Display the bookmarks. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eww" '("eww-"))) + ;;;*** -;;;### (autoloads nil "executable" "progmodes/executable.el" (22164 -;;;;;; 57535 451192 607000)) +;;;### (autoloads nil "executable" "progmodes/executable.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -10179,9 +11808,11 @@ file modes. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "executable" '("executable-"))) + ;;;*** -;;;### (autoloads nil "expand" "expand.el" (22164 57534 303192 607000)) +;;;### (autoloads nil "expand" "expand.el" (0 0 0 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10228,10 +11859,18 @@ This is used only in conjunction with `expand-add-abbrevs'. (define-key abbrev-map "p" 'expand-jump-to-previous-slot) (define-key abbrev-map "n" 'expand-jump-to-next-slot) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "expand" '("expand-"))) + +;;;*** + +;;;### (autoloads nil "ezimage" "ezimage.el" (0 0 0 0)) +;;; Generated autoloads from ezimage.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ezimage" '("ezimage-"))) + ;;;*** -;;;### (autoloads nil "f90" "progmodes/f90.el" (22164 57535 451192 -;;;;;; 607000)) +;;;### (autoloads nil "f90" "progmodes/f90.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10296,10 +11935,11 @@ with no args, if that value is non-nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "f90" '("f90-"))) + ;;;*** -;;;### (autoloads nil "face-remap" "face-remap.el" (22164 57534 303192 -;;;;;; 607000)) +;;;### (autoloads nil "face-remap" "face-remap.el" (0 0 0 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10456,10 +12096,11 @@ Besides the choice of face, it is the same as `buffer-face-mode'. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "face-remap" '("buffer-face-mode-" "text-scale-m" "face-" "internal-lisp-face-attributes"))) + ;;;*** -;;;### (autoloads nil "feedmail" "mail/feedmail.el" (22153 828 674851 -;;;;;; 262000)) +;;;### (autoloads nil "feedmail" "mail/feedmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/feedmail.el (push (purecopy '(feedmail 11)) package--builtin-versions) @@ -10511,9 +12152,11 @@ you can set `feedmail-queue-reminder-alist' to nil. \(fn &optional WHAT-EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "feedmail" '("feedmail-"))) + ;;;*** -;;;### (autoloads nil "ffap" "ffap.el" (22164 57534 311192 607000)) +;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10574,10 +12217,11 @@ Evaluate the forms in variable `ffap-bindings'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ffap" '("find-file-literally-at-point" "ffap-" "dired-at-point-"))) + ;;;*** -;;;### (autoloads nil "filecache" "filecache.el" (22164 57534 311192 -;;;;;; 607000)) +;;;### (autoloads nil "filecache" "filecache.el" (0 0 0 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10632,10 +12276,11 @@ the name is considered already unique; only the second substitution \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filecache" '("file-cache-"))) + ;;;*** -;;;### (autoloads nil "filenotify" "filenotify.el" (22220 16330 707423 -;;;;;; 271000)) +;;;### (autoloads nil "filenotify" "filenotify.el" (0 0 0 0)) ;;; Generated autoloads from filenotify.el (autoload 'file-notify-handle-event "filenotify" "\ @@ -10648,10 +12293,11 @@ Otherwise, signal a `file-notify-error'. \(fn EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filenotify" '("file-notify-"))) + ;;;*** -;;;### (autoloads nil "files-x" "files-x.el" (22189 60738 197741 -;;;;;; 19000)) +;;;### (autoloads nil "files-x" "files-x.el" (0 0 0 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10714,10 +12360,58 @@ Copy directory-local variables to the -*- line. \(fn)" t nil) +(defvar enable-connection-local-variables t "\ +Non-nil means enable use of connection-local variables.") + +(autoload 'connection-local-set-classes "files-x" "\ +Add CLASSES for remote servers. +CRITERIA is either a regular expression identifying a remote +server, or a function with one argument IDENTIFICATION, which +returns non-nil when a remote server shall apply CLASS'es +variables. If CRITERIA is nil, it always applies. +CLASSES are the names of a variable class (a symbol). + +When a connection to a remote server is opened and CRITERIA +matches to that server, the connection-local variables from CLASSES +are applied to the corresponding process buffer. The variables +for a class are defined using `connection-local-set-class-variables'. + +\(fn CRITERIA &rest CLASSES)" nil nil) + +(autoload 'connection-local-set-class-variables "files-x" "\ +Map the symbol CLASS to a list of variable settings. +VARIABLES is a list that declares connection-local variables for +the class. An element in VARIABLES is an alist whose elements +are of the form (VAR . VALUE). + +When a connection to a remote server is opened, the server's +classes are found. A server may be assigned a class using +`connection-local-set-class'. Then variables are set in the +server's process buffer according to the VARIABLES list of the +class. The list is processed in order. + +\(fn CLASS VARIABLES)" nil nil) + +(autoload 'hack-connection-local-variables-apply "files-x" "\ +Apply connection-local variables identified by `default-directory'. +Other local variables, like file-local and dir-local variables, +will not be changed. + +\(fn)" nil nil) + +(autoload 'with-connection-local-classes "files-x" "\ +Apply connection-local variables according to CLASSES in current buffer. +Execute BODY, and unwind connection local variables. + +\(fn CLASSES &rest BODY)" nil t) + +(function-put 'with-connection-local-classes 'lisp-indent-function '1) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("hack-connection-local-variables" "connection-local-" "modify-" "read-file-local-variable"))) + ;;;*** -;;;### (autoloads nil "filesets" "filesets.el" (22164 57534 315192 -;;;;;; 607000)) +;;;### (autoloads nil "filesets" "filesets.el" (0 0 0 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10726,10 +12420,11 @@ Set up hooks, load the cache file -- if existing -- and build the menu. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filesets" '("filesets-"))) + ;;;*** -;;;### (autoloads nil "find-cmd" "find-cmd.el" (22164 57534 315192 -;;;;;; 607000)) +;;;### (autoloads nil "find-cmd" "find-cmd.el" (0 0 0 0)) ;;; Generated autoloads from find-cmd.el (push (purecopy '(find-cmd 0 6)) package--builtin-versions) @@ -10747,10 +12442,11 @@ result is a string that should be ready for the command line. \(fn &rest SUBFINDS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-cmd" '("find-"))) + ;;;*** -;;;### (autoloads nil "find-dired" "find-dired.el" (22164 57534 315192 -;;;;;; 607000)) +;;;### (autoloads nil "find-dired" "find-dired.el" (0 0 0 0)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10788,10 +12484,11 @@ use in place of \"-ls\" as the final argument. \(fn DIR REGEXP)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-dired" '("find-" "lookfor-dired" "kill-find"))) + ;;;*** -;;;### (autoloads nil "find-file" "find-file.el" (22221 37189 888505 -;;;;;; 663000)) +;;;### (autoloads nil "find-file" "find-file.el" (0 0 0 0)) ;;; Generated autoloads from find-file.el (defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\ @@ -10879,17 +12576,22 @@ Visit the file you click on in another window. \(fn EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-file" '("ff-" "modula2-other-file-alist" "cc-"))) + ;;;*** -;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (22164 -;;;;;; 57534 183192 607000)) +;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ Find the Emacs Lisp source of LIBRARY. -LIBRARY should be a string (the name of the library). +LIBRARY should be a string (the name of the library). If the +optional OTHER-WINDOW argument (i.e., the command argument) is +specified, pop to a different window before displaying the +buffer. -\(fn LIBRARY)" t nil) +\(fn LIBRARY &optional OTHER-WINDOW)" t nil) (autoload 'find-function-search-for-symbol "find-func" "\ Search for SYMBOL's definition of type TYPE in LIBRARY. @@ -11050,10 +12752,11 @@ Define some key bindings for the find-function family of functions. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-func" '("find-"))) + ;;;*** -;;;### (autoloads nil "find-lisp" "find-lisp.el" (22164 57534 319192 -;;;;;; 607000)) +;;;### (autoloads nil "find-lisp" "find-lisp.el" (0 0 0 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -11071,9 +12774,11 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP. \(fn REGEXP)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-lisp" '("find-lisp-"))) + ;;;*** -;;;### (autoloads nil "finder" "finder.el" (22164 57534 319192 607000)) +;;;### (autoloads nil "finder" "finder.el" (0 0 0 0)) ;;; Generated autoloads from finder.el (push (purecopy '(finder 1 0)) package--builtin-versions) @@ -11093,10 +12798,11 @@ Find packages matching a given keyword. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file"))) + ;;;*** -;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (22164 57534 319192 -;;;;;; 607000)) +;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (0 0 0 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -11115,10 +12821,11 @@ to get the effect of a C-q. \(fn &rest LOSING-TERMINAL-TYPES)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-ctrl" '("flow-control-c-"))) + ;;;*** -;;;### (autoloads nil "flow-fill" "mail/flow-fill.el" (22221 37189 -;;;;;; 928505 663000)) +;;;### (autoloads nil "flow-fill" "mail/flow-fill.el" (0 0 0 0)) ;;; Generated autoloads from mail/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -11131,10 +12838,11 @@ to get the effect of a C-q. \(fn &optional BUFFER DELETE-SPACE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-fill" '("fill-flowed-"))) + ;;;*** -;;;### (autoloads nil "flymake" "progmodes/flymake.el" (22164 57535 -;;;;;; 451192 607000)) +;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) @@ -11162,10 +12870,11 @@ Turn flymake mode off. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-"))) + ;;;*** -;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (22228 10440 -;;;;;; 271428 995000)) +;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11233,16 +12942,19 @@ Flyspell whole buffer. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex"))) + ;;;*** -;;;### (autoloads nil "foldout" "foldout.el" (22164 57534 319192 -;;;;;; 607000)) +;;;### (autoloads nil "foldout" "foldout.el" (0 0 0 0)) ;;; Generated autoloads from foldout.el (push (purecopy '(foldout 1 10)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "foldout" '("foldout-"))) + ;;;*** -;;;### (autoloads nil "follow" "follow.el" (22164 57534 319192 607000)) +;;;### (autoloads nil "follow" "follow.el" (0 0 0 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11273,11 +12985,11 @@ virtual window. This is accomplished by two main techniques: makes it possible to walk between windows using normal cursor movement commands. -Follow mode comes to its prime when used on a large screen and two -side-by-side windows are used. The user can, with the help of Follow -mode, use two full-height windows as though they would have been -one. Imagine yourself editing a large function, or section of text, -and being able to use 144 lines instead of the normal 72... (your +Follow mode comes to its prime when used on a large screen and two or +more side-by-side windows are used. The user can, with the help of +Follow mode, use these full-height windows as though they were one. +Imagine yourself editing a large function, or section of text, and +being able to use 144 or 216 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands @@ -11292,6 +13004,34 @@ Keys specific to Follow mode: \(fn &optional ARG)" t nil) +(autoload 'follow-scroll-up-window "follow" "\ +Scroll text in a Follow mode window up by that window's size. +The other windows in the window chain will scroll synchronously. + +If called with no ARG, the `next-screen-context-lines' last lines of +the window will be visible after the scroll. + +If called with an argument, scroll ARG lines up. +Negative ARG means scroll downward. + +Works like `scroll-up' when not in Follow mode. + +\(fn &optional ARG)" t nil) + +(autoload 'follow-scroll-down-window "follow" "\ +Scroll text in a Follow mode window down by that window's size. +The other windows in the window chain will scroll synchronously. + +If called with no ARG, the `next-screen-context-lines' top lines of +the window in the chain will be visible after the scroll. + +If called with an argument, scroll ARG lines down. +Negative ARG means scroll upward. + +Works like `scroll-down' when not in Follow mode. + +\(fn &optional ARG)" t nil) + (autoload 'follow-scroll-up "follow" "\ Scroll text in a Follow mode window chain up. @@ -11334,10 +13074,19 @@ selected if the original window is the first one in the frame. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "follow" '("follow-"))) + +;;;*** + +;;;### (autoloads nil "fontset" "international/fontset.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from international/fontset.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fontset" '("charset-script-alist" "create-" "set" "standard-fontset-spec" "fontset-" "generate-fontset-menu" "xlfd-" "x-"))) + ;;;*** -;;;### (autoloads nil "footnote" "mail/footnote.el" (22164 57534 -;;;;;; 803192 607000)) +;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0)) ;;; Generated autoloads from mail/footnote.el (push (purecopy '(footnote 0 19)) package--builtin-versions) @@ -11347,16 +13096,25 @@ With a prefix argument ARG, enable Footnote mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Footnode mode is a buffer-local minor mode. If enabled, it +Footnote mode is a buffer-local minor mode. If enabled, it provides footnote support for `message-mode'. To get started, play around with the following keys: \\{footnote-minor-mode-map} \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "footnote" '("footnote-" "Footnote-"))) + +;;;*** + +;;;### (autoloads nil "format-spec" "format-spec.el" (0 0 0 0)) +;;; Generated autoloads from format-spec.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "format-spec" '("format-spec"))) + ;;;*** -;;;### (autoloads nil "forms" "forms.el" (22164 57534 359192 607000)) +;;;### (autoloads nil "forms" "forms.el" (0 0 0 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11390,10 +13148,11 @@ Visit a file in Forms mode in other window. \(fn FN)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "forms" '("forms-"))) + ;;;*** -;;;### (autoloads nil "fortran" "progmodes/fortran.el" (22164 57535 -;;;;;; 455192 607000)) +;;;### (autoloads nil "fortran" "progmodes/fortran.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11468,10 +13227,11 @@ with no args, if that value is non-nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortran" '("fortran-"))) + ;;;*** -;;;### (autoloads nil "fortune" "play/fortune.el" (22221 37190 505 -;;;;;; 663000)) +;;;### (autoloads nil "fortune" "play/fortune.el" (0 0 0 0)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11524,10 +13284,11 @@ and choose the directory as the fortune-file. \(fn &optional FILE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortune" '("fortune-"))) + ;;;*** -;;;### (autoloads nil "frameset" "frameset.el" (22189 60738 245741 -;;;;;; 19000)) +;;;### (autoloads nil "frameset" "frameset.el" (0 0 0 0)) ;;; Generated autoloads from frameset.el (defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\ @@ -11711,22 +13472,39 @@ Interactively, reads the register using `register-read-with-preview'. \(fn REGISTER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "frameset" '("frameset-"))) + ;;;*** -;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (22189 60739 -;;;;;; 13741 19000)) +;;;### (autoloads nil "fringe" "fringe.el" (0 0 0 0)) +;;; Generated autoloads from fringe.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fringe" '("fringe-" "set-fringe-"))) + +;;;*** + +;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (0 0 0 0)) ;;; Generated autoloads from play/gamegrid.el (push (purecopy '(gamegrid 1 2)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gamegrid" '("gamegrid-"))) + ;;;*** -;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (22164 57535 -;;;;;; 455192 607000)) +;;;### (autoloads nil "gametree" "play/gametree.el" (0 0 0 0)) +;;; Generated autoloads from play/gametree.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gametree" '("gametree-"))) + +;;;*** + +;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ Non-nil if Gdb-Enable-Debug mode is enabled. -See the command `gdb-enable-debug' for a description of this minor mode.") +See the `gdb-enable-debug' command +for a description of this minor mode.") (custom-autoload 'gdb-enable-debug "gdb-mi" nil) @@ -11741,14 +13519,18 @@ the list) is deleted every time a new one is added (at the front). \(fn &optional ARG)" t nil) (autoload 'gdb "gdb-mi" "\ -Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger. - -COMMAND-LINE is the shell command for starting the gdb session. -It should be a string consisting of the name of the gdb -executable followed by command line options. The command line -options should include \"-i=mi\" to use gdb's MI text interface. +Run gdb passing it COMMAND-LINE as arguments. + +If COMMAND-LINE names a program FILE to debug, gdb will run in +a buffer named *gud-FILE*, and the directory containing FILE +becomes the initial working directory and source-file directory +for your debugger. +If COMMAND-LINE requests that gdb attaches to a process PID, gdb +will run in *gud-PID*, otherwise it will run in *gud*; in these +cases the initial working directory is the default-directory of +the buffer in which this command was invoked. + +COMMAND-LINE should include \"-i=mi\" to use gdb's MI text interface. Note that the old \"--annotate\" option is no longer supported. If option `gdb-many-windows' is nil (the default value) then gdb just @@ -11796,10 +13578,19 @@ detailed description of this mode. \(fn COMMAND-LINE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gdb-mi" '("gdb" "gud-" "def-gdb-" "breakpoint-" "nil"))) + ;;;*** -;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (22164 57534 -;;;;;; 183192 607000)) +;;;### (autoloads nil "generator" "emacs-lisp/generator.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emacs-lisp/generator.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generator" '("cps-" "iter-"))) + +;;;*** + +;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11877,10 +13668,18 @@ regular expression that can be used as an element of (make-obsolete 'generic-make-keywords-list 'regexp-opt '"24.4") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic" '("generic-"))) + ;;;*** -;;;### (autoloads nil "glasses" "progmodes/glasses.el" (22164 57535 -;;;;;; 455192 607000)) +;;;### (autoloads nil "generic-x" "generic-x.el" (0 0 0 0)) +;;; Generated autoloads from generic-x.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic-x" '("generic-" "default-generic-mode"))) + +;;;*** + +;;;### (autoloads nil "glasses" "progmodes/glasses.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11892,10 +13691,11 @@ add virtual separators (like underscores) at places they belong to. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "glasses" '("glasses-"))) + ;;;*** -;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (22208 25156 -;;;;;; 857078 435000)) +;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -11947,9 +13747,11 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. \(fn ICON-LIST ZAP-LIST DEFAULT-MAP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gmm-utils" '("gmm-" "defun-gmm"))) + ;;;*** -;;;### (autoloads nil "gnus" "gnus/gnus.el" (22224 13401 634549 811000)) +;;;### (autoloads nil "gnus" "gnus/gnus.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus.el (push (purecopy '(gnus 5 13)) package--builtin-versions) (when (fboundp 'custom-autoload) @@ -11997,10 +13799,11 @@ prompt the user for the name of an NNTP server to use. \(fn &optional ARG DONT-CONNECT SLAVE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (22207 4296 -;;;;;; 608349 691000)) +;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -12088,10 +13891,11 @@ CLEAN is obsolete and ignored. \(fn &optional CLEAN REREAD)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-agent" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (22220 16330 -;;;;;; 735423 271000)) +;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -12099,10 +13903,26 @@ Make the current buffer look like a nice article. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-art" '("gnus-" "article-"))) + +;;;*** + +;;;### (autoloads nil "gnus-async" "gnus/gnus-async.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-async.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-async" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (22207 -;;;;;; 4296 628349 691000)) +;;;### (autoloads nil "gnus-bcklg" "gnus/gnus-bcklg.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-bcklg.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bcklg" '("gnus-backlog-"))) + +;;;*** + +;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -12123,10 +13943,11 @@ deletion, or > if it is flagged for displaying. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-"))) + ;;;*** -;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (22207 4296 -;;;;;; 628349 691000)) +;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -12165,10 +13986,32 @@ supported. \(fn GROUP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cache" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-cite" "gnus/gnus-cite.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-cite.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cite" '("turn-o" "gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-cloud" "gnus/gnus-cloud.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-cloud.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cloud" '("gnus-cloud-"))) + ;;;*** -;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (22207 4296 -;;;;;; 628349 691000)) +;;;### (autoloads nil "gnus-cus" "gnus/gnus-cus.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-cus.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cus" '("gnus-" "category-fields"))) + +;;;*** + +;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -12201,10 +14044,18 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. \(fn &optional NO-KEYMAP NO-CHECK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-delay" '("gnus-delay-"))) + ;;;*** -;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (22207 4296 -;;;;;; 628349 691000)) +;;;### (autoloads nil "gnus-demon" "gnus/gnus-demon.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-demon.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-demon" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -12217,10 +14068,11 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. \(fn HEADER)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-diary" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (22204 28147 -;;;;;; 283298 479000)) +;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -12228,10 +14080,11 @@ Convenience method to turn on gnus-dired-mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dired" '("gnus-dired-"))) + ;;;*** -;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (22204 28147 -;;;;;; 283298 479000)) +;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -12239,10 +14092,25 @@ Reminder user if there are unsent drafts. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-draft" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-dup" "gnus/gnus-dup.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-dup.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dup" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-eform" "gnus/gnus-eform.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-eform.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-eform" '("gnus-edit-form"))) + ;;;*** -;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (22203 7237 406647 -;;;;;; 107000)) +;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus--random-face-with-type "gnus-fun" "\ @@ -12305,10 +14173,12 @@ Insert a random Face header from `gnus-face-directory'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-fun" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (22205 -;;;;;; 48966 780819 751000)) +;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -12323,10 +14193,11 @@ If gravatars are already displayed, remove them. \(fn &optional FORCE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-"))) + ;;;*** -;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (22228 10440 -;;;;;; 231428 995000)) +;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12341,10 +14212,11 @@ Pop up a frame and enter GROUP. \(fn GROUP)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-group" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (22207 4296 -;;;;;; 632349 691000)) +;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -12357,10 +14229,26 @@ Pop up a frame and enter GROUP. \(fn SUMMARY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-html" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-icalendar" "gnus/gnus-icalendar.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from gnus/gnus-icalendar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-icalendar" '("gnus-icalendar"))) + +;;;*** + +;;;### (autoloads nil "gnus-int" "gnus/gnus-int.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-int.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-int" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (22195 13278 -;;;;;; 43727 967000)) +;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12371,10 +14259,25 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-kill" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-logic" "gnus/gnus-logic.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-logic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-logic" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-mh" "gnus/gnus-mh.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-mh.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mh" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (22204 28147 307298 -;;;;;; 479000)) +;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -12395,10 +14298,11 @@ Minor mode for providing mailing-list commands. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))) + ;;;*** -;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (22164 57534 -;;;;;; 547192 607000)) +;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -12496,10 +14400,11 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: \(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mlspl" '("gnus-group-split-"))) + ;;;*** -;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (22208 25156 -;;;;;; 865078 435000)) +;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12523,10 +14428,12 @@ Like `message-reply'. (define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-msg" '("gnus-"))) + ;;;*** ;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (22207 4296 640349 691000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12540,10 +14447,11 @@ This is typically a function to add in \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-notifications" '("gnus-notifications-"))) + ;;;*** -;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (22204 28147 -;;;;;; 319298 479000)) +;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12564,10 +14472,11 @@ If picons are already displayed, remove them. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-picon" '("gnus-picon-"))) + ;;;*** -;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (22164 57534 -;;;;;; 563192 607000)) +;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -12632,10 +14541,12 @@ Add NUM into sorted LIST by side effect. \(fn LIST NUM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-range" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (22204 -;;;;;; 28147 319298 479000)) +;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -12648,10 +14559,33 @@ Install the registry hooks. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-registry" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-rfc1843" "gnus/gnus-rfc1843.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from gnus/gnus-rfc1843.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-rfc1843" '("rfc1843-"))) + +;;;*** + +;;;### (autoloads nil "gnus-salt" "gnus/gnus-salt.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-salt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-salt" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-score" "gnus/gnus-score.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-score.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-score" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (22164 57534 -;;;;;; 567192 607000)) +;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12676,10 +14610,11 @@ See the documentation for these variables and functions for details. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sieve" '("gnus-sieve-"))) + ;;;*** -;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (22207 4296 -;;;;;; 644349 691000)) +;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12687,10 +14622,18 @@ Update the format specification near point. \(fn VAR)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-spec" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-srvr" "gnus/gnus-srvr.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-srvr.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-srvr" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (22208 25156 -;;;;;; 873078 435000)) +;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12698,10 +14641,11 @@ Declare back end NAME with ABILITIES as a Gnus back end. \(fn NAME &rest ABILITIES)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-start" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (22208 25156 -;;;;;; 909078 435000)) +;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12710,26 +14654,46 @@ BOOKMARK is a bookmark name or a bookmark record. \(fn BOOKMARK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sum" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (22208 25156 -;;;;;; 913078 435000)) -;;; Generated autoloads from gnus/gnus-sync.el +;;;### (autoloads nil "gnus-topic" "gnus/gnus-topic.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-topic.el -(autoload 'gnus-sync-initialize "gnus-sync" "\ -Initialize the Gnus sync facility. +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-topic" '("gnus-"))) -\(fn)" t nil) +;;;*** + +;;;### (autoloads nil "gnus-undo" "gnus/gnus-undo.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-undo.el -(autoload 'gnus-sync-install-hooks "gnus-sync" "\ -Install the sync hooks. +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-undo" '("gnus-"))) -\(fn)" t nil) +;;;*** + +;;;### (autoloads nil "gnus-util" "gnus/gnus-util.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-util" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-uu" "gnus/gnus-uu.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-uu.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-uu" '("gnus-"))) + +;;;*** + +;;;### (autoloads nil "gnus-vm" "gnus/gnus-vm.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gnus-vm.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-vm" '("gnus-"))) ;;;*** -;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (22207 4296 704349 -;;;;;; 691000)) +;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12737,10 +14701,11 @@ Add the window configuration CONF to `gnus-buffer-configuration'. \(fn CONF)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-win" '("gnus-"))) + ;;;*** -;;;### (autoloads nil "gnutls" "net/gnutls.el" (22218 60997 160333 -;;;;;; 743000)) +;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12754,10 +14719,11 @@ A value of nil says to use the default GnuTLS value.") (custom-autoload 'gnutls-min-prime-bits "gnutls" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream"))) + ;;;*** -;;;### (autoloads nil "gomoku" "play/gomoku.el" (22189 60739 17741 -;;;;;; 19000)) +;;;### (autoloads nil "gomoku" "play/gomoku.el" (0 0 0 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12781,10 +14747,11 @@ Use \\[describe-mode] for more info. \(fn &optional N M)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gomoku" '("gomoku-"))) + ;;;*** -;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (22164 57534 -;;;;;; 927192 607000)) +;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (0 0 0 0)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12823,10 +14790,11 @@ Like `goto-address-mode', but only for comments and strings. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-"))) + ;;;*** -;;;### (autoloads nil "gravatar" "image/gravatar.el" (22221 37189 -;;;;;; 912505 663000)) +;;;### (autoloads nil "gravatar" "image/gravatar.el" (0 0 0 0)) ;;; Generated autoloads from image/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12840,9 +14808,11 @@ Retrieve MAIL-ADDRESS gravatar and returns it. \(fn MAIL-ADDRESS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gravatar" '("gravatar-"))) + ;;;*** -;;;### (autoloads nil "grep" "progmodes/grep.el" t) +;;;### (autoloads nil "grep" "progmodes/grep.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -13007,9 +14977,11 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'. (defalias 'rzgrep 'zrgrep) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "grep" '("rgrep-default-command" "grep-" "kill-grep"))) + ;;;*** -;;;### (autoloads nil "gs" "gs.el" (22164 57534 707192 607000)) +;;;### (autoloads nil "gs" "gs.el" (0 0 0 0)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -13020,16 +14992,30 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. \(fn FRAME SPEC IMG-WIDTH IMG-HEIGHT WINDOW-AND-PIXMAP-ID PIXEL-COLORS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gs" '("gs-"))) + ;;;*** -;;;### (autoloads nil "gud" "progmodes/gud.el" (22195 13278 263727 -;;;;;; 967000)) +;;;### (autoloads nil "gssapi" "gnus/gssapi.el" (0 0 0 0)) +;;; Generated autoloads from gnus/gssapi.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gssapi" '("open-gssapi-stream" "gssapi-program"))) + +;;;*** + +;;;### (autoloads nil "gud" "progmodes/gud.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ -Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working -directory and source-file directory for your debugger. +Run gdb passing it COMMAND-LINE as arguments. +If COMMAND-LINE names a program FILE to debug, gdb will run in +a buffer named *gud-FILE*, and the directory containing FILE +becomes the initial working directory and source-file directory +for your debugger. +If COMMAND-LINE requests that gdb attaches to a process PID, gdb +will run in *gud-PID*, otherwise it will run in *gud*; in these +cases the initial working directory is the default-directory of +the buffer in which this command was invoked. \(fn COMMAND-LINE)" t nil) @@ -13101,7 +15087,8 @@ Major mode for editing GDB scripts. (defvar gud-tooltip-mode nil "\ Non-nil if Gud-Tooltip mode is enabled. -See the command `gud-tooltip-mode' for a description of this minor mode. +See the `gud-tooltip-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `gud-tooltip-mode'.") @@ -13116,10 +15103,11 @@ it if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gud" '("gdb-" "gud-"))) + ;;;*** -;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (22164 57534 183192 -;;;;;; 607000)) +;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -13214,15 +15202,16 @@ The return value is the last VAL in the list. Return a reference to PLACE. This is like the `&' operator of the C language. Note: this only works reliably with lexical binding mode, except for very -simple PLACEs such as (function-symbol \\='foo) which will also work in dynamic +simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic binding mode. \(fn PLACE)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gv" '("gv-"))) + ;;;*** -;;;### (autoloads nil "handwrite" "play/handwrite.el" (22164 57535 -;;;;;; 303192 607000)) +;;;### (autoloads nil "handwrite" "play/handwrite.el" (0 0 0 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -13237,10 +15226,19 @@ Variables: `handwrite-linespace' (default 12) \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map"))) + ;;;*** -;;;### (autoloads nil "hanoi" "play/hanoi.el" (21799 41767 31221 -;;;;;; 635000)) +;;;### (autoloads nil "hanja-util" "language/hanja-util.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from language/hanja-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanja-util" '("han"))) + +;;;*** + +;;;### (autoloads nil "hanoi" "play/hanoi.el" (0 0 0 0)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -13265,10 +15263,11 @@ to be updated. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanoi" '("hanoi-"))) + ;;;*** -;;;### (autoloads nil "hashcash" "mail/hashcash.el" (22164 57534 -;;;;;; 803192 607000)) +;;;### (autoloads nil "hashcash" "mail/hashcash.el" (0 0 0 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13308,10 +15307,11 @@ Prefix arg sets default accept amount temporarily. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hashcash" '("hashcash-"))) + ;;;*** -;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (22164 57534 707192 -;;;;;; 607000)) +;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (0 0 0 0)) ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -13436,14 +15436,16 @@ different regions. With numeric argument ARG, behaves like \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-at-pt" '("scan-buf-move-hook" "help-at-pt-"))) + ;;;*** -;;;### (autoloads nil "help-fns" "help-fns.el" (22220 16330 775423 -;;;;;; 271000)) +;;;### (autoloads nil "help-fns" "help-fns.el" (0 0 0 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ Display the full documentation of FUNCTION (a symbol). +When called from lisp, FUNCTION may also be a function object. \(fn FUNCTION)" t nil) @@ -13524,10 +15526,11 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. \(fn FILE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-fns" '("help-" "describe-"))) + ;;;*** -;;;### (autoloads nil "help-macro" "help-macro.el" (22164 57534 707192 -;;;;;; 607000)) +;;;### (autoloads nil "help-macro" "help-macro.el" (0 0 0 0)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13539,10 +15542,11 @@ gives the window that lists the options.") (custom-autoload 'three-step-help "help-macro" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-macro" '("make-help-screen"))) + ;;;*** -;;;### (autoloads nil "help-mode" "help-mode.el" (22220 16330 779423 -;;;;;; 271000)) +;;;### (autoloads nil "help-mode" "help-mode.el" (0 0 0 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13641,10 +15645,11 @@ BOOKMARK is a bookmark name or a bookmark record. \(fn BOOKMARK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-mode" '("help-" "describe-symbol-backends"))) + ;;;*** -;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (22164 57534 -;;;;;; 183192 607000)) +;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13657,9 +15662,18 @@ Provide help for current mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "helper" '("Helper-"))) + ;;;*** -;;;### (autoloads nil "hexl" "hexl.el" (22164 57534 711192 607000)) +;;;### (autoloads nil "hex-util" "hex-util.el" (0 0 0 0)) +;;; Generated autoloads from hex-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hex-util" '("encode-hex-string" "decode-hex-string"))) + +;;;*** + +;;;### (autoloads nil "hexl" "hexl.el" (0 0 0 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13751,10 +15765,11 @@ This discards the buffer's undo information. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hexl" '("hexl-" "dehexlify-buffer"))) + ;;;*** -;;;### (autoloads nil "hi-lock" "hi-lock.el" (22164 57534 711192 -;;;;;; 607000)) +;;;### (autoloads nil "hi-lock" "hi-lock.el" (0 0 0 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13824,7 +15839,8 @@ Hi-lock: end is found. A mode is excluded if it's in the list (defvar global-hi-lock-mode nil "\ Non-nil if Global Hi-Lock mode is enabled. -See the command `global-hi-lock-mode' for a description of this minor mode. +See the `global-hi-lock-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-hi-lock-mode'.") @@ -13919,10 +15935,11 @@ be found in variable `hi-lock-interactive-patterns'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled"))) + ;;;*** -;;;### (autoloads nil "hideif" "progmodes/hideif.el" (22174 6972 -;;;;;; 720792 520000)) +;;;### (autoloads nil "hideif" "progmodes/hideif.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13967,10 +15984,11 @@ Several variables affect how the hiding is done: \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideif" '("hif-" "hide-ifdef" "show-ifdef" "previous-ifdef" "next-ifdef" "up-ifdef" "down-ifdef" "backward-ifdef" "forward-ifdef" "intern-safe"))) + ;;;*** -;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (22221 37190 -;;;;;; 44505 663000)) +;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -14030,10 +16048,11 @@ Unconditionally turn off `hs-minor-mode'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideshow" '("hs-"))) + ;;;*** -;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (22164 57534 715192 -;;;;;; 607000)) +;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (0 0 0 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -14143,7 +16162,8 @@ changes are made, so \\[highlight-changes-next-change] and (defvar global-highlight-changes-mode nil "\ Non-nil if Global Highlight-Changes mode is enabled. -See the command `global-highlight-changes-mode' for a description of this minor mode. +See the `global-highlight-changes-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-highlight-changes-mode'.") @@ -14162,10 +16182,11 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hilit-chg" '("highlight-" "hilit-chg-" "global-highlight-changes"))) + ;;;*** -;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (22164 57534 715192 -;;;;;; 607000)) +;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (0 0 0 0)) ;;; Generated autoloads from hippie-exp.el (push (purecopy '(hippie-exp 1 6)) package--builtin-versions) @@ -14195,10 +16216,11 @@ argument VERBOSE non-nil makes the function verbose. \(fn TRY-LIST &optional VERBOSE)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hippie-exp" '("hippie-expand-" "he-" "try-"))) + ;;;*** -;;;### (autoloads nil "hl-line" "hl-line.el" (22164 57534 715192 -;;;;;; 607000)) +;;;### (autoloads nil "hl-line" "hl-line.el" (0 0 0 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -14216,14 +16238,15 @@ non-selected window. Hl-Line mode uses the function When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the line about point in the selected window only. In this case, it -uses the function `hl-line-unhighlight' on `pre-command-hook' in +uses the function `hl-line-maybe-unhighlight' in addition to `hl-line-highlight' on `post-command-hook'. \(fn &optional ARG)" t nil) (defvar global-hl-line-mode nil "\ Non-nil if Global Hl-Line mode is enabled. -See the command `global-hl-line-mode' for a description of this minor mode. +See the `global-hl-line-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-hl-line-mode'.") @@ -14237,18 +16260,33 @@ positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode -highlights the line about the current buffer's point in all +highlights the line about the current buffer's point in all live windows. -Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and -`global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'. +Global-Hl-Line mode uses the functions `global-hl-line-highlight' +and `global-hl-line-maybe-unhighlight' on `post-command-hook'. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hl-line" '("hl-line-" "global-hl-line-"))) + ;;;*** -;;;### (autoloads nil "holidays" "calendar/holidays.el" (22164 57533 -;;;;;; 855192 607000)) +;;;### (autoloads nil "hmac-def" "net/hmac-def.el" (0 0 0 0)) +;;; Generated autoloads from net/hmac-def.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-def" '("define-hmac-function"))) + +;;;*** + +;;;### (autoloads nil "hmac-md5" "net/hmac-md5.el" (0 0 0 0)) +;;; Generated autoloads from net/hmac-md5.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary"))) + +;;;*** + +;;;### (autoloads nil "holidays" "calendar/holidays.el" (0 0 0 0)) ;;; Generated autoloads from calendar/holidays.el (defvar holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ @@ -14356,10 +16394,11 @@ The optional LABEL is used to label the buffer created. (defalias 'holiday-list 'list-holidays) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "holidays" '("holiday-" "calendar-"))) + ;;;*** -;;;### (autoloads nil "html2text" "net/html2text.el" (22221 37189 -;;;;;; 964505 663000)) +;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0)) ;;; Generated autoloads from net/html2text.el (autoload 'html2text "html2text" "\ @@ -14367,10 +16406,11 @@ Convert HTML to plain text in the current buffer. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "html2text" '("html2text-"))) + ;;;*** -;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (22189 60738 -;;;;;; 317741 19000)) +;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -14384,8 +16424,9 @@ Dangerous characters in the existing buffer are turned into HTML entities, so you should even be able to do HTML-within-HTML fontified display. -You should, however, note that random control or eight-bit -characters such as ^L ( ) or ¤ (\244) won't get mapped yet. +You should, however, note that random control or non-ASCII +characters such as ^L (U+000C FORM FEED (FF)) or ¤ (U+00A4 +CURRENCY SIGN) won't get mapped yet. If the SRCDIR and FILE arguments are set, lookup etags derived entries in the `hfy-tags-cache' and add HTML anchors and @@ -14401,10 +16442,19 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. \(fn SRCDIR DSTDIR &optional F-EXT L-EXT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ibuf-ext" "ibuf-ext.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from ibuf-ext.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-ext" '("ibuffer-" "filename" "shell-command-" "size" "alphabetic" "major-mode" "mode" "print" "predicate" "content" "name" "derived-mode" "used-mode" "query-replace" "rename-uniquely" "revert" "replace-regexp" "view-and-eval" "eval"))) + ;;;*** -;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (22164 57534 715192 -;;;;;; 607000)) +;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (0 0 0 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14478,8 +16528,13 @@ operation is complete, in the form: ACTIVE-OPSTRING is a string which will be displayed to the user in a confirmation message, in the form: \"Really ACTIVE-OPSTRING x buffers?\" -COMPLEX means this function is special; see the source code of this -macro for exactly what it does. +COMPLEX means this function is special; if COMPLEX is nil BODY +evaluates once for each marked buffer, MBUF, with MBUF current +and saving the point. If COMPLEX is non-nil, BODY evaluates +without requiring MBUF current. +BODY define the operation; they are forms to evaluate per each +marked buffer. BODY is evaluated with `buf' bound to the +buffer object. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil t) @@ -14504,10 +16559,11 @@ bound to the current value of the filter. (function-put 'define-ibuffer-filter 'doc-string-elt '2) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-macs" '("ibuffer-"))) + ;;;*** -;;;### (autoloads nil "ibuffer" "ibuffer.el" (22164 57534 719192 -;;;;;; 607000)) +;;;### (autoloads nil "ibuffer" "ibuffer.el" (0 0 0 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14544,10 +16600,12 @@ FORMATS is the value to use for `ibuffer-formats'. \(fn &optional OTHER-WINDOW-P NAME QUALIFIERS NOSELECT SHRINK FILTER-GROUPS FORMATS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuffer" '("ibuffer-" "filename" "process" "mark" "mod" "size" "name" "locked" "read-only"))) + ;;;*** -;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (22164 -;;;;;; 57533 859192 607000)) +;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/icalendar.el (push (purecopy '(icalendar 0 19)) package--builtin-versions) @@ -14598,15 +16656,17 @@ buffer `*icalendar-errors*'. \(fn &optional DIARY-FILE DO-NOT-ASK NON-MARKING)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icalendar" '("icalendar-"))) + ;;;*** -;;;### (autoloads nil "icomplete" "icomplete.el" (22164 57534 719192 -;;;;;; 607000)) +;;;### (autoloads nil "icomplete" "icomplete.el" (0 0 0 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ Non-nil if Icomplete mode is enabled. -See the command `icomplete-mode' for a description of this minor mode. +See the `icomplete-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `icomplete-mode'.") @@ -14638,10 +16698,11 @@ completions: (make-obsolete 'iswitchb-mode "use `icomplete-mode' or `ido-mode' instead." "24.4")) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icomplete" '("icomplete-"))) + ;;;*** -;;;### (autoloads nil "icon" "progmodes/icon.el" (22164 57535 475192 -;;;;;; 607000)) +;;;### (autoloads nil "icon" "progmodes/icon.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14679,10 +16740,28 @@ with no args, if that value is non-nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icon" '("indent-icon-exp" "icon-" "electric-icon-brace" "end-of-icon-defun" "beginning-of-icon-defun" "mark-icon-function" "calculate-icon-indent"))) + +;;;*** + +;;;### (autoloads nil "idlw-complete-structtag" "progmodes/idlw-complete-structtag.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from progmodes/idlw-complete-structtag.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-complete-structtag" '("idlwave-"))) + +;;;*** + +;;;### (autoloads nil "idlw-help" "progmodes/idlw-help.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from progmodes/idlw-help.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-help" '("idlwave-"))) + ;;;*** -;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (22164 -;;;;;; 57535 483192 607000)) +;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14705,10 +16784,19 @@ See also the variable `idlwave-shell-prompt-pattern'. \(fn &optional ARG QUICK)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-"))) + +;;;*** + +;;;### (autoloads nil "idlw-toolbar" "progmodes/idlw-toolbar.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from progmodes/idlw-toolbar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-"))) + ;;;*** -;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (22164 57535 -;;;;;; 491192 607000)) +;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/idlwave.el (push (purecopy '(idlwave 6 1 22)) package--builtin-versions) @@ -14835,9 +16923,11 @@ The main features of this mode are \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlwave" '("idlwave-"))) + ;;;*** -;;;### (autoloads nil "ido" "ido.el" (22164 57534 731192 607000)) +;;;### (autoloads nil "ido" "ido.el" (0 0 0 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -15097,9 +17187,11 @@ DEF, if non-nil, is the default value. \(fn PROMPT CHOICES &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ido" '("ido-"))) + ;;;*** -;;;### (autoloads nil "ielm" "ielm.el" (22164 57534 731192 607000)) +;;;### (autoloads nil "ielm" "ielm.el" (0 0 0 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -15109,9 +17201,18 @@ See `inferior-emacs-lisp-mode' for details. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("inferior-emacs-lisp-mode" "ielm-"))) + ;;;*** -;;;### (autoloads nil "iimage" "iimage.el" (22164 57534 731192 607000)) +;;;### (autoloads nil "ietf-drums" "mail/ietf-drums.el" (0 0 0 0)) +;;; Generated autoloads from mail/ietf-drums.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ietf-drums" '("ietf-drums-"))) + +;;;*** + +;;;### (autoloads nil "iimage" "iimage.el" (0 0 0 0)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -15125,9 +17226,11 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))) + ;;;*** -;;;### (autoloads nil "image" "image.el" (22220 16330 779423 271000)) +;;;### (autoloads nil "image" "image.el" (0 0 0 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15318,9 +17421,11 @@ If Emacs is compiled without ImageMagick support, this does nothing. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image" '("image"))) + ;;;*** -;;;### (autoloads nil "image-dired" "image-dired.el" t) +;;;### (autoloads nil "image-dired" "image-dired.el" (0 0 0 0)) ;;; Generated autoloads from image-dired.el (push (purecopy '(image-dired 0 4 11)) package--builtin-versions) @@ -15455,10 +17560,11 @@ easy-to-use form. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-dired" '("image-dired-"))) + ;;;*** -;;;### (autoloads nil "image-file" "image-file.el" (22164 57534 731192 -;;;;;; 607000)) +;;;### (autoloads nil "image-file" "image-file.el" (0 0 0 0)) ;;; Generated autoloads from image-file.el (defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ @@ -15499,7 +17605,8 @@ the command `insert-file-contents'. (defvar auto-image-file-mode nil "\ Non-nil if Auto-Image-File mode is enabled. -See the command `auto-image-file-mode' for a description of this minor mode. +See the `auto-image-file-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `auto-image-file-mode'.") @@ -15518,10 +17625,11 @@ An image file is one whose name has an extension in \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-file" '("image-file-"))) + ;;;*** -;;;### (autoloads nil "image-mode" "image-mode.el" (22226 55133 156211 -;;;;;; 947000)) +;;;### (autoloads nil "image-mode" "image-mode.el" (0 0 0 0)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -15558,9 +17666,18 @@ displays an image file as text. \(fn BMK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-mode" '("image-"))) + ;;;*** -;;;### (autoloads nil "imenu" "imenu.el" (22164 57534 735192 607000)) +;;;### (autoloads nil "imap" "net/imap.el" (0 0 0 0)) +;;; Generated autoloads from net/imap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imap" '("imap-"))) + +;;;*** + +;;;### (autoloads nil "imenu" "imenu.el" (0 0 0 0)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15696,10 +17813,11 @@ for more information. \(fn INDEX-ITEM)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imenu" '("imenu-"))) + ;;;*** -;;;### (autoloads nil "ind-util" "language/ind-util.el" (22164 57534 -;;;;;; 783192 607000)) +;;;### (autoloads nil "ind-util" "language/ind-util.el" (0 0 0 0)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15727,10 +17845,11 @@ Convert old Emacs Devanagari characters to UCS. \(fn FROM TO)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ind-util" '("indian-" "ucs-to-is"))) + ;;;*** -;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (22164 57535 -;;;;;; 491192 607000)) +;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15746,12 +17865,14 @@ of `inferior-lisp-program'). Runs the hooks from (defalias 'run-lisp 'inferior-lisp) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp"))) + ;;;*** -;;;### (autoloads nil "info" "info.el" (22164 57534 739192 607000)) +;;;### (autoloads nil "info" "info.el" (0 0 0 0)) ;;; Generated autoloads from info.el -(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\ +(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/"))) (suffixes '("share/" "")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\ Default list of directories to search for Info documentation files. They are searched in the order they are given in the list. Therefore, the directory of Info files that come with Emacs @@ -15958,10 +18079,11 @@ completion alternatives to currently visited manuals. \(fn MANUAL)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info" '("info-" "Info-"))) + ;;;*** -;;;### (autoloads nil "info-look" "info-look.el" (22164 57534 735192 -;;;;;; 607000)) +;;;### (autoloads nil "info-look" "info-look.el" (0 0 0 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -16006,10 +18128,11 @@ Perform completion on file preceding point. \(fn &optional MODE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-look" '("info-"))) + ;;;*** -;;;### (autoloads nil "info-xref" "info-xref.el" (22164 57534 735192 -;;;;;; 607000)) +;;;### (autoloads nil "info-xref" "info-xref.el" (0 0 0 0)) ;;; Generated autoloads from info-xref.el (push (purecopy '(info-xref 3)) package--builtin-versions) @@ -16090,10 +18213,11 @@ the sources handy. \(fn FILENAME-LIST)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-xref" '("info-xref-"))) + ;;;*** -;;;### (autoloads nil "informat" "informat.el" (22164 57534 739192 -;;;;;; 607000)) +;;;### (autoloads nil "informat" "informat.el" (0 0 0 0)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -16136,10 +18260,11 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "informat" '("Info-validate-"))) + ;;;*** -;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (22174 6972 -;;;;;; 468792 520000)) +;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/inline.el (autoload 'define-inline "inline" "\ @@ -16151,10 +18276,11 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" (function-put 'define-inline 'doc-string-elt '3) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inline" '("inline-"))) + ;;;*** -;;;### (autoloads nil "inversion" "cedet/inversion.el" (22164 57533 -;;;;;; 935192 607000)) +;;;### (autoloads nil "inversion" "cedet/inversion.el" (0 0 0 0)) ;;; Generated autoloads from cedet/inversion.el (push (purecopy '(inversion 1 3)) package--builtin-versions) @@ -16164,10 +18290,12 @@ Only checks one based on which kind of Emacs is being run. \(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inversion" '("inversion-"))) + ;;;*** -;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (22164 -;;;;;; 57534 743192 607000)) +;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -16185,10 +18313,11 @@ Toggle input method in interactive search. \(fn LAST-CHAR &optional COUNT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearch-x" '("isearch-"))) + ;;;*** -;;;### (autoloads nil "isearchb" "isearchb.el" (22164 57534 763192 -;;;;;; 607000)) +;;;### (autoloads nil "isearchb" "isearchb.el" (0 0 0 0)) ;;; Generated autoloads from isearchb.el (push (purecopy '(isearchb 1 5)) package--builtin-versions) @@ -16200,10 +18329,20 @@ accessed via isearchb. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearchb" '("isearchb"))) + +;;;*** + +;;;### (autoloads nil "iso-ascii" "international/iso-ascii.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from international/iso-ascii.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-ascii" '("iso-ascii-"))) + ;;;*** -;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (22164 -;;;;;; 57534 743192 607000)) +;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -16291,18 +18430,21 @@ Add submenus to the File menu, to convert to and from various formats. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-cvt" '("iso-"))) + ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (22164 57534 743192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/iso-transl.el (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-transl" '("iso-transl-"))) + ;;;*** -;;;### (autoloads nil "ispell" "textmodes/ispell.el" (22189 60739 -;;;;;; 273741 19000)) +;;;### (autoloads nil "ispell" "textmodes/ispell.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16342,7 +18484,7 @@ Valid forms include: (KEY REGEXP) - skip to end of REGEXP. REGEXP must be a string. (KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.") -(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \n]*{[ \n]*document[ \n]*}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \n]*{[ \n]*program[ \n]*}") ("verbatim\\*?" . "\\\\end[ \n]*{[ \n]*verbatim\\*?[ \n]*}")))) "\ +(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \n]*{[ \n]*document[ \n]*}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \n]*{[ \n]*program[ \n]*}") ("verbatim\\*?" . "\\\\end[ \n]*{[ \n]*verbatim\\*?[ \n]*}")))) "\ Lists of regions to be skipped in TeX mode. First list is used raw. Second list has key placed inside \\begin{}. @@ -16522,10 +18664,10 @@ The `X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your init file: - (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5 - (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4 - (add-hook \\='mail-send-hook \\='ispell-message) - (add-hook \\='mh-before-send-letter-hook \\='ispell-message) + (add-hook \\='message-send-hook #\\='ispell-message) ;; GNUS 5 + (add-hook \\='news-inews-hook #\\='ispell-message) ;; GNUS 4 + (add-hook \\='mail-send-hook #\\='ispell-message) + (add-hook \\='mh-before-send-letter-hook #\\='ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: @@ -16533,10 +18675,28 @@ You can bind this to the key C-c i in GNUS or mail by adding to \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ispell" '("ispell-" "check-ispell-version"))) + +;;;*** + +;;;### (autoloads nil "ja-dic-cnv" "international/ja-dic-cnv.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from international/ja-dic-cnv.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-cnv" '("skkdic-" "batch-skkdic-convert" "ja-dic-filename"))) + +;;;*** + +;;;### (autoloads nil "ja-dic-utl" "international/ja-dic-utl.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from international/ja-dic-utl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-utl" '("skkdic-"))) + ;;;*** -;;;### (autoloads nil "japan-util" "language/japan-util.el" (22164 -;;;;;; 57534 787192 607000)) +;;;### (autoloads nil "japan-util" "language/japan-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -16611,10 +18771,11 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. \(fn PROMPT &optional INITIAL-INPUT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "japan-util" '("japanese-"))) + ;;;*** -;;;### (autoloads nil "jka-compr" "jka-compr.el" (22164 57534 763192 -;;;;;; 607000)) +;;;### (autoloads nil "jka-compr" "jka-compr.el" (0 0 0 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16635,10 +18796,11 @@ by `jka-compr-installed'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jka-compr" '("jka-compr-" "compression-error"))) + ;;;*** -;;;### (autoloads nil "js" "progmodes/js.el" (22164 57535 507192 -;;;;;; 607000)) +;;;### (autoloads nil "js" "progmodes/js.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/js.el (push (purecopy '(js 9)) package--builtin-versions) @@ -16663,16 +18825,26 @@ locally, like so: (dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "js" '("js-" "with-js"))) + ;;;*** -;;;### (autoloads nil "json" "json.el" (22164 57534 763192 607000)) +;;;### (autoloads nil "json" "json.el" (0 0 0 0)) ;;; Generated autoloads from json.el (push (purecopy '(json 1 4)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json" '("json-"))) + ;;;*** -;;;### (autoloads nil "keypad" "emulation/keypad.el" (22164 57534 -;;;;;; 223192 607000)) +;;;### (autoloads nil "kermit" "kermit.el" (0 0 0 0)) +;;; Generated autoloads from kermit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kermit" '("kermit-"))) + +;;;*** + +;;;### (autoloads nil "keypad" "emulation/keypad.el" (0 0 0 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16727,8 +18899,8 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** -;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (22164 -;;;;;; 57534 743192 607000)) +;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16747,10 +18919,11 @@ the context of text formatting. \(fn LINEBEG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kinsoku" '("kinsoku-"))) + ;;;*** -;;;### (autoloads nil "kkc" "international/kkc.el" (22164 57534 747192 -;;;;;; 607000)) +;;;### (autoloads nil "kkc" "international/kkc.el" (0 0 0 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16770,9 +18943,11 @@ and the return value is the length of the conversion. \(fn FROM TO)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kkc" '("kkc-"))) + ;;;*** -;;;### (autoloads nil "kmacro" "kmacro.el" (22164 57534 767192 607000)) +;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16882,10 +19057,12 @@ If kbd macro currently being defined end it before activating it. \(fn EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kmacro" '("kmacro-"))) + ;;;*** -;;;### (autoloads nil "korea-util" "language/korea-util.el" (22164 -;;;;;; 57534 787192 607000)) +;;;### (autoloads nil "korea-util" "language/korea-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -16897,10 +19074,11 @@ The kind of Korean keyboard for Korean input method. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "korea-util" '("exit-korean-environment" "korean-key-bindings" "isearch-" "quail-hangul-switch-" "toggle-korean-input-method"))) + ;;;*** -;;;### (autoloads nil "lao-util" "language/lao-util.el" (22164 57534 -;;;;;; 787192 607000)) +;;;### (autoloads nil "lao-util" "language/lao-util.el" (0 0 0 0)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16935,10 +19113,12 @@ Transcribe Romanized Lao string STR to Lao character string. \(fn FROM TO)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lao-util" '("lao-"))) + ;;;*** -;;;### (autoloads nil "latexenc" "international/latexenc.el" (22164 -;;;;;; 57534 747192 607000)) +;;;### (autoloads nil "latexenc" "international/latexenc.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from international/latexenc.el (defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\ @@ -16967,10 +19147,12 @@ coding system names is determined from `latex-inputenc-coding-alist'. \(fn ARG-LIST)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latexenc" '("latexenc-dont-use-"))) + ;;;*** ;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el" -;;;;;; (22164 57534 747192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -17009,10 +19191,12 @@ use either \\[customize] or the function `latin1-display'.") (custom-autoload 'latin1-display-ucs-per-lynx "latin1-disp" nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latin1-disp" '("latin1-display-"))) + ;;;*** -;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (22164 -;;;;;; 57535 507192 607000)) +;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -17020,10 +19204,27 @@ A major mode to edit GNU ld script files \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ld-script" '("ld-script-"))) + +;;;*** + +;;;### (autoloads nil "ldap" "net/ldap.el" (0 0 0 0)) +;;; Generated autoloads from net/ldap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ldap" '("ldap-"))) + +;;;*** + +;;;### (autoloads nil "legacy-gnus-agent" "gnus/legacy-gnus-agent.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from gnus/legacy-gnus-agent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-"))) + ;;;*** -;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (22164 -;;;;;; 57534 183192 607000)) +;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/let-alist.el (push (purecopy '(let-alist 1 0 4)) package--builtin-versions) @@ -17060,9 +19261,11 @@ displayed in the example above. (function-put 'let-alist 'lisp-indent-function '1) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "let-alist" '("let-alist--"))) + ;;;*** -;;;### (autoloads nil "life" "play/life.el" (22164 57535 303192 607000)) +;;;### (autoloads nil "life" "play/life.el" (0 0 0 0)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -17073,9 +19276,11 @@ generations (this defaults to 1). \(fn &optional SLEEPTIME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "life" '("life-"))) + ;;;*** -;;;### (autoloads nil "linum" "linum.el" (22164 57534 799192 607000)) +;;;### (autoloads nil "linum" "linum.el" (0 0 0 0)) ;;; Generated autoloads from linum.el (push (purecopy '(linum 0 9 24)) package--builtin-versions) @@ -17091,7 +19296,8 @@ Linum mode is a buffer-local minor mode. (defvar global-linum-mode nil "\ Non-nil if Global Linum mode is enabled. -See the command `global-linum-mode' for a description of this minor mode. +See the `global-linum-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-linum-mode'.") @@ -17110,10 +19316,19 @@ See `linum-mode' for more information on Linum mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "linum" '("linum-"))) + +;;;*** + +;;;### (autoloads nil "lisp-mnt" "emacs-lisp/lisp-mnt.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emacs-lisp/lisp-mnt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lisp-mnt" '("lm-"))) + ;;;*** -;;;### (autoloads nil "loadhist" "loadhist.el" (22164 57534 799192 -;;;;;; 607000)) +;;;### (autoloads nil "loadhist" "loadhist.el" (0 0 0 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -17142,9 +19357,11 @@ something strange, such as redefining an Emacs function. \(fn FEATURE &optional FORCE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("unload-" "loadhist-hook-functions" "read-feature" "feature-" "file-"))) + ;;;*** -;;;### (autoloads nil "locate" "locate.el" (22164 57534 803192 607000)) +;;;### (autoloads nil "locate" "locate.el" (0 0 0 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -17194,10 +19411,11 @@ except that FILTER is not optional. \(fn SEARCH-STRING FILTER &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "locate" '("locate-"))) + ;;;*** -;;;### (autoloads nil "log-edit" "vc/log-edit.el" (22164 57535 859192 -;;;;;; 607000)) +;;;### (autoloads nil "log-edit" "vc/log-edit.el" (0 0 0 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -17226,10 +19444,11 @@ done. Otherwise, it uses the current buffer. \(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-edit" '("log-edit-" "vc-log-"))) + ;;;*** -;;;### (autoloads nil "log-view" "vc/log-view.el" (22164 57535 859192 -;;;;;; 607000)) +;;;### (autoloads nil "log-view" "vc/log-view.el" (0 0 0 0)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -17237,15 +19456,17 @@ Major mode for browsing CVS log output. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-view" '("log-view-"))) + ;;;*** -;;;### (autoloads nil "lpr" "lpr.el" (22164 57534 803192 607000)) +;;;### (autoloads nil "lpr" "lpr.el" (0 0 0 0)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ Non-nil if running on MS-DOS or MS Windows.") -(defvar lpr-lp-system (memq system-type '(usg-unix-v hpux irix)) "\ +(defvar lpr-lp-system (memq system-type '(usg-unix-v hpux)) "\ Non-nil if running on a system type that uses the \"lp\" command.") (defvar printer-name (and (eq system-type 'ms-dos) "PRN") "\ @@ -17332,10 +19553,11 @@ for further customization of the printer command. \(fn START END)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lpr" '("lpr-" "print"))) + ;;;*** -;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (22220 16330 783423 -;;;;;; 271000)) +;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (0 0 0 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17344,10 +19566,11 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") (custom-autoload 'ls-lisp-support-shell-wildcards "ls-lisp" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ls-lisp" '("ls-lisp-"))) + ;;;*** -;;;### (autoloads nil "lunar" "calendar/lunar.el" (22164 57533 859192 -;;;;;; 607000)) +;;;### (autoloads nil "lunar" "calendar/lunar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -17357,10 +19580,11 @@ This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lunar" '("lunar-" "diary-lunar-phases" "calendar-lunar-phases"))) + ;;;*** -;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (22164 57535 -;;;;;; 507192 607000)) +;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17368,9 +19592,11 @@ A major mode to edit m4 macro files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "m4-mode" '("m4-"))) + ;;;*** -;;;### (autoloads nil "macros" "macros.el" (22164 57534 803192 607000)) +;;;### (autoloads nil "macros" "macros.el" (0 0 0 0)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17459,8 +19685,7 @@ and then select the region of un-tablified names and use ;;;*** -;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (22200 31055 -;;;;;; 586669 23000)) +;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (0 0 0 0)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -17488,10 +19713,11 @@ Convert mail domain DOMAIN to the country it corresponds to. \(fn DOMAIN)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-extr" '("mail-extr-"))) + ;;;*** -;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (22164 57534 -;;;;;; 807192 607000)) +;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (0 0 0 0)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17518,10 +19744,33 @@ This function normally would be called when the message is sent. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-hist" '("mail-hist-"))) + +;;;*** + +;;;### (autoloads nil "mail-parse" "mail/mail-parse.el" (0 0 0 0)) +;;; Generated autoloads from mail/mail-parse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-parse" '("mail-"))) + +;;;*** + +;;;### (autoloads nil "mail-prsvr" "mail/mail-prsvr.el" (0 0 0 0)) +;;; Generated autoloads from mail/mail-prsvr.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-prsvr" '("mail-parse-"))) + ;;;*** -;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (22164 57534 -;;;;;; 807192 607000)) +;;;### (autoloads nil "mail-source" "gnus/mail-source.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from gnus/mail-source.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-source" '("mail-source"))) + +;;;*** + +;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (0 0 0 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17593,15 +19842,17 @@ matches may be returned from the message body. \(fn FIELD-NAME &optional LAST ALL LIST)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-utils" '("mail-"))) + ;;;*** -;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (22164 57534 -;;;;;; 807192 607000)) +;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ Non-nil if Mail-Abbrevs mode is enabled. -See the command `mail-abbrevs-mode' for a description of this minor mode. +See the `mail-abbrevs-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `mail-abbrevs-mode'.") @@ -17643,10 +19894,11 @@ double-quotes. \(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailabbrev" '("merge-mail-abbrevs" "mail-" "rebuild-mail-abbrevs"))) + ;;;*** -;;;### (autoloads nil "mailalias" "mail/mailalias.el" (22195 13278 -;;;;;; 151727 967000)) +;;;### (autoloads nil "mailalias" "mail/mailalias.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17697,10 +19949,18 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. (make-obsolete 'mail-complete 'mail-completion-at-point-function '"24.1") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailalias" '("mail-" "build-mail-aliases"))) + ;;;*** -;;;### (autoloads nil "mailclient" "mail/mailclient.el" (22189 60738 -;;;;;; 465741 19000)) +;;;### (autoloads nil "mailcap" "net/mailcap.el" (0 0 0 0)) +;;; Generated autoloads from net/mailcap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailcap" '("mailcap-"))) + +;;;*** + +;;;### (autoloads nil "mailclient" "mail/mailclient.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17710,10 +19970,26 @@ The mail client is taken to be the handler of mailto URLs. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailclient" '("mailclient-"))) + ;;;*** -;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (22221 -;;;;;; 37190 64505 663000)) +;;;### (autoloads nil "mailheader" "mail/mailheader.el" (0 0 0 0)) +;;; Generated autoloads from mail/mailheader.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailheader" '("mail-header"))) + +;;;*** + +;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0)) +;;; Generated autoloads from net/mairix.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mairix" '("mairix-"))) + +;;;*** + +;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17828,10 +20104,18 @@ An adapted `makefile-mode' that knows about imake. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "make-mode" '("makefile-"))) + +;;;*** + +;;;### (autoloads nil "makeinfo" "textmodes/makeinfo.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/makeinfo.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makeinfo" '("makeinfo-"))) + ;;;*** -;;;### (autoloads nil "makesum" "makesum.el" (22164 57534 843192 -;;;;;; 607000)) +;;;### (autoloads nil "makesum" "makesum.el" (0 0 0 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17840,9 +20124,11 @@ Previous contents of that buffer are killed first. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makesum" '("double-column"))) + ;;;*** -;;;### (autoloads nil "man" "man.el" (22195 13278 151727 967000)) +;;;### (autoloads nil "man" "man.el" (0 0 0 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17880,7 +20166,7 @@ otherwise look like a page name. An \"apropos\" query with -k gives a buffer of matching page names or descriptions. The pattern argument is usually an -\"egrep\" style regexp. +\"grep -E\" style regexp. -k pattern @@ -17896,16 +20182,26 @@ Default bookmark handler for Man buffers. \(fn BOOKMARK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "man" '("Man-" "man"))) + +;;;*** + +;;;### (autoloads nil "mantemp" "progmodes/mantemp.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/mantemp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mantemp" '("mantemp-"))) + ;;;*** -;;;### (autoloads nil "map" "emacs-lisp/map.el" (22195 13277 947727 -;;;;;; 967000)) +;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/map.el -(push (purecopy '(map 1 0)) package--builtin-versions) +(push (purecopy '(map 1 1)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map"))) ;;;*** -;;;### (autoloads nil "master" "master.el" (22164 57534 847192 607000)) +;;;### (autoloads nil "master" "master.el" (0 0 0 0)) ;;; Generated autoloads from master.el (push (purecopy '(master 1 0 2)) package--builtin-versions) @@ -17926,15 +20222,17 @@ yourself the value of `master-of' by calling `master-show-slave'. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "master" '("master-"))) + ;;;*** -;;;### (autoloads nil "mb-depth" "mb-depth.el" (22164 57534 847192 -;;;;;; 607000)) +;;;### (autoloads nil "mb-depth" "mb-depth.el" (0 0 0 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ Non-nil if Minibuffer-Depth-Indicate mode is enabled. -See the command `minibuffer-depth-indicate-mode' for a description of this minor mode. +See the `minibuffer-depth-indicate-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `minibuffer-depth-indicate-mode'.") @@ -17954,16 +20252,19 @@ recursion depth in the minibuffer prompt. This is only useful if \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mb-depth" '("minibuffer-depth-"))) + ;;;*** -;;;### (autoloads nil "md4" "md4.el" (22164 57534 847192 607000)) +;;;### (autoloads nil "md4" "md4.el" (0 0 0 0)) ;;; Generated autoloads from md4.el (push (purecopy '(md4 1 0)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "md4" '("md4"))) + ;;;*** -;;;### (autoloads nil "message" "gnus/message.el" (22220 16330 763423 -;;;;;; 271000)) +;;;### (autoloads nil "message" "gnus/message.el" (0 0 0 0)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -18126,10 +20427,12 @@ which specify the range to operate on. \(fn START END)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "message" '("message-" "nil"))) + ;;;*** -;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (22164 -;;;;;; 57535 511192 607000)) +;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/meta-mode.el (push (purecopy '(meta-mode 1 0)) package--builtin-versions) @@ -18143,10 +20446,11 @@ Major mode for editing MetaPost sources. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "meta-mode" '("meta" "font-lock-match-meta-declaration-item-and-skip-to-next"))) + ;;;*** -;;;### (autoloads nil "metamail" "mail/metamail.el" (22164 57534 -;;;;;; 807192 607000)) +;;;### (autoloads nil "metamail" "mail/metamail.el" (0 0 0 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -18187,10 +20491,32 @@ redisplayed as output is inserted. \(fn BEG END &optional VIEWMODE BUFFER NODISPLAY)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "metamail" '("metamail-"))) + +;;;*** + +;;;### (autoloads nil "mh-acros" "mh-e/mh-acros.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-acros.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-acros" '("mh-" "with-mh-folder-updating" "def"))) + +;;;*** + +;;;### (autoloads nil "mh-alias" "mh-e/mh-alias.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-alias.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-alias" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-buffers" "mh-e/mh-buffers.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-buffers.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-buffers" '("mh-"))) + ;;;*** -;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (22205 48966 992819 -;;;;;; 751000)) +;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -18278,9 +20604,18 @@ delete the draft message. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-comp" '("mh-"))) + ;;;*** -;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (22172 51646 865679 83000)) +;;;### (autoloads nil "mh-compat" "mh-e/mh-compat.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-compat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-compat" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-e.el (push (purecopy '(mh-e 8 6 -4)) package--builtin-versions) @@ -18295,10 +20630,11 @@ Display version information about MH-E and the MH mail handling system. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-e" '("mh-" "def"))) + ;;;*** -;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (22164 57534 -;;;;;; 875192 607000)) +;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -18377,15 +20713,138 @@ perform the operation on all messages in that region. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-folder" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-funcs" "mh-e/mh-funcs.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-funcs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-funcs" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-identity" "mh-e/mh-identity.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from mh-e/mh-identity.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-identity" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-inc" "mh-e/mh-inc.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-inc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-inc" '("mh-inc-spool-"))) + +;;;*** + +;;;### (autoloads nil "mh-junk" "mh-e/mh-junk.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-junk.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-junk" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-letter" "mh-e/mh-letter.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-letter.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-letter" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-limit" "mh-e/mh-limit.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-limit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-limit" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-mime" "mh-e/mh-mime.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-mime.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-mime" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-print" "mh-e/mh-print.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-print.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-print" '("mh-p"))) + +;;;*** + +;;;### (autoloads nil "mh-scan" "mh-e/mh-scan.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-scan.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-scan" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-search" "mh-e/mh-search.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-search.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-search" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-seq" "mh-e/mh-seq.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-seq.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-seq" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-show" "mh-e/mh-show.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-show.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-show" '("mh-"))) + ;;;*** -;;;### (autoloads nil "midnight" "midnight.el" (22195 13278 155727 -;;;;;; 967000)) +;;;### (autoloads nil "mh-speed" "mh-e/mh-speed.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-speed.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-speed" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-thread" "mh-e/mh-thread.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-thread.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-thread" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-tool-bar" "mh-e/mh-tool-bar.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from mh-e/mh-tool-bar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-"))) + +;;;*** + +;;;### (autoloads nil "mh-utils" "mh-e/mh-utils.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-utils.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-utils" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "mh-xface" "mh-e/mh-xface.el" (0 0 0 0)) +;;; Generated autoloads from mh-e/mh-xface.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-xface" '("mh-"))) + +;;;*** + +;;;### (autoloads nil "midnight" "midnight.el" (0 0 0 0)) ;;; Generated autoloads from midnight.el (defvar midnight-mode nil "\ Non-nil if Midnight mode is enabled. -See the command `midnight-mode' for a description of this minor mode. +See the `midnight-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `midnight-mode'.") @@ -18418,15 +20877,17 @@ to its second argument TM. \(fn SYMB TM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "midnight" '("midnight-" "clean-buffer-list-"))) + ;;;*** -;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (22164 57534 -;;;;;; 883192 607000)) +;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (0 0 0 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ Non-nil if Minibuffer-Electric-Default mode is enabled. -See the command `minibuffer-electric-default-mode' for a description of this minor mode. +See the `minibuffer-electric-default-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `minibuffer-electric-default-mode'.") @@ -18448,11 +20909,56 @@ is modified to remove the default indication. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "minibuf-eldef" '("minibuf"))) + ;;;*** -;;;### (autoloads nil "misc" "misc.el" (22164 57534 895192 607000)) +;;;### (autoloads nil "misc" "misc.el" (0 0 0 0)) ;;; Generated autoloads from misc.el +(autoload 'copy-from-above-command "misc" "\ +Copy characters from previous nonblank line, starting just above point. +Copy ARG characters, but not past the end of that line. +If no argument given, copy the entire rest of the line. +The characters copied are inserted in the buffer before point. + +\(fn &optional ARG)" t nil) + +(autoload 'zap-up-to-char "misc" "\ +Kill up to, but not including ARGth occurrence of CHAR. +Case is ignored if `case-fold-search' is non-nil in the current buffer. +Goes backward if ARG is negative; error if CHAR not found. +Ignores CHAR at point. + +\(fn ARG CHAR)" t nil) + +(autoload 'mark-beginning-of-buffer "misc" "\ +Set mark at the beginning of the buffer. + +\(fn)" t nil) + +(autoload 'mark-end-of-buffer "misc" "\ +Set mark at the end of the buffer. + +\(fn)" t nil) + +(autoload 'upcase-char "misc" "\ +Uppercasify ARG chars starting from point. Point doesn't move. + +\(fn ARG)" t nil) + +(autoload 'forward-to-word "misc" "\ +Move forward until encountering the beginning of a word. +With argument, do this that many times. + +\(fn ARG)" t nil) + +(autoload 'backward-to-word "misc" "\ +Move backward until encountering the end of a word. +With argument, do this that many times. + +\(fn ARG)" t nil) + (autoload 'butterfly "misc" "\ Use butterflies to flip the desired bit on the drive platter. Open hands and let the delicate wings flap once. The disturbance @@ -18476,10 +20982,11 @@ The return value is always nil. \(fn &optional LOADED-ONLY-P BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misc" '("list-dynamic-libraries--"))) + ;;;*** -;;;### (autoloads nil "misearch" "misearch.el" (22164 57534 895192 -;;;;;; 607000)) +;;;### (autoloads nil "misearch" "misearch.el" (0 0 0 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18565,10 +21072,12 @@ whose file names match the specified wildcard. \(fn FILES)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misearch" '("multi-isearch-" "misearch-unload-function"))) + ;;;*** -;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (22164 -;;;;;; 57535 511192 607000)) +;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/mixal-mode.el (push (purecopy '(mixal-mode 0 1)) package--builtin-versions) @@ -18577,10 +21086,32 @@ Major mode for the mixal asm language. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mixal-mode" '("mixal-"))) + +;;;*** + +;;;### (autoloads nil "mm-archive" "gnus/mm-archive.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mm-archive.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-archive" '("mm-"))) + ;;;*** -;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (22164 57534 -;;;;;; 635192 607000)) +;;;### (autoloads nil "mm-bodies" "gnus/mm-bodies.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mm-bodies.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-bodies" '("mm-"))) + +;;;*** + +;;;### (autoloads nil "mm-decode" "gnus/mm-decode.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mm-decode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-decode" '("mm-"))) + +;;;*** + +;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-encode.el (autoload 'mm-default-file-encoding "mm-encode" "\ @@ -18588,10 +21119,11 @@ Return a default encoding for FILE. \(fn FILE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-encode" '("mm-"))) + ;;;*** -;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (22164 57534 -;;;;;; 635192 607000)) +;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -18607,10 +21139,11 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. \(fn HANDLE &optional NO-DISPLAY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-extern" '("mm-extern-"))) + ;;;*** -;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (22205 48966 -;;;;;; 892819 751000)) +;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -18621,10 +21154,11 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. \(fn HANDLE &optional NO-DISPLAY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-partial" '("mm-partial-find-parts"))) + ;;;*** -;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (22208 25156 957078 -;;;;;; 435000)) +;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -18638,10 +21172,18 @@ Insert file contents of URL using `mm-url-program'. \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-url" '("mm-url-"))) + ;;;*** -;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (22208 25156 957078 -;;;;;; 435000)) +;;;### (autoloads nil "mm-util" "gnus/mm-util.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mm-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-util" '("mm-"))) + +;;;*** + +;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -18658,9 +21200,18 @@ Assume text has been decoded if DECODED is non-nil. \(fn HANDLE &optional DECODED)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-uu" '("mm-"))) + ;;;*** -;;;### (autoloads nil "mml" "gnus/mml.el" (22208 25156 961078 435000)) +;;;### (autoloads nil "mm-view" "gnus/mm-view.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mm-view.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-view" '("mm-"))) + +;;;*** + +;;;### (autoloads nil "mml" "gnus/mml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18683,10 +21234,25 @@ body) or \"attachment\" (separate from the body). \(fn FILE &optional TYPE DESCRIPTION DISPOSITION)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml" '("mime-to-mml" "mml-"))) + +;;;*** + +;;;### (autoloads nil "mml-sec" "gnus/mml-sec.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mml-sec.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-sec" '("mml-"))) + +;;;*** + +;;;### (autoloads nil "mml-smime" "gnus/mml-smime.el" (0 0 0 0)) +;;; Generated autoloads from gnus/mml-smime.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-smime" '("mml-smime-"))) + ;;;*** -;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (22205 48966 900819 -;;;;;; 751000)) +;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18699,10 +21265,11 @@ body) or \"attachment\" (separate from the body). \(fn CONT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml1991" '("mml1991-"))) + ;;;*** -;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (22207 4296 732349 -;;;;;; 691000)) +;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18740,18 +21307,20 @@ body) or \"attachment\" (separate from the body). \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml2015" '("mml2015-"))) + ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (22189 60738 -;;;;;; 45741 19000)) +;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (0 0 0 0)) ;;; Generated autoloads from cedet/mode-local.el (put 'define-overloadable-function 'doc-string-elt 3) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mode-local" '("make-obsolete-overload" "mode-local-" "deactivate-mode-local-bindings" "def" "describe-mode-local-" "xref-mode-local-" "overload-" "fetch-overload" "function-overload-p" "set" "with-mode-local" "activate-mode-local-bindings" "new-mode-local-bindings" "get-mode-local-parent"))) + ;;;*** -;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21607 54478 -;;;;;; 800121 42000)) +;;;### (autoloads nil "modula2" "progmodes/modula2.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18782,10 +21351,11 @@ followed by the first character of the construct. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "modula2" '("m3-font-lock-keywords" "m2-"))) + ;;;*** -;;;### (autoloads nil "morse" "play/morse.el" (22164 57535 303192 -;;;;;; 607000)) +;;;### (autoloads nil "morse" "play/morse.el" (0 0 0 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18808,10 +21378,18 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. \(fn BEG END)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "morse" '("nato-alphabet" "morse-code"))) + +;;;*** + +;;;### (autoloads nil "mouse-copy" "mouse-copy.el" (0 0 0 0)) +;;; Generated autoloads from mouse-copy.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-copy" '("mouse-"))) + ;;;*** -;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (22164 57534 895192 -;;;;;; 607000)) +;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (0 0 0 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18856,9 +21434,11 @@ To test this function, evaluate: \(fn START-EVENT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-drag" '("mouse-"))) + ;;;*** -;;;### (autoloads nil "mpc" "mpc.el" (22164 57534 911192 607000)) +;;;### (autoloads nil "mpc" "mpc.el" (0 0 0 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18866,9 +21446,11 @@ Main entry point for MPC. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes"))) + ;;;*** -;;;### (autoloads nil "mpuz" "play/mpuz.el" (22164 57535 303192 607000)) +;;;### (autoloads nil "mpuz" "play/mpuz.el" (0 0 0 0)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18876,14 +21458,17 @@ Multiplication puzzle with GNU Emacs. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpuz" '("mpuz-"))) + ;;;*** -;;;### (autoloads nil "msb" "msb.el" (22164 57534 911192 607000)) +;;;### (autoloads nil "msb" "msb.el" (0 0 0 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ Non-nil if Msb mode is enabled. -See the command `msb-mode' for a description of this minor mode. +See the `msb-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `msb-mode'.") @@ -18901,10 +21486,19 @@ different buffer menu using the function `msb'. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))) + ;;;*** -;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (22164 -;;;;;; 57534 751192 607000)) +;;;### (autoloads nil "mspools" "mail/mspools.el" (0 0 0 0)) +;;; Generated autoloads from mail/mspools.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mspools" '("mspools-"))) + +;;;*** + +;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -19034,10 +21628,12 @@ The default is 20. If LIMIT is negative, do not limit the listing. \(fn &optional LIMIT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-diag" '("insert-section" "list-" "print-" "describe-font-internal" "charset-history" "non-iso-charset-alist" "sort-listed-character-sets"))) + ;;;*** -;;;### (autoloads nil "mule-util" "international/mule-util.el" (22174 -;;;;;; 6972 628792 520000)) +;;;### (autoloads nil "mule-util" "international/mule-util.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -19194,10 +21790,18 @@ QUALITY can be: \(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis"))) + ;;;*** -;;;### (autoloads nil "net-utils" "net/net-utils.el" (22164 57534 -;;;;;; 931192 607000)) +;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0)) +;;; Generated autoloads from mwheel.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))) + +;;;*** + +;;;### (autoloads nil "net-utils" "net/net-utils.el" (0 0 0 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -19289,10 +21893,11 @@ Open a network connection to HOST on PORT. \(fn HOST PORT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "net-utils" '("nslookup-" "net" "whois-" "ftp-" "finger-X.500-host-regexps" "route-program" "run-network-program" "smbclient" "ifconfig-program" "iwconfig-program" "ipconfig" "dig-program" "dns-lookup-program" "arp-program" "ping-program" "traceroute-program"))) + ;;;*** -;;;### (autoloads nil "netrc" "net/netrc.el" (22164 57534 931192 -;;;;;; 607000)) +;;;### (autoloads nil "netrc" "net/netrc.el" (0 0 0 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -19302,10 +21907,12 @@ listed in the PORTS list. \(fn MACHINE &rest PORTS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "netrc" '("netrc-"))) + ;;;*** -;;;### (autoloads nil "network-stream" "net/network-stream.el" (22218 -;;;;;; 60997 160333 743000)) +;;;### (autoloads nil "network-stream" "net/network-stream.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -19321,8 +21928,8 @@ BUFFER is a buffer or buffer name to associate with the process. Process output goes at end of that buffer. BUFFER may be nil, meaning that the process is not associated with any buffer. HOST is the name or IP address of the host to connect to. -SERVICE is the name of the service desired, or an integer specifying - a port number to connect to. +SERVICE is the name of the service desired, or an integer or + integer string specifying a port number to connect to. The remaining PARAMETERS should be a sequence of keywords and values: @@ -19405,10 +22012,12 @@ gnutls-boot (as returned by `gnutls-boot-parameters'). (defalias 'open-protocol-stream 'open-network-stream) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "network-stream" '("network-stream-"))) + ;;;*** -;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (22164 -;;;;;; 57534 939192 607000)) +;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19427,10 +22036,12 @@ Run `newsticker-start-hook' if newsticker was not running already. \(fn &optional DO-NOT-COMPLAIN-IF-RUNNING)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-backend" '("newsticker-"))) + ;;;*** ;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el" -;;;;;; (22164 57534 939192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19438,10 +22049,12 @@ Start newsticker plainview. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-plainview" '("newsticker-"))) + ;;;*** -;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (22174 -;;;;;; 6972 660792 520000)) +;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -19449,10 +22062,12 @@ Start reading news. You may want to bind this to a key. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-reader" '("newsticker-"))) + ;;;*** -;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (22164 -;;;;;; 57534 939192 607000)) +;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from net/newst-ticker.el (autoload 'newsticker-ticker-running-p "newst-ticker" "\ @@ -19470,10 +22085,12 @@ running already. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-ticker" '("newsticker-"))) + ;;;*** -;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (22203 -;;;;;; 7237 642647 107000)) +;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19481,10 +22098,32 @@ Start newsticker treeview. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-treeview" '("newsticker-"))) + ;;;*** -;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (22208 25156 977078 -;;;;;; 435000)) +;;;### (autoloads nil "newsticker" "net/newsticker.el" (0 0 0 0)) +;;; Generated autoloads from net/newsticker.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newsticker" '("newsticker-version"))) + +;;;*** + +;;;### (autoloads nil "nnagent" "gnus/nnagent.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnagent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnagent" '("nnagent-"))) + +;;;*** + +;;;### (autoloads nil "nnbabyl" "gnus/nnbabyl.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnbabyl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnbabyl" '("nnbabyl-"))) + +;;;*** + +;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19492,10 +22131,18 @@ Generate NOV databases in all nndiary directories. \(fn &optional SERVER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndiary" '("nndiary-"))) + +;;;*** + +;;;### (autoloads nil "nndir" "gnus/nndir.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nndir.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndir" '("nndir-"))) + ;;;*** -;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (22205 48966 904819 -;;;;;; 751000)) +;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19507,10 +22154,25 @@ symbol in the alist. \(fn DEFINITION &optional POSITION)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndoc" '("nndoc-"))) + ;;;*** -;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (22208 25156 -;;;;;; 981078 435000)) +;;;### (autoloads nil "nndraft" "gnus/nndraft.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nndraft.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndraft" '("nndraft-"))) + +;;;*** + +;;;### (autoloads nil "nneething" "gnus/nneething.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nneething.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nneething" '("nneething-"))) + +;;;*** + +;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19519,9 +22181,74 @@ This command does not work if you use short group names. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnfolder" '("nnfolder-"))) + +;;;*** + +;;;### (autoloads nil "nngateway" "gnus/nngateway.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nngateway.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nngateway" '("nngateway-"))) + +;;;*** + +;;;### (autoloads nil "nnheader" "gnus/nnheader.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnheader.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnheader" '("nntp-" "nnheader-" "mail-header-" "make-" "gnus-"))) + +;;;*** + +;;;### (autoloads nil "nnimap" "gnus/nnimap.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnimap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnimap" '("nnimap"))) + +;;;*** + +;;;### (autoloads nil "nnir" "gnus/nnir.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnir.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnir" '("nnir-" "gnus-"))) + +;;;*** + +;;;### (autoloads nil "nnmail" "gnus/nnmail.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnmail.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmail" '("nnmail-"))) + +;;;*** + +;;;### (autoloads nil "nnmaildir" "gnus/nnmaildir.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnmaildir.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmaildir" '("nnmaildir-"))) + +;;;*** + +;;;### (autoloads nil "nnmairix" "gnus/nnmairix.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnmairix.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmairix" '("nnmairix-"))) + ;;;*** -;;;### (autoloads nil "nnml" "gnus/nnml.el" (22205 48966 952819 751000)) +;;;### (autoloads nil "nnmbox" "gnus/nnmbox.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnmbox.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmbox" '("nnmbox-"))) + +;;;*** + +;;;### (autoloads nil "nnmh" "gnus/nnmh.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnmh.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmh" '("nnmh-"))) + +;;;*** + +;;;### (autoloads nil "nnml" "gnus/nnml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19529,9 +22256,74 @@ Generate NOV databases in all nnml directories. \(fn &optional SERVER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnml" '("nnml-"))) + +;;;*** + +;;;### (autoloads nil "nnnil" "gnus/nnnil.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnnil.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnnil" '("nnnil-"))) + +;;;*** + +;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnoo.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnoo" '("nnoo-" "def"))) + +;;;*** + +;;;### (autoloads nil "nnregistry" "gnus/nnregistry.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnregistry.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnregistry" '("nnregistry-"))) + ;;;*** -;;;### (autoloads nil "novice" "novice.el" (22164 57535 35192 607000)) +;;;### (autoloads nil "nnrss" "gnus/nnrss.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnrss.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnrss" '("nnrss-"))) + +;;;*** + +;;;### (autoloads nil "nnspool" "gnus/nnspool.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnspool.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-"))) + +;;;*** + +;;;### (autoloads nil "nntp" "gnus/nntp.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nntp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nntp" '("nntp-"))) + +;;;*** + +;;;### (autoloads nil "nnvirtual" "gnus/nnvirtual.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnvirtual.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnvirtual" '("nnvirtual-"))) + +;;;*** + +;;;### (autoloads nil "nnweb" "gnus/nnweb.el" (0 0 0 0)) +;;; Generated autoloads from gnus/nnweb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnweb" '("nnweb-"))) + +;;;*** + +;;;### (autoloads nil "notifications" "notifications.el" (0 0 0 0)) +;;; Generated autoloads from notifications.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "notifications" '("notifications-"))) + +;;;*** + +;;;### (autoloads nil "novice" "novice.el" (0 0 0 0)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19561,10 +22353,12 @@ future sessions. \(fn COMMAND)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "novice" '("en/disable-command"))) + ;;;*** -;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (22164 -;;;;;; 57535 807192 607000)) +;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19576,16 +22370,40 @@ closing requests for requests that are used in matched pairs. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nroff-mode" '("nroff-"))) + ;;;*** -;;;### (autoloads nil "ntlm" "net/ntlm.el" (22164 57534 955192 607000)) +;;;### (autoloads nil "nsm" "net/nsm.el" (0 0 0 0)) +;;; Generated autoloads from net/nsm.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nsm" '("network-security-level" "nsm-"))) + +;;;*** + +;;;### (autoloads nil "ntlm" "net/ntlm.el" (0 0 0 0)) ;;; Generated autoloads from net/ntlm.el -(push (purecopy '(ntlm 2 0 0)) package--builtin-versions) +(push (purecopy '(ntlm 2 1 0)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ntlm" '("ntlm-"))) + +;;;*** + +;;;### (autoloads nil "nxml-enc" "nxml/nxml-enc.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-enc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-enc" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "nxml-maint" "nxml/nxml-maint.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-maint.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set"))) ;;;*** -;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (22171 30780 -;;;;;; 156984 795000)) +;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (0 0 0 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19643,10 +22461,388 @@ Many aspects this mode can be customized using \(fn)" t nil) (defalias 'xml-mode 'nxml-mode) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-mode" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "nxml-ns" "nxml/nxml-ns.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-ns.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-ns" '("nxml-ns-"))) + +;;;*** + +;;;### (autoloads nil "nxml-outln" "nxml/nxml-outln.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-outln.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-outln" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "nxml-parse" "nxml/nxml-parse.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-parse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-parse" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "nxml-rap" "nxml/nxml-rap.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-rap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-rap" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "nxml-util" "nxml/nxml-util.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-util" '("nxml-"))) + +;;;*** + +;;;### (autoloads nil "ob-C" "org/ob-C.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-C.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-R.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-asymptote" "org/ob-asymptote.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from org/ob-asymptote.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-asymptote" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-awk" "org/ob-awk.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-awk.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-awk" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-calc" "org/ob-calc.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-calc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-calc" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-clojure.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-comint" "org/ob-comint.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-comint.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ob-core.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-core" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-css" "org/ob-css.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-css.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-css" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ditaa" "org/ob-ditaa.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ditaa.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ditaa" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-dot" "org/ob-dot.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-dot.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from org/ob-emacs-lisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-emacs-lisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-eval" "org/ob-eval.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-eval.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eval" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-exp" "org/ob-exp.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-exp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-fortran.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-fortran" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-gnuplot" "org/ob-gnuplot.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-gnuplot.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("org-babel-" "*org-babel-gnuplot-"))) + +;;;*** + +;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-haskell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-haskell" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-io" "org/ob-io.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-io.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-io" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-java" "org/ob-java.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-java.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-java" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-js" "org/ob-js.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-js.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-js" '("org-babel-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ob-keys" "org/ob-keys.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ob-keys.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-keys" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-latex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-" "convert-pdf"))) + +;;;*** + +;;;### (autoloads nil "ob-ledger" "org/ob-ledger.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ledger.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ledger" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-lilypond" "org/ob-lilypond.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-lilypond.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lilypond" '("org-babel-" "lilypond-mode"))) + +;;;*** + +;;;### (autoloads nil "ob-lisp" "org/ob-lisp.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-lisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ob-lob" "org/ob-lob.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ob-lob.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-makefile.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-makefile" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-maxima" "org/ob-maxima.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-maxima.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-maxima" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-mscgen" "org/ob-mscgen.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-mscgen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-mscgen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ocaml" "org/ob-ocaml.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ocaml.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ocaml" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-octave" "org/ob-octave.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-octave.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-octave" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-org" "org/ob-org.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-org.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-org" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-perl" "org/ob-perl.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-perl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-perl" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-picolisp" "org/ob-picolisp.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-picolisp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-picolisp" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-plantuml" "org/ob-plantuml.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-plantuml.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-"))) + +;;;*** + +;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-python.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-python" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ref" "org/ob-ref.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ref.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ref" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-ruby" "org/ob-ruby.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ruby.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ruby" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sass" "org/ob-sass.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-sass.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sass" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-scala" "org/ob-scala.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-scala.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scala" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-scheme" "org/ob-scheme.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-scheme.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scheme" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-screen" "org/ob-screen.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-screen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-screen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sh" "org/ob-sh.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-sh.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sh" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-shen" "org/ob-shen.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-shen.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shen" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-sql.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-" "dbstring-mysql"))) + +;;;*** + +;;;### (autoloads nil "ob-sqlite" "org/ob-sqlite.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-sqlite.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-table.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-table" '("org-"))) + ;;;*** -;;;### (autoloads nil "octave" "progmodes/octave.el" (22164 57535 -;;;;;; 515192 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "ob-tangle" "org/ob-tangle.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ob-tangle.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-tangle" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "octave" "progmodes/octave.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/octave.el (autoload 'octave-mode "octave" "\ @@ -19681,10 +22877,18 @@ startup file, `~/.emacs-octave'. (defalias 'run-octave 'inferior-octave) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "octave" '("octave-" "inferior-octave-"))) + ;;;*** -;;;### (autoloads nil "opascal" "progmodes/opascal.el" (22164 57535 -;;;;;; 527192 607000)) +;;;### (autoloads nil "ogonek" "international/ogonek.el" (0 0 0 0)) +;;; Generated autoloads from international/ogonek.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ogonek" '("ogonek-"))) + +;;;*** + +;;;### (autoloads nil "opascal" "progmodes/opascal.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/opascal.el (define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4") @@ -19717,9 +22921,11 @@ Coloring: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "opascal" '("opascal-"))) + ;;;*** -;;;### (autoloads nil "org" "org/org.el" (22189 60738 961741 19000)) +;;;### (autoloads nil "org" "org/org.el" (0 0 0 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19938,10 +23144,11 @@ Call the customize function with org as argument. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org" '("org" "turn-on-org-cdlatex"))) + ;;;*** -;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (22164 57535 -;;;;;; 151192 607000)) +;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (0 0 0 0)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -20212,10 +23419,42 @@ to override `appt-message-warning-time'. \(fn &optional REFRESH FILTER &rest ARGS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-"))) + ;;;*** -;;;### (autoloads nil "org-capture" "org/org-capture.el" (22164 57535 -;;;;;; 151192 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "org-archive" +;;;;;; "org/org-archive.el" (0 0 0 0)) +;;; Generated autoloads from org/org-archive.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-archive" '("org-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-attach" "org/org-attach.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-attach.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach" '("org-attach-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-bbdb" "org/org-bbdb.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-bbdb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bbdb" '("org-bbdb-"))) + +;;;*** + +;;;### (autoloads nil "org-bibtex" "org/org-bibtex.el" (0 0 0 0)) +;;; Generated autoloads from org/org-bibtex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bibtex" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-capture" "org/org-capture.el" (0 0 0 0)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -20255,10 +23494,19 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-clock" "org/org-clock.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-clock.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-clock" '("org-"))) + ;;;*** -;;;### (autoloads nil "org-colview" "org/org-colview.el" (22164 57535 -;;;;;; 155192 607000)) +;;;### (autoloads nil "org-colview" "org/org-colview.el" (0 0 0 0)) ;;; Generated autoloads from org/org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -20319,10 +23567,11 @@ Turn on or update column view in the agenda. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-"))) + ;;;*** -;;;### (autoloads nil "org-compat" "org/org-compat.el" (22195 13278 -;;;;;; 247727 967000)) +;;;### (autoloads nil "org-compat" "org/org-compat.el" (0 0 0 0)) ;;; Generated autoloads from org/org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -20330,10 +23579,153 @@ Try very hard to provide sensible version strings. \(fn)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0)) +;;; Generated autoloads from org/org-crypt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0)) +;;; Generated autoloads from org/org-ctags.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-" "y-or-n-minibuffer"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-datetree" +;;;;;; "org/org-datetree.el" (0 0 0 0)) +;;; Generated autoloads from org/org-datetree.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-datetree" '("org-datetree-"))) + +;;;*** + +;;;### (autoloads nil "org-docview" "org/org-docview.el" (0 0 0 0)) +;;; Generated autoloads from org/org-docview.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-docview" '("org-docview-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-element" +;;;;;; "org/org-element.el" (0 0 0 0)) +;;; Generated autoloads from org/org-element.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-element" '("org-element-"))) + +;;;*** + +;;;### (autoloads nil "org-entities" "org/org-entities.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from org/org-entities.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("replace-amp" "org-entit"))) + +;;;*** + +;;;### (autoloads nil "org-eshell" "org/org-eshell.el" (0 0 0 0)) +;;; Generated autoloads from org/org-eshell.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eshell" '("org-eshell-"))) + +;;;*** + +;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0)) +;;; Generated autoloads from org/org-faces.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-faces" '("org-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-feed" "org/org-feed.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-feed.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-feed" '("org-feed-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-footnote" +;;;;;; "org/org-footnote.el" (0 0 0 0)) +;;; Generated autoloads from org/org-footnote.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-footnote" '("org-footnote-"))) + +;;;*** + +;;;### (autoloads nil "org-gnus" "org/org-gnus.el" (0 0 0 0)) +;;; Generated autoloads from org/org-gnus.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-gnus-"))) + +;;;*** + +;;;### (autoloads nil "org-habit" "org/org-habit.el" (0 0 0 0)) +;;; Generated autoloads from org/org-habit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-habit" '("org-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-id" "org/org-id.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-id.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-id" '("org-id-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-indent" "org/org-indent.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-indent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-info" "org/org-info.el" (0 0 0 0)) +;;; Generated autoloads from org/org-info.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-info" '("org-info-"))) + +;;;*** + +;;;### (autoloads nil "org-inlinetask" "org/org-inlinetask.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from org/org-inlinetask.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-inlinetask" '("org-inlinetask-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-irc" "org/org-irc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-irc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-irc" '("org-irc-"))) + +;;;*** + +;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0)) +;;; Generated autoloads from org/org-list.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-macro" "org/org-macro.el" (0 0 0 0)) +;;; Generated autoloads from org/org-macro.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macro" '("org-macro-"))) + ;;;*** -;;;### (autoloads nil "org-macs" "org/org-macs.el" (22164 57535 163192 -;;;;;; 607000)) +;;;### (autoloads nil "org-macs" "org/org-macs.el" (0 0 0 0)) ;;; Generated autoloads from org/org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ @@ -20341,10 +23733,87 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a \(fn FILE)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-"))) + +;;;*** + +;;;### (autoloads nil "org-mhe" "org/org-mhe.el" (0 0 0 0)) +;;; Generated autoloads from org/org-mhe.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mhe" '("org-mhe-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-mobile" "org/org-mobile.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-mobile.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mobile" '("org-mobile-"))) + +;;;*** + +;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0)) +;;; Generated autoloads from org/org-mouse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mouse" '("org-mouse-"))) + +;;;*** + +;;;### (autoloads nil "org-pcomplete" "org/org-pcomplete.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from org/org-pcomplete.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-plot" "org/org-plot.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-plot.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-plot" '("org-plot"))) + +;;;*** + +;;;### (autoloads nil "org-protocol" "org/org-protocol.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from org/org-protocol.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-"))) + +;;;*** + +;;;### (autoloads nil "org-rmail" "org/org-rmail.el" (0 0 0 0)) +;;; Generated autoloads from org/org-rmail.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-rmail" '("org-rmail-"))) + +;;;*** + +;;;### (autoloads nil "org-src" "org/org-src.el" (0 0 0 0)) +;;; Generated autoloads from org/org-src.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-src" '("org-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "org-table" "org/org-table.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-table.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org" "*orgtbl-"))) + ;;;*** -;;;### (autoloads nil "org-version" "org/org-version.el" (21607 54478 -;;;;;; 800121 42000)) +;;;### (autoloads "actual autoloads are elsewhere" "org-timer" "org/org-timer.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/org-timer.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-timer" '("org-timer-"))) + +;;;*** + +;;;### (autoloads nil "org-version" "org/org-version.el" (0 0 0 0)) ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ @@ -20361,8 +23830,14 @@ The Git version of org-mode. ;;;*** -;;;### (autoloads nil "outline" "outline.el" (22164 57535 255192 -;;;;;; 607000)) +;;;### (autoloads nil "org-w3m" "org/org-w3m.el" (0 0 0 0)) +;;; Generated autoloads from org/org-w3m.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-w3m" '("org-w3m-"))) + +;;;*** + +;;;### (autoloads nil "outline" "outline.el" (0 0 0 0)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) @@ -20403,9 +23878,107 @@ See the command `outline-mode' for more information on this mode. \(fn &optional ARG)" t nil) (put 'outline-level 'risky-local-variable t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "outline" '("outline-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox" "org/ox.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox" '("org-export-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-ascii" "org/ox-ascii.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-ascii.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-ascii" '("org-ascii-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-beamer" "org/ox-beamer.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-beamer.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-beamer" '("org-beamer-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-html" "org/ox-html.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-html.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-html" '("org-html-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-icalendar" +;;;;;; "org/ox-icalendar.el" (0 0 0 0)) +;;; Generated autoloads from org/ox-icalendar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-icalendar" '("org-icalendar-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-latex" "org/ox-latex.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-latex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-latex" '("org-latex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-man" "org/ox-man.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-man.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-md" "org/ox-md.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-md.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-md" '("org-md-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-odt" "org/ox-odt.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-odt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-odt" '("org-odt-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-org" "org/ox-org.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-org.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-org" '("org-org-"))) + ;;;*** -;;;### (autoloads nil "package" "emacs-lisp/package.el" t) +;;;### (autoloads "actual autoloads are elsewhere" "ox-publish" "org/ox-publish.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-publish.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-publish" '("org-publish-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "ox-texinfo" "org/ox-texinfo.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from org/ox-texinfo.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-texinfo" '("org-texinfo-"))) + +;;;*** + +;;;### (autoloads nil "package" "emacs-lisp/package.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/package.el (push (purecopy '(package 1 1 0)) package--builtin-versions) @@ -20429,6 +24002,9 @@ it to the file. If called as part of loading `user-init-file', set `package-enable-at-startup' to nil, to prevent accidentally loading packages twice. +It is not necessary to adjust `load-path' or `require' the +individual packages after calling `package-initialize' -- this is +taken care of by `package-initialize'. \(fn &optional NO-ACTIVATE)" t nil) @@ -20518,14 +24094,32 @@ The list is displayed in a buffer named `*Packages*'. (defalias 'package-list-packages 'list-packages) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package" '("package-" "define-package" "describe-package-1" "bad-signature"))) + ;;;*** -;;;### (autoloads nil "paren" "paren.el" (22164 57535 255192 607000)) +;;;### (autoloads nil "package-x" "emacs-lisp/package-x.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emacs-lisp/package-x.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package-x" '("package-"))) + +;;;*** + +;;;### (autoloads nil "page-ext" "textmodes/page-ext.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/page-ext.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "page-ext" '("previous-page" "pages-" "sort-pages-" "original-page-delimiter" "add-new-page" "next-page" "ctl-x-ctl-p-map"))) + +;;;*** + +;;;### (autoloads nil "paren" "paren.el" (0 0 0 0)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ Non-nil if Show-Paren mode is enabled. -See the command `show-paren-mode' for a description of this minor mode. +See the `show-paren-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `show-paren-mode'.") @@ -20544,24 +24138,31 @@ matching parenthesis is highlighted in `show-paren-style' after \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paren" '("show-paren-"))) + ;;;*** -;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (22226 -;;;;;; 55133 144211 947000)) +;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) (autoload 'parse-time-string "parse-time" "\ Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -The values are identical to those of `decode-time', but any values that are -unknown are returned as nil. +STRING should be on something resembling an RFC2822 string, a la +\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is +somewhat liberal in what format it accepts, and will attempt to +return a \"likely\" value even for somewhat malformed strings. +The values returned are identical to those of `decode-time', but +any values that are unknown are returned as nil. \(fn STRING)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parse-time" '("parse-"))) + ;;;*** -;;;### (autoloads nil "pascal" "progmodes/pascal.el" (22164 57535 -;;;;;; 535192 607000)) +;;;### (autoloads nil "pascal" "progmodes/pascal.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20608,10 +24209,12 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pascal" '("pascal-" "electric-pascal-"))) + ;;;*** -;;;### (autoloads nil "password-cache" "password-cache.el" (22164 -;;;;;; 57535 255192 607000)) +;;;### (autoloads nil "password-cache" "password-cache.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20630,10 +24233,11 @@ Check if KEY is in the cache. \(fn KEY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "password-cache" '("password-"))) + ;;;*** -;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (22195 13277 -;;;;;; 947727 967000)) +;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20734,9 +24338,9 @@ any kind of error. (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ +Like `dolist' but where the binding can be a `pcase' pattern. - -\(fn SPEC &rest BODY)" nil t) +\(fn (PATTERN LIST) BODY...)" nil t) (function-put 'pcase-dolist 'lisp-indent-function '1) @@ -20751,10 +24355,11 @@ to this macro. (function-put 'pcase-defmacro 'doc-string-elt '3) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcase" '("pcase-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (22164 57535 255192 -;;;;;; 607000)) +;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20762,10 +24367,11 @@ Completion rules for the `cvs' command. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (22224 13401 634549 -;;;;;; 811000)) +;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20795,10 +24401,11 @@ Completion for the GNU find utility. (defalias 'pcomplete/gdb 'pcomplete/xargs) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (22164 57535 -;;;;;; 255192 607000)) +;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20816,10 +24423,11 @@ Completion for GNU/Linux `mount'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-linux" '("pcomplete-pare-list" "pcmpl-linux-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (22164 57535 259192 -;;;;;; 607000)) +;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20827,10 +24435,11 @@ Completion for the `rpm' command. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (22164 57535 259192 -;;;;;; 607000)) +;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -20883,10 +24492,11 @@ Includes files as well as host names followed by a colon. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-unix" '("pcmpl-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (22164 57535 259192 -;;;;;; 607000)) +;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-x.el (autoload 'pcomplete/tlmgr "pcmpl-x" "\ @@ -20908,10 +24518,11 @@ Completion for the `ag' command. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-x" '("pcmpl-x-"))) + ;;;*** -;;;### (autoloads nil "pcomplete" "pcomplete.el" (22164 57535 259192 -;;;;;; 607000)) +;;;### (autoloads nil "pcomplete" "pcomplete.el" (0 0 0 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -20966,9 +24577,11 @@ Setup `shell-mode' to use pcomplete. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcomplete" '("pcomplete-"))) + ;;;*** -;;;### (autoloads nil "pcvs" "vc/pcvs.el" (22189 60739 309741 19000)) +;;;### (autoloads nil "pcvs" "vc/pcvs.el" (0 0 0 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -21041,19 +24654,43 @@ Anything else means to do it only if the prefix arg is equal to this value.") Run `cvs-examine' if DIR is a CVS administrative directory. The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp dir) (setq dir (directory-file-name dir)) (when (and (string= "CVS" (file-name-nondirectory dir)) (file-readable-p (expand-file-name "Entries" dir)) cvs-dired-use-hook (if (eq cvs-dired-use-hook (quote always)) (not current-prefix-arg) (equal current-prefix-arg cvs-dired-use-hook))) (save-excursion (funcall cvs-dired-action (file-name-directory dir) t t))))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode"))) + ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (22164 57535 -;;;;;; 859192 607000)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (0 0 0 0)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\ Global menu used by PCL-CVS.") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-defs" '("cvs-"))) + +;;;*** + +;;;### (autoloads nil "pcvs-info" "vc/pcvs-info.el" (0 0 0 0)) +;;; Generated autoloads from vc/pcvs-info.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-info" '("cvs-"))) + ;;;*** -;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (22164 -;;;;;; 57535 539192 607000)) +;;;### (autoloads nil "pcvs-parse" "vc/pcvs-parse.el" (0 0 0 0)) +;;; Generated autoloads from vc/pcvs-parse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-parse" '("cvs-"))) + +;;;*** + +;;;### (autoloads nil "pcvs-util" "vc/pcvs-util.el" (0 0 0 0)) +;;; Generated autoloads from vc/pcvs-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-util" '("cvs-"))) + +;;;*** + +;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -21112,10 +24749,11 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "perl-mode" '("perl-" "mark-perl-function" "indent-perl-exp"))) + ;;;*** -;;;### (autoloads nil "picture" "textmodes/picture.el" (22164 57535 -;;;;;; 807192 607000)) +;;;### (autoloads nil "picture" "textmodes/picture.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -21193,10 +24831,11 @@ they are not by default assigned to keys. (defalias 'edit-picture 'picture-mode) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "picture" '("picture-"))) + ;;;*** -;;;### (autoloads nil "pinentry" "net/pinentry.el" (22220 16330 783423 -;;;;;; 271000)) +;;;### (autoloads nil "pinentry" "net/pinentry.el" (0 0 0 0)) ;;; Generated autoloads from net/pinentry.el (push (purecopy '(pinentry 0 1)) package--builtin-versions) @@ -21211,9 +24850,11 @@ will not be shown. \(fn &optional QUIET)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pinentry" '("pinentry-"))) + ;;;*** -;;;### (autoloads nil "plstore" "plstore.el" (22221 37190 24505 663000)) +;;;### (autoloads nil "plstore" "plstore.el" (0 0 0 0)) ;;; Generated autoloads from plstore.el (autoload 'plstore-open "plstore" "\ @@ -21226,10 +24867,11 @@ Major mode for editing PLSTORE files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "plstore" '("plstore-"))) + ;;;*** -;;;### (autoloads nil "po" "textmodes/po.el" (22164 57535 807192 -;;;;;; 607000)) +;;;### (autoloads nil "po" "textmodes/po.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -21238,9 +24880,11 @@ Called through `file-coding-system-alist', before the file is visited for real. \(fn ARG-LIST)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "po" '("po-"))) + ;;;*** -;;;### (autoloads nil "pong" "play/pong.el" (22164 57535 303192 607000)) +;;;### (autoloads nil "pong" "play/pong.el" (0 0 0 0)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -21254,9 +24898,11 @@ pong-mode keybindings:\\<pong-mode-map> \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pong" '("pong-"))) + ;;;*** -;;;### (autoloads nil "pop3" "net/pop3.el" (22221 37189 976505 663000)) +;;;### (autoloads nil "pop3" "net/pop3.el" (0 0 0 0)) ;;; Generated autoloads from net/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -21265,10 +24911,11 @@ Use streaming commands. \(fn FILE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pop3" '("pop3-"))) + ;;;*** -;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (22164 57534 207192 -;;;;;; 607000)) +;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -21316,10 +24963,11 @@ Ignores leading comment characters. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pp" '("pp-"))) + ;;;*** -;;;### (autoloads nil "printing" "printing.el" (22164 57535 315192 -;;;;;; 607000)) +;;;### (autoloads nil "printing" "printing.el" (0 0 0 0)) ;;; Generated autoloads from printing.el (push (purecopy '(printing 6 9 3)) package--builtin-versions) @@ -21905,9 +25553,11 @@ are both set to t. \(fn &optional SELECT-PRINTER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "printing" '("pr-" "lpr-setup"))) + ;;;*** -;;;### (autoloads nil "proced" "proced.el" (22221 37190 44505 663000)) +;;;### (autoloads nil "proced" "proced.el" (0 0 0 0)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -21923,10 +25573,11 @@ Proced buffers. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "proced" '("proced-"))) + ;;;*** -;;;### (autoloads nil "profiler" "profiler.el" (22164 57535 319192 -;;;;;; 607000)) +;;;### (autoloads nil "profiler" "profiler.el" (0 0 0 0)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -21952,16 +25603,19 @@ Open profile FILENAME. \(fn FILENAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "profiler" '("profiler-"))) + ;;;*** -;;;### (autoloads nil "project" "progmodes/project.el" (22189 60739 -;;;;;; 129741 19000)) +;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el (autoload 'project-current "project" "\ Return the project instance in DIR or `default-directory'. When no project found in DIR, and MAYBE-PROMPT is non-nil, ask -the user for a different directory to look in. +the user for a different directory to look in. If that directory +is not a part of a detectable project either, return a +`transient' project instance rooted in it. \(fn &optional MAYBE-PROMPT DIR)" nil nil) @@ -21993,10 +25647,11 @@ recognized. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-"))) + ;;;*** -;;;### (autoloads nil "prolog" "progmodes/prolog.el" (22195 13278 -;;;;;; 291727 967000)) +;;;### (autoloads nil "prolog" "progmodes/prolog.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -22027,9 +25682,11 @@ With prefix argument ARG, restart the Prolog process if running before. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "prolog" '("prolog-" "mercury-mode-map"))) + ;;;*** -;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (22164 57535 651192 607000)) +;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (0 0 0 0)) ;;; Generated autoloads from ps-bdf.el (defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\ @@ -22038,10 +25695,11 @@ The default value is (\"/usr/local/share/emacs/fonts/bdf\").") (custom-autoload 'bdf-directory-list "ps-bdf" t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-bdf" '("bdf-"))) + ;;;*** -;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (22164 57535 -;;;;;; 543192 607000)) +;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ps-mode.el (push (purecopy '(ps-mode 1 1 9)) package--builtin-versions) @@ -22085,10 +25743,19 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mode" '("ps-"))) + ;;;*** -;;;### (autoloads nil "ps-print" "ps-print.el" (22220 16330 855423 -;;;;;; 271000)) +;;;### (autoloads "actual autoloads are elsewhere" "ps-mule" "ps-mule.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from ps-mule.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mule" '("ps-mule-"))) + +;;;*** + +;;;### (autoloads nil "ps-print" "ps-print.el" (0 0 0 0)) ;;; Generated autoloads from ps-print.el (push (purecopy '(ps-print 7 3 5)) package--builtin-versions) @@ -22283,10 +25950,18 @@ If EXTENSION is any other symbol, it is ignored. \(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-print" '("ps-"))) + +;;;*** + +;;;### (autoloads nil "ps-samp" "ps-samp.el" (0 0 0 0)) +;;; Generated autoloads from ps-samp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-samp" '("ps-"))) + ;;;*** -;;;### (autoloads nil "pulse" "cedet/pulse.el" (22164 57533 943192 -;;;;;; 607000)) +;;;### (autoloads nil "pulse" "cedet/pulse.el" (0 0 0 0)) ;;; Generated autoloads from cedet/pulse.el (push (purecopy '(pulse 1 0)) package--builtin-versions) @@ -22302,12 +25977,20 @@ Optional argument FACE specifies the face to do the highlighting. \(fn START END &optional FACE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pulse" '("pulse-"))) + +;;;*** + +;;;### (autoloads nil "puny" "net/puny.el" (0 0 0 0)) +;;; Generated autoloads from net/puny.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "puny" '("puny-"))) + ;;;*** -;;;### (autoloads nil "python" "progmodes/python.el" (22189 60739 -;;;;;; 137741 19000)) +;;;### (autoloads nil "python" "progmodes/python.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/python.el -(push (purecopy '(python 0 25 1)) package--builtin-versions) +(push (purecopy '(python 0 25 2)) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode)) @@ -22340,9 +26023,11 @@ Major mode for editing Python files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "python" '("python-" "run-python-internal" "inferior-python-mode"))) + ;;;*** -;;;### (autoloads nil "qp" "mail/qp.el" (22221 37189 944505 663000)) +;;;### (autoloads nil "qp" "mail/qp.el" (0 0 0 0)) ;;; Generated autoloads from mail/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -22359,10 +26044,11 @@ them into characters should be done separately. \(fn FROM TO &optional CODING-SYSTEM)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "qp" '("quoted-printable-"))) + ;;;*** -;;;### (autoloads nil "quail" "international/quail.el" (22189 60738 -;;;;;; 377741 19000)) +;;;### (autoloads nil "quail" "international/quail.el" (0 0 0 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22590,10 +26276,20 @@ of each directory. \(fn DIRNAME &rest DIRNAMES)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail" '("quail-"))) + +;;;*** + +;;;### (autoloads nil "quail/ethiopic" "leim/quail/ethiopic.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from leim/quail/ethiopic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation"))) + ;;;*** -;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (22164 -;;;;;; 57534 791192 607000)) +;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from leim/quail/hangul.el (autoload 'hangul-input-method-activate "quail/hangul" "\ @@ -22603,10 +26299,72 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'. \(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/hangul" '("hangul" "alphabetp" "notzerop"))) + +;;;*** + +;;;### (autoloads nil "quail/indian" "leim/quail/indian.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from leim/quail/indian.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/indian" '("inscript-" "quail-"))) + +;;;*** + +;;;### (autoloads nil "quail/ipa" "leim/quail/ipa.el" (0 0 0 0)) +;;; Generated autoloads from leim/quail/ipa.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ipa" '("ipa-x-sampa-"))) + +;;;*** + +;;;### (autoloads nil "quail/japanese" "leim/quail/japanese.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from leim/quail/japanese.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/japanese" '("quail-japanese-"))) + +;;;*** + +;;;### (autoloads nil "quail/lao" "leim/quail/lao.el" (0 0 0 0)) +;;; Generated autoloads from leim/quail/lao.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation"))) + +;;;*** + +;;;### (autoloads nil "quail/lrt" "leim/quail/lrt.el" (0 0 0 0)) +;;; Generated autoloads from leim/quail/lrt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation"))) + +;;;*** + +;;;### (autoloads nil "quail/sisheng" "leim/quail/sisheng.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from leim/quail/sisheng.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-"))) + +;;;*** + +;;;### (autoloads nil "quail/thai" "leim/quail/thai.el" (0 0 0 0)) +;;; Generated autoloads from leim/quail/thai.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/thai" '("thai-generate-quail-map"))) + +;;;*** + +;;;### (autoloads nil "quail/tibetan" "leim/quail/tibetan.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from leim/quail/tibetan.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-"))) + ;;;*** ;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el" -;;;;;; (22164 57534 799192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from leim/quail/uni-input.el (autoload 'ucs-input-activate "quail/uni-input" "\ @@ -22618,10 +26376,18 @@ While this input method is active, the variable \(fn &optional ARG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/uni-input" '("ucs-input-"))) + +;;;*** + +;;;### (autoloads nil "quail/viqr" "leim/quail/viqr.el" (0 0 0 0)) +;;; Generated autoloads from leim/quail/viqr.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))) + ;;;*** -;;;### (autoloads nil "quickurl" "net/quickurl.el" (22164 57534 955192 -;;;;;; 607000)) +;;;### (autoloads nil "quickurl" "net/quickurl.el" (0 0 0 0)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -22690,10 +26456,19 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quickurl" '("quickurl-"))) + ;;;*** -;;;### (autoloads nil "rcirc" "net/rcirc.el" (22191 16060 565822 -;;;;;; 179000)) +;;;### (autoloads nil "radix-tree" "emacs-lisp/radix-tree.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from emacs-lisp/radix-tree.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "radix-tree" '("radix-tree-"))) + +;;;*** + +;;;### (autoloads nil "rcirc" "net/rcirc.el" (0 0 0 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22714,7 +26489,8 @@ If ARG is non-nil, instead prompt for connection parameters. (defvar rcirc-track-minor-mode nil "\ Non-nil if Rcirc-Track minor mode is enabled. -See the command `rcirc-track-minor-mode' for a description of this minor mode. +See the `rcirc-track-minor-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `rcirc-track-minor-mode'.") @@ -22729,10 +26505,12 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rcirc" '("rcirc-" "defun-rcirc-command" "set-rcirc-" "with-rcirc-"))) + ;;;*** -;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (22164 -;;;;;; 57534 211192 607000)) +;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -22748,15 +26526,17 @@ matching parts of the target buffer will be highlighted. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "re-builder" '("reb-" "re-builder-unload-function"))) + ;;;*** -;;;### (autoloads nil "recentf" "recentf.el" (22164 57535 675192 -;;;;;; 607000)) +;;;### (autoloads nil "recentf" "recentf.el" (0 0 0 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ Non-nil if Recentf mode is enabled. -See the command `recentf-mode' for a description of this minor mode. +See the `recentf-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `recentf-mode'.") @@ -22775,9 +26555,11 @@ were operated on recently. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "recentf" '("recentf-"))) + ;;;*** -;;;### (autoloads nil "rect" "rect.el" (22174 6972 772792 520000)) +;;;### (autoloads nil "rect" "rect.el" (0 0 0 0)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -22818,7 +26600,7 @@ With a prefix (or a FILL) argument, also fill lines where nothing has to be deleted. If the buffer is read-only, Emacs will beep and refrain from deleting -the rectangle, but put it in the kill ring anyway. This means that +the rectangle, but put it in `killed-rectangle' anyway. This means that you can use this command to copy text from a read-only buffer. \(If the variable `kill-read-only-ok' is non-nil, then this won't even beep.) @@ -22863,7 +26645,7 @@ no text on the right side of the rectangle. Delete all whitespace following a specified column in each line. The left edge of the rectangle specifies the position in each line at which whitespace deletion should begin. On each line in the -rectangle, all continuous whitespace starting at that column is deleted. +rectangle, all contiguous whitespace starting at that column is deleted. When called from a program the rectangle's corners are START and END. With a prefix (or a FILL) argument, also fill too short lines. @@ -22915,10 +26697,25 @@ Activates the region if needed. Only lasts until the region is deactivated. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rect" '("rectangle-" "clear-rectangle-line" "spaces-string" "string-rectangle-" "delete-" "ope" "killed-rectangle" "extract-rectangle-" "apply-on-rectangle"))) + +;;;*** + +;;;### (autoloads nil "refbib" "textmodes/refbib.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/refbib.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refbib" '("r2b-"))) + +;;;*** + +;;;### (autoloads nil "refer" "textmodes/refer.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/refer.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refer" '("refer-"))) + ;;;*** -;;;### (autoloads nil "refill" "textmodes/refill.el" (22164 57535 -;;;;;; 811192 607000)) +;;;### (autoloads nil "refill" "textmodes/refill.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -22936,10 +26733,11 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refill" '("refill-"))) + ;;;*** -;;;### (autoloads nil "reftex" "textmodes/reftex.el" (22164 57535 -;;;;;; 815192 607000)) +;;;### (autoloads nil "reftex" "textmodes/reftex.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'reftex-citation "reftex-cite" nil t) (autoload 'reftex-all-document-files "reftex-parse") @@ -22990,36 +26788,138 @@ This enforces rescanning the buffer on next use. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-auc" "textmodes/reftex-auc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-auc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-auc" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-cite" +;;;;;; "textmodes/reftex-cite.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-cite.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-cite" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-dcr" "textmodes/reftex-dcr.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-dcr.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-dcr" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-global" +;;;;;; "textmodes/reftex-global.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-global.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-global" '("reftex-"))) + ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (22189 -;;;;;; 60739 285741 19000)) +;;;### (autoloads "actual autoloads are elsewhere" "reftex-index" +;;;;;; "textmodes/reftex-index.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-index.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-index" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-parse" +;;;;;; "textmodes/reftex-parse.el" (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-parse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-parse" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-ref" "textmodes/reftex-ref.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-ref.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-ref" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-sel" "textmodes/reftex-sel.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-sel.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-sel" '("reftex-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "reftex-toc" "textmodes/reftex-toc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/reftex-toc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-toc" '("reftex-"))) + +;;;*** + +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-level-indent 'safe-local-variable 'integerp) (put 'reftex-guess-label-type 'safe-local-variable (lambda (x) (memq x '(nil t)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-vars" '("reftex-"))) + ;;;*** -;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (22164 -;;;;;; 57534 211192 607000)) +;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ Return a regexp to match a string in the list STRINGS. -Each string should be unique in STRINGS and should not contain any regexps, -quoted or not. If optional PAREN is non-nil, ensure that the returned regexp -is enclosed by at least one regexp grouping construct. -The returned regexp is typically more efficient than the equivalent regexp: +Each string should be unique in STRINGS and should not contain +any regexps, quoted or not. Optional PAREN specifies how the +returned regexp is surrounded by grouping constructs. + +The optional argument PAREN can be any of the following: + +a string + the resulting regexp is preceded by PAREN and followed by + \\), e.g. use \"\\\\(?1:\" to produce an explicitly numbered + group. + +`words' + the resulting regexp is surrounded by \\=\\<\\( and \\)\\>. - (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\"))) - (concat open (mapconcat \\='regexp-quote STRINGS \"\\\\|\") close)) +`symbols' + the resulting regexp is surrounded by \\_<\\( and \\)\\_>. -If PAREN is `words', then the resulting regexp is additionally surrounded -by \\=\\< and \\>. -If PAREN is `symbols', then the resulting regexp is additionally surrounded -by \\=\\_< and \\_>. +non-nil + the resulting regexp is surrounded by \\( and \\). + +nil + the resulting regexp is surrounded by \\(?: and \\), if it is + necessary to ensure that a postfix operator appended to it will + apply to the whole expression. + +The resulting regexp is equivalent to but usually more efficient +than that of a simplified version: + + (defun simplified-regexp-opt (strings &optional paren) + (let ((parens + (cond ((stringp paren) (cons paren \"\\\\)\")) + ((eq paren 'words) '(\"\\\\\\=<\\\\(\" . \"\\\\)\\\\>\")) + ((eq paren 'symbols) '(\"\\\\_<\\\\(\" . \"\\\\)\\\\_>\")) + ((null paren) '(\"\\\\(?:\" . \"\\\\)\")) + (t '(\"\\\\(\" . \"\\\\)\"))))) + (concat (car paren) + (mapconcat 'regexp-quote strings \"\\\\|\") + (cdr paren)))) \(fn STRINGS &optional PAREN)" nil nil) @@ -23030,17 +26930,26 @@ This means the number of non-shy regexp grouping constructs \(fn REGEXP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regexp-opt" '("regexp-opt-"))) + ;;;*** -;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (22164 57534 211192 -;;;;;; 607000)) +;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/regi.el (push (purecopy '(regi 1 8)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regi" '("regi-"))) + +;;;*** + +;;;### (autoloads nil "registry" "registry.el" (0 0 0 0)) +;;; Generated autoloads from registry.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "registry" '("registry-"))) + ;;;*** -;;;### (autoloads nil "remember" "textmodes/remember.el" (22164 57535 -;;;;;; 815192 607000)) +;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/remember.el (push (purecopy '(remember 2 0)) package--builtin-versions) @@ -23092,9 +27001,11 @@ to turn the *scratch* buffer into your notes buffer. \(fn &optional SWITCH-TO)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "remember" '("remember-"))) + ;;;*** -;;;### (autoloads nil "repeat" "repeat.el" (22164 57535 675192 607000)) +;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0)) ;;; Generated autoloads from repeat.el (push (purecopy '(repeat 0 51)) package--builtin-versions) @@ -23115,10 +27026,11 @@ recently executed command not bound to an input event\". \(fn REPEAT-ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "repeat" '("repeat-"))) + ;;;*** -;;;### (autoloads nil "reporter" "mail/reporter.el" (22164 57534 -;;;;;; 811192 607000)) +;;;### (autoloads nil "reporter" "mail/reporter.el" (0 0 0 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -23147,10 +27059,11 @@ mail-sending package is used for editing and sending the message. \(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reporter" '("reporter-"))) + ;;;*** -;;;### (autoloads nil "reposition" "reposition.el" (22164 57535 679192 -;;;;;; 607000)) +;;;### (autoloads nil "reposition" "reposition.el" (0 0 0 0)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -23174,9 +27087,11 @@ first comment line visible (if point is in a comment). \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reposition" '("repos-count-screen-lines"))) + ;;;*** -;;;### (autoloads nil "reveal" "reveal.el" (22164 57535 679192 607000)) +;;;### (autoloads nil "reveal" "reveal.el" (0 0 0 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -23192,7 +27107,8 @@ reveals invisible text around point. (defvar global-reveal-mode nil "\ Non-nil if Global Reveal mode is enabled. -See the command `global-reveal-mode' for a description of this minor mode. +See the `global-reveal-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-reveal-mode'.") @@ -23209,10 +27125,61 @@ the mode if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reveal" '("reveal-"))) + +;;;*** + +;;;### (autoloads nil "rfc1843" "international/rfc1843.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from international/rfc1843.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc1843" '("rfc1843-"))) + ;;;*** -;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (22164 57534 211192 -;;;;;; 607000)) +;;;### (autoloads nil "rfc2045" "mail/rfc2045.el" (0 0 0 0)) +;;; Generated autoloads from mail/rfc2045.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2045" '("rfc2045-encode-string"))) + +;;;*** + +;;;### (autoloads nil "rfc2047" "mail/rfc2047.el" (0 0 0 0)) +;;; Generated autoloads from mail/rfc2047.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2047" '("rfc2047-"))) + +;;;*** + +;;;### (autoloads nil "rfc2104" "net/rfc2104.el" (0 0 0 0)) +;;; Generated autoloads from net/rfc2104.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2104" '("rfc2104-"))) + +;;;*** + +;;;### (autoloads nil "rfc2231" "mail/rfc2231.el" (0 0 0 0)) +;;; Generated autoloads from mail/rfc2231.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2231" '("rfc2231-"))) + +;;;*** + +;;;### (autoloads nil "rfc2368" "mail/rfc2368.el" (0 0 0 0)) +;;; Generated autoloads from mail/rfc2368.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2368" '("rfc2368-"))) + +;;;*** + +;;;### (autoloads nil "rfc822" "mail/rfc822.el" (0 0 0 0)) +;;; Generated autoloads from mail/rfc822.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc822" '("rfc822-"))) + +;;;*** + +;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -23225,10 +27192,11 @@ Make a ring that can contain SIZE elements. \(fn SIZE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ring" '("ring-"))) + ;;;*** -;;;### (autoloads nil "rlogin" "net/rlogin.el" (22164 57534 959192 -;;;;;; 607000)) +;;;### (autoloads nil "rlogin" "net/rlogin.el" (0 0 0 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -23270,10 +27238,11 @@ variable. \(fn INPUT-ARGS &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rlogin" '("rlogin-"))) + ;;;*** -;;;### (autoloads nil "rmail" "mail/rmail.el" (22174 6972 640792 -;;;;;; 520000)) +;;;### (autoloads nil "rmail" "mail/rmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -23281,9 +27250,9 @@ Name of user's primary mail file.") (custom-autoload 'rmail-file-name "rmail" t) -(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/")))) +(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/")))) -(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/"))) "\ +(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\ Name of directory used by system mailer for delivering new mail. Its name should end with a slash.") @@ -23468,10 +27437,43 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. \(fn PASSWORD)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail" '("rmail-" "mail-"))) + +;;;*** + +;;;### (autoloads nil "rmail-spam-filter" "mail/rmail-spam-filter.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmail-spam-filter.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "rmailedit" "mail/rmailedit.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmailedit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailedit" '("rmail-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "rmailkwd" "mail/rmailkwd.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmailkwd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailkwd" '("rmail-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "rmailmm" "mail/rmailmm.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmailmm.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailmm" '("rmail-"))) + ;;;*** -;;;### (autoloads nil "rmailout" "mail/rmailout.el" (22164 57534 -;;;;;; 831192 607000)) +;;;### (autoloads nil "rmailout" "mail/rmailout.el" (0 0 0 0)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -23533,10 +27535,27 @@ than appending to it. Deletes the message after writing if \(fn FILE-NAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailout" '("rmail-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "rmailsort" "mail/rmailsort.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmailsort.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsort" '("rmail-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "rmailsum" "mail/rmailsum.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/rmailsum.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsum" '("rmail-"))) + ;;;*** -;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (22183 21960 -;;;;;; 606603 947000)) +;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (0 0 0 0)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23545,10 +27564,39 @@ Return a pattern. \(fn FILENAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-cmpct" '("rng-"))) + ;;;*** -;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (22171 30780 -;;;;;; 160984 795000)) +;;;### (autoloads nil "rng-dt" "nxml/rng-dt.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-dt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-dt" '("rng-dt-"))) + +;;;*** + +;;;### (autoloads nil "rng-loc" "nxml/rng-loc.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-loc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-loc" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-maint" "nxml/rng-maint.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-maint.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-maint" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-match" "nxml/rng-match.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-match.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-match" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (0 0 0 0)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23558,10 +27606,39 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-nxml" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-parse" "nxml/rng-parse.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-parse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-parse" '("rng-parse-"))) + ;;;*** -;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (22171 30780 -;;;;;; 172984 795000)) +;;;### (autoloads nil "rng-pttrn" "nxml/rng-pttrn.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-pttrn.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-pttrn" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-uri" "nxml/rng-uri.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-uri.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-uri" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-util" "nxml/rng-util.el" (0 0 0 0)) +;;; Generated autoloads from nxml/rng-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-util" '("rng-"))) + +;;;*** + +;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (0 0 0 0)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23589,10 +27666,11 @@ to use for finding the schema. \(fn &optional ARG NO-CHANGE-SCHEMA)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-valid" '("rng-"))) + ;;;*** -;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (22170 9914 185954 -;;;;;; 164000)) +;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (0 0 0 0)) ;;; Generated autoloads from nxml/rng-xsd.el (put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile) @@ -23617,10 +27695,11 @@ must be equal. \(fn NAME PARAMS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates"))) + ;;;*** -;;;### (autoloads nil "robin" "international/robin.el" (21953 58033 -;;;;;; 303058 929000)) +;;;### (autoloads nil "robin" "international/robin.el" (0 0 0 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23650,13 +27729,18 @@ Start using robin package NAME, which is a string. \(fn NAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "robin" '("robin-"))) + ;;;*** -;;;### (autoloads nil "rot13" "rot13.el" (22164 57535 679192 607000)) +;;;### (autoloads nil "rot13" "rot13.el" (0 0 0 0)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ -Return ROT13 encryption of OBJECT, a buffer or string. +ROT13 encrypt OBJECT, a buffer or string. +If OBJECT is a buffer, encrypt the region between START and END. +If OBJECT is a string, encrypt it in its entirety, ignoring START +and END, and return the encrypted string. \(fn OBJECT &optional START END)" nil nil) @@ -23687,10 +27771,11 @@ Toggle the use of ROT13 encoding for the current window. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rot13" '("rot13-"))) + ;;;*** -;;;### (autoloads nil "rst" "textmodes/rst.el" (22164 57535 819192 -;;;;;; 607000)) +;;;### (autoloads nil "rst" "textmodes/rst.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23718,10 +27803,19 @@ for modes derived from Text mode, like Mail mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rst" '("rst-"))) + +;;;*** + +;;;### (autoloads nil "rtree" "rtree.el" (0 0 0 0)) +;;; Generated autoloads from rtree.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rtree" '("rtree-"))) + ;;;*** -;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (22189 -;;;;;; 60739 145741 19000)) +;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (push (purecopy '(ruby-mode 1 2)) package--builtin-versions) @@ -23736,10 +27830,11 @@ Major mode for editing Ruby code. (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruby-mode" '("ruby-"))) + ;;;*** -;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (22164 57535 683192 -;;;;;; 607000)) +;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0)) ;;; Generated autoloads from ruler-mode.el (push (purecopy '(ruler-mode 1 6)) package--builtin-versions) @@ -23755,10 +27850,11 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruler-mode" '("ruler-"))) + ;;;*** -;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (22164 57534 211192 -;;;;;; 607000)) +;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24067,23 +28163,55 @@ enclosed in `(and ...)'. \(fn &rest REGEXPS)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rx" '("rx-"))) + ;;;*** -;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (22164 57534 -;;;;;; 963192 607000)) +;;;### (autoloads nil "sasl" "net/sasl.el" (0 0 0 0)) +;;; Generated autoloads from net/sasl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl" '("sasl-"))) + +;;;*** + +;;;### (autoloads nil "sasl-cram" "net/sasl-cram.el" (0 0 0 0)) +;;; Generated autoloads from net/sasl-cram.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-cram" '("sasl-cram-md5-"))) + +;;;*** + +;;;### (autoloads nil "sasl-digest" "net/sasl-digest.el" (0 0 0 0)) +;;; Generated autoloads from net/sasl-digest.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-digest" '("sasl-digest-md5-"))) + +;;;*** + +;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (0 0 0 0)) ;;; Generated autoloads from net/sasl-ntlm.el (push (purecopy '(sasl 1 0)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-"))) + ;;;*** -;;;### (autoloads nil "savehist" "savehist.el" (22164 57535 683192 -;;;;;; 607000)) +;;;### (autoloads nil "sasl-scram-rfc" "net/sasl-scram-rfc.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from net/sasl-scram-rfc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-"))) + +;;;*** + +;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) (defvar savehist-mode nil "\ Non-nil if Savehist mode is enabled. -See the command `savehist-mode' for a description of this minor mode. +See the `savehist-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `savehist-mode'.") @@ -24107,15 +28235,17 @@ histories, which is probably undesirable. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "savehist" '("savehist-"))) + ;;;*** -;;;### (autoloads nil "saveplace" "saveplace.el" (22164 57535 683192 -;;;;;; 607000)) +;;;### (autoloads nil "saveplace" "saveplace.el" (0 0 0 0)) ;;; Generated autoloads from saveplace.el (defvar save-place-mode nil "\ Non-nil if Save-Place mode is enabled. -See the command `save-place-mode' for a description of this minor mode. +See the `save-place-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `save-place-mode'.") @@ -24129,10 +28259,34 @@ where it was when you previously visited the same file. \(fn &optional ARG)" t nil) +(autoload 'save-place-local-mode "saveplace" "\ +Toggle whether to save your place in this file between sessions. +If this mode is enabled, point is recorded when you kill the buffer +or exit Emacs. Visiting this file again will go to that position, +even in a later Emacs session. + +If called with a prefix arg, the mode is enabled if and only if +the argument is positive. + +To save places automatically in all files, put this in your init +file: + +\(save-place-mode 1) + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "saveplace" '("save-place" "load-save-place-alist-from-file"))) + ;;;*** -;;;### (autoloads nil "scheme" "progmodes/scheme.el" (22220 16330 -;;;;;; 815423 271000)) +;;;### (autoloads nil "sb-image" "sb-image.el" (0 0 0 0)) +;;; Generated autoloads from sb-image.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sb-image" '("speedbar-" "defimage-speedbar"))) + +;;;*** + +;;;### (autoloads nil "scheme" "progmodes/scheme.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24169,10 +28323,11 @@ that variable's value is a string. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scheme" '("scheme-" "dsssl-"))) + ;;;*** -;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (22164 57534 -;;;;;; 695192 607000)) +;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (0 0 0 0)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -24183,15 +28338,17 @@ This mode is an extended emacs-lisp mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-"))) + ;;;*** -;;;### (autoloads nil "scroll-all" "scroll-all.el" (22164 57535 683192 -;;;;;; 607000)) +;;;### (autoloads nil "scroll-all" "scroll-all.el" (0 0 0 0)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ Non-nil if Scroll-All mode is enabled. -See the command `scroll-all-mode' for a description of this minor mode. +See the `scroll-all-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `scroll-all-mode'.") @@ -24209,10 +28366,18 @@ one window apply to all visible windows in the same frame. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-all" '("scroll-all-"))) + +;;;*** + +;;;### (autoloads nil "scroll-bar" "scroll-bar.el" (0 0 0 0)) +;;; Generated autoloads from scroll-bar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-bar" '("set-scroll-bar-mode" "scroll-bar-" "toggle-" "horizontal-scroll-bar" "get-scroll-bar-mode" "previous-scroll-bar-mode"))) + ;;;*** -;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (22164 57535 -;;;;;; 683192 607000)) +;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (0 0 0 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -24226,18 +28391,20 @@ vertically fixed relative to window boundaries during scrolling. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-lock" '("scroll-lock-"))) + ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (22164 57534 963192 -;;;;;; 607000)) +;;;### (autoloads nil "secrets" "net/secrets.el" (0 0 0 0)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) (autoload 'secrets-show-secrets "secrets" nil t)) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "secrets" '("secrets-"))) + ;;;*** -;;;### (autoloads nil "semantic" "cedet/semantic.el" (22164 57533 -;;;;;; 947192 607000)) +;;;### (autoloads nil "semantic" "cedet/semantic.el" (0 0 0 0)) ;;; Generated autoloads from cedet/semantic.el (push (purecopy '(semantic 2 2)) package--builtin-versions) @@ -24269,7 +28436,8 @@ The following modes are more targeted at people who want to see (defvar semantic-mode nil "\ Non-nil if Semantic mode is enabled. -See the command `semantic-mode' for a description of this minor mode. +See the `semantic-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `semantic-mode'.") @@ -24292,10 +28460,92 @@ Semantic mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic" '("semantic-" "bovinate"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze" +;;;;;; "cedet/semantic/analyze.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/analyze.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze" '("semantic-a"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/complete" +;;;;;; "cedet/semantic/analyze/complete.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/analyze/complete.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-"))) + +;;;*** + +;;;### (autoloads nil "semantic/analyze/debug" "cedet/semantic/analyze/debug.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/analyze/debug.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze"))) + +;;;*** + +;;;### (autoloads nil "semantic/analyze/fcn" "cedet/semantic/analyze/fcn.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/analyze/fcn.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/refs" +;;;;;; "cedet/semantic/analyze/refs.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/analyze/refs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/refs" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine" +;;;;;; "cedet/semantic/bovine.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/c" +;;;;;; "cedet/semantic/bovine/c.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/c.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/c" '("semantic" "c++-mode" "c-mode"))) + +;;;*** + +;;;### (autoloads nil "semantic/bovine/debug" "cedet/semantic/bovine/debug.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/debug.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/debug" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/el" +;;;;;; "cedet/semantic/bovine/el.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/el.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/el" '("lisp-mode" "emacs-lisp-mode" "semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/gcc" +;;;;;; "cedet/semantic/bovine/gcc.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/gcc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/gcc" '("semantic-"))) + ;;;*** ;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el" -;;;;;; (22164 57533 951192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -24303,10 +28553,476 @@ Major mode for editing Bovine grammars. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/grammar" '("bovine-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/make" +;;;;;; "cedet/semantic/bovine/make.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/make.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/make" '("semantic-" "makefile-mode"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/scm" +;;;;;; "cedet/semantic/bovine/scm.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/bovine/scm.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/scm" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/chart" "cedet/semantic/chart.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/chart.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/chart" '("semantic-chart-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/complete" +;;;;;; "cedet/semantic/complete.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/complete.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/complete" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/ctxt" +;;;;;; "cedet/semantic/ctxt.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/ctxt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ctxt" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db" +;;;;;; "cedet/semantic/db.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads nil "semantic/db-debug" "cedet/semantic/db-debug.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-debug.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-debug" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads nil "semantic/db-ebrowse" "cedet/semantic/db-ebrowse.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-ebrowse.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ebrowse" '("semanticdb-" "c++-mode"))) + +;;;*** + +;;;### (autoloads nil "semantic/db-el" "cedet/semantic/db-el.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-el.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-el" '("semanticdb-" "emacs-lisp-mode"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-file" +;;;;;; "cedet/semantic/db-file.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-file.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-file" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-find" +;;;;;; "cedet/semantic/db-find.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-find.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-find" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-global" +;;;;;; "cedet/semantic/db-global.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-global.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-global" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads nil "semantic/db-javascript" "cedet/semantic/db-javascript.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-javascript.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-javascript" '("semanticdb-" "javascript-mode"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-mode" +;;;;;; "cedet/semantic/db-mode.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-mode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-mode" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads nil "semantic/db-ref" "cedet/semantic/db-ref.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-ref.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-typecache" +;;;;;; "cedet/semantic/db-typecache.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/db-typecache.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-typecache" '("semanticdb-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/debug" +;;;;;; "cedet/semantic/debug.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/debug.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/debug" '("semantic-debug-"))) + +;;;*** + +;;;### (autoloads nil "semantic/decorate" "cedet/semantic/decorate.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/decorate.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/include" +;;;;;; "cedet/semantic/decorate/include.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/decorate/include.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/mode" +;;;;;; "cedet/semantic/decorate/mode.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/decorate/mode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/mode" '("semantic-" "define-semantic-decoration-style"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/dep" +;;;;;; "cedet/semantic/dep.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/dep.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/dep" '("semantic-" "defcustom-mode-local-semantic-dependency-system-include-path"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/doc" +;;;;;; "cedet/semantic/doc.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/doc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/doc" '("semantic-doc"))) + +;;;*** + +;;;### (autoloads nil "semantic/ede-grammar" "cedet/semantic/ede-grammar.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/ede-grammar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/edit" +;;;;;; "cedet/semantic/edit.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/edit.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/edit" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/find" +;;;;;; "cedet/semantic/find.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/find.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/find" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/format" +;;;;;; "cedet/semantic/format.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/format.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/format" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/fw" "cedet/semantic/fw.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cedet/semantic/fw.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/fw" '("semantic"))) + +;;;*** + +;;;### (autoloads nil "semantic/grammar" "cedet/semantic/grammar.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/grammar.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/grammar-wy" "cedet/semantic/grammar-wy.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/grammar-wy.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/html" +;;;;;; "cedet/semantic/html.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/html.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/html" '("html-helper-mode" "semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia" +;;;;;; "cedet/semantic/ia.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/ia.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia" '("semantic-ia-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia-sb" +;;;;;; "cedet/semantic/ia-sb.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/ia-sb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/idle" +;;;;;; "cedet/semantic/idle.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/idle.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/idle" '("semantic-" "global-semantic-idle-summary-mode" "define-semantic-idle-service"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/imenu" +;;;;;; "cedet/semantic/imenu.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/imenu.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/imenu" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/java" "cedet/semantic/java.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/semantic/java.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/java" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex" +;;;;;; "cedet/semantic/lex.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/lex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex" '("semantic-" "define-lex"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex-spp" +;;;;;; "cedet/semantic/lex-spp.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/lex-spp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex-spp" '("semantic-lex-" "define-lex-spp-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/mru-bookmark" +;;;;;; "cedet/semantic/mru-bookmark.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/mru-bookmark.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/mru-bookmark" '("semantic-" "global-semantic-mru-bookmark-mode"))) + +;;;*** + +;;;### (autoloads nil "semantic/sb" "cedet/semantic/sb.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cedet/semantic/sb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sb" '("semantic-sb-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/scope" +;;;;;; "cedet/semantic/scope.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/scope.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/scope" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/senator" +;;;;;; "cedet/semantic/senator.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/senator.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/sort" +;;;;;; "cedet/semantic/sort.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/sort.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sort" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref" +;;;;;; "cedet/semantic/symref.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref" '("semantic-symref-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/cscope" +;;;;;; "cedet/semantic/symref/cscope.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/cscope.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re"))) + +;;;*** + +;;;### (autoloads nil "semantic/symref/filter" "cedet/semantic/symref/filter.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/filter.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/filter" '("semantic-symref-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/global" +;;;;;; "cedet/semantic/symref/global.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/global.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/grep" +;;;;;; "cedet/semantic/symref/grep.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/grep.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/grep" '("semantic-symref-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/idutils" +;;;;;; "cedet/semantic/symref/idutils.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/idutils.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/list" +;;;;;; "cedet/semantic/symref/list.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/symref/list.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/list" '("semantic-symref-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag" +;;;;;; "cedet/semantic/tag.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/tag.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-file" +;;;;;; "cedet/semantic/tag-file.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/tag-file.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-ls" +;;;;;; "cedet/semantic/tag-ls.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/tag-ls.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-ls" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-write" +;;;;;; "cedet/semantic/tag-write.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/tag-write.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/texi" +;;;;;; "cedet/semantic/texi.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/texi.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/texi" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/util" "cedet/semantic/util.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/semantic/util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util" '("semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/util-modes" +;;;;;; "cedet/semantic/util-modes.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/util-modes.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util-modes" '("semantic-"))) + +;;;*** + +;;;### (autoloads nil "semantic/wisent" "cedet/semantic/wisent.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent" '("wisent-" "define-wisent-lexer"))) + +;;;*** + +;;;### (autoloads nil "semantic/wisent/comp" "cedet/semantic/wisent/comp.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent/comp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/comp" '("wisent-"))) + ;;;*** ;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el" -;;;;;; (22164 57534 7192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -24314,10 +29030,43 @@ Major mode for editing Wisent grammars. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/grammar" '("wisent-"))) + ;;;*** -;;;### (autoloads nil "sendmail" "mail/sendmail.el" (22164 57534 -;;;;;; 839192 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/java-tags" +;;;;;; "cedet/semantic/wisent/java-tags.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent/java-tags.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/javascript" +;;;;;; "cedet/semantic/wisent/javascript.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent/javascript.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/javascript" '("js-mode" "semantic-" "wisent-javascript-jv-expand-tag"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/python" +;;;;;; "cedet/semantic/wisent/python.el" (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent/python.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/python" '("wisent-python-" "semantic-" "python-"))) + +;;;*** + +;;;### (autoloads nil "semantic/wisent/wisent" "cedet/semantic/wisent/wisent.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/semantic/wisent/wisent.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/wisent" '("wisent-" "$region" "$nterm" "$action"))) + +;;;*** + +;;;### (autoloads nil "sendmail" "mail/sendmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24596,16 +29345,19 @@ Like `mail' command, but display mail buffer in another frame. \(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sendmail" '("mail-" "sendmail-"))) + ;;;*** -;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (22208 25156 853078 -;;;;;; 435000)) +;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/seq.el -(push (purecopy '(seq 2 3)) package--builtin-versions) +(push (purecopy '(seq 2 19)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "seq" '("seq-"))) ;;;*** -;;;### (autoloads nil "server" "server.el" (22164 57535 687192 607000)) +;;;### (autoloads nil "server" "server.el" (0 0 0 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24614,6 +29366,13 @@ Like `mail' command, but display mail buffer in another frame. (put 'server-auth-dir 'risky-local-variable t) +(defvar server-name "server" "\ +The name of the Emacs server, if this Emacs process creates one. +The command `server-start' makes use of this. It should not be +changed while a server is running.") + +(custom-autoload 'server-name "server" t) + (autoload 'server-start "server" "\ Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which client @@ -24642,7 +29401,8 @@ NAME defaults to `server-name'. With argument, ask for NAME. (defvar server-mode nil "\ Non-nil if Server mode is enabled. -See the command `server-mode' for a description of this minor mode. +See the `server-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `server-mode'.") @@ -24670,9 +29430,11 @@ only these files will be asked to be saved. \(fn ARG)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "server" '("server-"))) + ;;;*** -;;;### (autoloads nil "ses" "ses.el" (22195 13278 327727 967000)) +;;;### (autoloads nil "ses" "ses.el" (0 0 0 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24714,10 +29476,12 @@ formula: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ses" '("ses" "noreturn" "1value"))) + ;;;*** -;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (22183 -;;;;;; 21960 642603 947000)) +;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24780,10 +29544,12 @@ To work around that, do: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sgml-mode" '("html-" "sgml-"))) + ;;;*** -;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (22220 -;;;;;; 16330 827423 271000)) +;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/sh-script.el (push (purecopy '(sh-script 2 0 6)) package--builtin-versions) (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24832,7 +29598,8 @@ buffer indents as it currently is indented. \\[sh-execute-region] Have optional header and region be executed in a subshell. `sh-electric-here-document-mode' controls whether insertion of two -unquoted < insert a here document. +unquoted < insert a here document. You can control this behavior by +modifying `sh-mode-hook'. If you generally program a shell different from your login shell you can set `sh-shell-file' accordingly. If your shell's file name doesn't correctly @@ -24845,10 +29612,11 @@ with your script for an edit-interpret-debug cycle. (defalias 'shell-script-mode 'sh-mode) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sh-script" '("sh-"))) + ;;;*** -;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (22164 57534 -;;;;;; 211192 607000)) +;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -24895,10 +29663,11 @@ function, `load-path-shadows-find'. \(fn &optional STRINGP)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadow" '("load-path-shadows-"))) + ;;;*** -;;;### (autoloads nil "shadowfile" "shadowfile.el" (22164 57535 703192 -;;;;;; 607000)) +;;;### (autoloads nil "shadowfile" "shadowfile.el" (0 0 0 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -24934,9 +29703,11 @@ Set up file shadowing. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadowfile" '("shadow"))) + ;;;*** -;;;### (autoloads nil "shell" "shell.el" (22164 57535 703192 607000)) +;;;### (autoloads nil "shell" "shell.el" (0 0 0 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -24982,9 +29753,11 @@ Otherwise, one argument `-i' is passed to the shell. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shell" '("shell-" "dirs" "explicit-"))) + ;;;*** -;;;### (autoloads nil "shr" "net/shr.el" t) +;;;### (autoloads nil "shr" "net/shr.el" (0 0 0 0)) ;;; Generated autoloads from net/shr.el (autoload 'shr-render-region "shr" "\ @@ -24999,10 +29772,18 @@ DOM should be a parse tree as generated by \(fn DOM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr" '("shr-"))) + +;;;*** + +;;;### (autoloads nil "shr-color" "net/shr-color.el" (0 0 0 0)) +;;; Generated autoloads from net/shr-color.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr-color" '("shr-color-"))) + ;;;*** -;;;### (autoloads nil "sieve" "net/sieve.el" (22221 37189 996505 -;;;;;; 663000)) +;;;### (autoloads nil "sieve" "net/sieve.el" (0 0 0 0)) ;;; Generated autoloads from net/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -25025,10 +29806,19 @@ DOM should be a parse tree as generated by \(fn &optional NAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve" '("sieve-"))) + +;;;*** + +;;;### (autoloads nil "sieve-manage" "net/sieve-manage.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from net/sieve-manage.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-manage" '("sieve-"))) + ;;;*** -;;;### (autoloads nil "sieve-mode" "net/sieve-mode.el" (22221 37189 -;;;;;; 996505 663000)) +;;;### (autoloads nil "sieve-mode" "net/sieve-mode.el" (0 0 0 0)) ;;; Generated autoloads from net/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -25041,10 +29831,11 @@ Turning on Sieve mode runs `sieve-mode-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-mode" '("sieve-"))) + ;;;*** -;;;### (autoloads nil "simula" "progmodes/simula.el" (22164 57535 -;;;;;; 559192 607000)) +;;;### (autoloads nil "simula" "progmodes/simula.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25090,10 +29881,11 @@ with no arguments, if that value is non-nil. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "simula" '("simula-"))) + ;;;*** -;;;### (autoloads nil "skeleton" "skeleton.el" (22164 57535 731192 -;;;;;; 607000)) +;;;### (autoloads nil "skeleton" "skeleton.el" (0 0 0 0)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25210,10 +30002,11 @@ twice for the others. \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "skeleton" '("skeleton-"))) + ;;;*** -;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (22189 60739 -;;;;;; 309741 19000)) +;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (0 0 0 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -25238,10 +30031,18 @@ If no conflict maker is found, turn off `smerge-mode'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smerge-mode" '("smerge-"))) + ;;;*** -;;;### (autoloads nil "smiley" "gnus/smiley.el" (22208 25157 1078 -;;;;;; 435000)) +;;;### (autoloads nil "smie" "emacs-lisp/smie.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/smie.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smie" '("smie-"))) + +;;;*** + +;;;### (autoloads nil "smiley" "gnus/smiley.el" (0 0 0 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -25256,10 +30057,18 @@ interactively. If there's no argument, do it at the current buffer. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smiley" '("smiley-" "gnus-smiley-file-types"))) + +;;;*** + +;;;### (autoloads nil "smime" "gnus/smime.el" (0 0 0 0)) +;;; Generated autoloads from gnus/smime.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smime" '("smime"))) + ;;;*** -;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (22164 57534 -;;;;;; 839192 607000)) +;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -25272,10 +30081,11 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smtpmail" '("smtpmail-"))) + ;;;*** -;;;### (autoloads nil "snake" "play/snake.el" (22220 16330 787423 -;;;;;; 271000)) +;;;### (autoloads nil "snake" "play/snake.el" (0 0 0 0)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -25296,10 +30106,11 @@ Snake mode keybindings: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snake" '("snake-"))) + ;;;*** -;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (22164 57534 -;;;;;; 967192 607000)) +;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (0 0 0 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -25326,17 +30137,34 @@ then `snmpv2-mode-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snmp-mode" '("snmp"))) + ;;;*** -;;;### (autoloads nil "soap-client" "net/soap-client.el" (22164 57534 -;;;;;; 987192 607000)) +;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0)) ;;; Generated autoloads from net/soap-client.el -(push (purecopy '(soap-client 3 0 2)) package--builtin-versions) +(push (purecopy '(soap-client 3 1 1)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-"))) ;;;*** -;;;### (autoloads nil "solar" "calendar/solar.el" (22195 13277 891727 -;;;;;; 967000)) +;;;### (autoloads nil "soap-inspect" "net/soap-inspect.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from net/soap-inspect.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-inspect" '("soap-"))) + +;;;*** + +;;;### (autoloads nil "socks" "net/socks.el" (0 0 0 0)) +;;; Generated autoloads from net/socks.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "socks" '("socks-"))) + +;;;*** + +;;;### (autoloads nil "solar" "calendar/solar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -25349,10 +30177,11 @@ This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solar" '("solar-" "diary-sunrise-sunset" "calendar-"))) + ;;;*** -;;;### (autoloads nil "solitaire" "play/solitaire.el" (22164 57535 -;;;;;; 307192 607000)) +;;;### (autoloads nil "solitaire" "play/solitaire.el" (0 0 0 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -25425,9 +30254,11 @@ Pick your favorite shortcuts: \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solitaire" '("solitaire-"))) + ;;;*** -;;;### (autoloads nil "sort" "sort.el" (22164 57535 731192 607000)) +;;;### (autoloads nil "sort" "sort.el" (0 0 0 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25600,9 +30431,18 @@ is non-nil, it also prints a message describing the number of deletions. \(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sort" '("sort-"))) + +;;;*** + +;;;### (autoloads nil "soundex" "soundex.el" (0 0 0 0)) +;;; Generated autoloads from soundex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soundex" '("soundex"))) + ;;;*** -;;;### (autoloads nil "spam" "gnus/spam.el" (22205 48966 980819 751000)) +;;;### (autoloads nil "spam" "gnus/spam.el" (0 0 0 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25614,10 +30454,12 @@ installed through `spam-necessary-extra-headers'. \(fn &rest SYMBOLS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam" '("spam-"))) + ;;;*** -;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (22207 -;;;;;; 4296 768349 691000)) +;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25657,10 +30499,25 @@ Spam reports will be queued with the method used when \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-report" '("spam-report-"))) + +;;;*** + +;;;### (autoloads nil "spam-stat" "gnus/spam-stat.el" (0 0 0 0)) +;;; Generated autoloads from gnus/spam-stat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size"))) + +;;;*** + +;;;### (autoloads nil "spam-wash" "gnus/spam-wash.el" (0 0 0 0)) +;;; Generated autoloads from gnus/spam-wash.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-wash" '("spam-"))) + ;;;*** -;;;### (autoloads nil "speedbar" "speedbar.el" (22195 13278 407727 -;;;;;; 967000)) +;;;### (autoloads nil "speedbar" "speedbar.el" (0 0 0 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25682,10 +30539,11 @@ selected. If the speedbar frame is active, then select the attached frame. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "speedbar" '("speedbar-"))) + ;;;*** -;;;### (autoloads nil "spook" "play/spook.el" (22164 57535 307192 -;;;;;; 607000)) +;;;### (autoloads nil "spook" "play/spook.el" (0 0 0 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25698,10 +30556,11 @@ Return a vector containing the lines from `spook-phrases-file'. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spook" '("spook-phrase"))) + ;;;*** -;;;### (autoloads nil "sql" "progmodes/sql.el" (22189 60739 161741 -;;;;;; 19000)) +;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/sql.el (push (purecopy '(sql 3 5)) package--builtin-versions) @@ -26165,17 +31024,164 @@ Run vsql as an inferior process. \(fn &optional BUFFER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sql" '("sql-"))) + ;;;*** -;;;### (autoloads nil "srecode" "cedet/srecode.el" (22164 57534 7192 -;;;;;; 607000)) +;;;### (autoloads nil "srecode" "cedet/srecode.el" (0 0 0 0)) ;;; Generated autoloads from cedet/srecode.el (push (purecopy '(srecode 1 2)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode" '("srecode-version"))) + +;;;*** + +;;;### (autoloads nil "srecode/args" "cedet/srecode/args.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/srecode/args.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/args" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/compile" +;;;;;; "cedet/srecode/compile.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/compile.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/compile" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/cpp" +;;;;;; "cedet/srecode/cpp.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/cpp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/cpp" '("srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/ctxt" "cedet/srecode/ctxt.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/srecode/ctxt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/ctxt" '("srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/dictionary" "cedet/srecode/dictionary.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/dictionary.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/dictionary" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/document" +;;;;;; "cedet/srecode/document.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/document.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/document" '("srecode-document-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/el" "cedet/srecode/el.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/el.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/expandproto" +;;;;;; "cedet/srecode/expandproto.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/expandproto.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/expandproto" '("srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/extract" "cedet/srecode/extract.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/extract.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/extract" '("srecode-extract"))) + +;;;*** + +;;;### (autoloads nil "srecode/fields" "cedet/srecode/fields.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/fields.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/fields" '("srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/filters" "cedet/srecode/filters.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/filters.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/filters" '("srecode-comment-prefix"))) + +;;;*** + +;;;### (autoloads nil "srecode/find" "cedet/srecode/find.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cedet/srecode/find.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/find" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/getset" +;;;;;; "cedet/srecode/getset.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/getset.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/getset" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/insert" +;;;;;; "cedet/srecode/insert.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/insert.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/insert" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/map" +;;;;;; "cedet/srecode/map.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/map.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/map" '("srecode-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/mode" +;;;;;; "cedet/srecode/mode.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/mode.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/mode" '("srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/semantic" "cedet/srecode/semantic.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/semantic.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/semantic" '("srecode-semantic-"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/srt" +;;;;;; "cedet/srecode/srt.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/srt.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt" '("srecode-read-"))) + ;;;*** ;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (22164 57534 19192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -26185,10 +31191,35 @@ Major-mode for writing SRecode macros. (defalias 'srt-mode 'srecode-template-mode) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-"))) + +;;;*** + +;;;### (autoloads nil "srecode/table" "cedet/srecode/table.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cedet/srecode/table.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/table" '("srecode-" "object-sort-list"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/template" +;;;;;; "cedet/srecode/template.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/template.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/template" '("semantic-tag-components"))) + +;;;*** + +;;;### (autoloads "actual autoloads are elsewhere" "srecode/texi" +;;;;;; "cedet/srecode/texi.el" (0 0 0 0)) +;;; Generated autoloads from cedet/srecode/texi.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-"))) + ;;;*** -;;;### (autoloads nil "starttls" "net/starttls.el" (22221 37189 996505 -;;;;;; 663000)) +;;;### (autoloads nil "starttls" "net/starttls.el" (0 0 0 0)) ;;; Generated autoloads from net/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -26209,10 +31240,11 @@ GnuTLS requires a port number. \(fn NAME BUFFER HOST PORT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "starttls" '("starttls-"))) + ;;;*** -;;;### (autoloads nil "strokes" "strokes.el" (22189 60739 257741 -;;;;;; 19000)) +;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -26283,7 +31315,8 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead. (defvar strokes-mode nil "\ Non-nil if Strokes mode is enabled. -See the command `strokes-mode' for a description of this minor mode. +See the `strokes-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `strokes-mode'.") @@ -26323,10 +31356,11 @@ Read a complex stroke and insert its glyph into the current buffer. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "strokes" '("strokes-"))) + ;;;*** -;;;### (autoloads nil "studly" "play/studly.el" (21607 54478 800121 -;;;;;; 42000)) +;;;### (autoloads nil "studly" "play/studly.el" (0 0 0 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -26346,8 +31380,14 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads nil "subword" "progmodes/subword.el" (22164 57535 -;;;;;; 575192 607000)) +;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/subr-x.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subr-x" '("read-multiple-choice" "string-" "hash-table-" "when-let" "internal--" "if-let" "thread-"))) + +;;;*** + +;;;### (autoloads nil "subword" "progmodes/subword.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/subword.el (define-obsolete-function-alias 'capitalized-words-mode 'subword-mode "25.1") @@ -26382,7 +31422,8 @@ treat nomenclature boundaries as word boundaries. (defvar global-subword-mode nil "\ Non-nil if Global Subword mode is enabled. -See the command `global-subword-mode' for a description of this minor mode. +See the `global-subword-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-subword-mode'.") @@ -26418,7 +31459,8 @@ as parts of words: e.g., in `superword-mode', (defvar global-superword-mode nil "\ Non-nil if Global Superword mode is enabled. -See the command `global-superword-mode' for a description of this minor mode. +See the `global-superword-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-superword-mode'.") @@ -26437,10 +31479,11 @@ See `superword-mode' for more information on Superword mode. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subword" '("superword-mode-map" "subword-"))) + ;;;*** -;;;### (autoloads nil "supercite" "mail/supercite.el" (22164 57534 -;;;;;; 843192 607000)) +;;;### (autoloads nil "supercite" "mail/supercite.el" (0 0 0 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26470,16 +31513,26 @@ and `sc-post-hook' is run after the guts of this function. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "supercite" '("sc-"))) + +;;;*** + +;;;### (autoloads nil "svg" "svg.el" (0 0 0 0)) +;;; Generated autoloads from svg.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "svg" '("svg-"))) + ;;;*** -;;;### (autoloads nil "t-mouse" "t-mouse.el" (22211 1352 328084 927000)) +;;;### (autoloads nil "t-mouse" "t-mouse.el" (0 0 0 0)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") (defvar gpm-mouse-mode t "\ Non-nil if Gpm-Mouse mode is enabled. -See the command `gpm-mouse-mode' for a description of this minor mode. +See the `gpm-mouse-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `gpm-mouse-mode'.") @@ -26502,9 +31555,11 @@ GPM. This is due to limitations in GPM and the Linux kernel. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "t-mouse" '("gpm-mouse-"))) + ;;;*** -;;;### (autoloads nil "tabify" "tabify.el" (22164 57535 763192 607000)) +;;;### (autoloads nil "tabify" "tabify.el" (0 0 0 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26531,10 +31586,11 @@ The variable `tab-width' controls the spacing of tab stops. \(fn START END &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tabify" '("tabify-regexp"))) + ;;;*** -;;;### (autoloads nil "table" "textmodes/table.el" (22189 60739 301741 -;;;;;; 19000)) +;;;### (autoloads nil "table" "textmodes/table.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/table.el (autoload 'table-insert "table" "\ @@ -27103,9 +32159,18 @@ converts a table into plain text without frames. It is a companion to \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "table" '("table-" "*table--"))) + ;;;*** -;;;### (autoloads nil "talk" "talk.el" (22164 57535 763192 607000)) +;;;### (autoloads nil "tabulated-list" "emacs-lisp/tabulated-list.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/tabulated-list.el +(push (purecopy '(tabulated-list 1 0)) package--builtin-versions) + +;;;*** + +;;;### (autoloads nil "talk" "talk.el" (0 0 0 0)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -27118,10 +32183,11 @@ Connect to the Emacs talk group from the current X display or tty frame. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "talk" '("talk-"))) + ;;;*** -;;;### (autoloads nil "tar-mode" "tar-mode.el" (22164 57535 775192 -;;;;;; 607000)) +;;;### (autoloads nil "tar-mode" "tar-mode.el" (0 0 0 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27142,10 +32208,11 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tar-mode" '("tar-"))) + ;;;*** -;;;### (autoloads nil "tcl" "progmodes/tcl.el" (22164 57535 575192 -;;;;;; 607000)) +;;;### (autoloads nil "tcl" "progmodes/tcl.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27191,10 +32258,27 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. \(fn COMMAND &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcl" '("tcl-" "calculate-tcl-indent" "inferior-tcl-" "indent-tcl-exp" "add-log-tcl-defun" "run-tcl" "switch-to-tcl"))) + ;;;*** -;;;### (autoloads nil "telnet" "net/telnet.el" (22164 57534 987192 -;;;;;; 607000)) +;;;### (autoloads nil "tcover-ses" "emacs-lisp/tcover-ses.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from emacs-lisp/tcover-ses.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-ses" '("ses-exercise"))) + +;;;*** + +;;;### (autoloads nil "tcover-unsafep" "emacs-lisp/tcover-unsafep.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from emacs-lisp/tcover-unsafep.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-unsafep" '("testcover-unsafep"))) + +;;;*** + +;;;### (autoloads nil "telnet" "net/telnet.el" (0 0 0 0)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -27217,9 +32301,18 @@ Normally input is edited in Emacs and sent a line at a time. \(fn HOST)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "telnet" '("telnet-" "send-process-next-char"))) + +;;;*** + +;;;### (autoloads nil "tempo" "tempo.el" (0 0 0 0)) +;;; Generated autoloads from tempo.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tempo" '("tempo-"))) + ;;;*** -;;;### (autoloads nil "term" "term.el" (22221 37190 84505 663000)) +;;;### (autoloads nil "term" "term.el" (0 0 0 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -27259,21 +32352,32 @@ use in that buffer. \(fn PORT SPEED)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "term" '("serial-" "term-" "ansi-term-color-vector" "explicit-shell-file-name"))) + ;;;*** -;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (22164 -;;;;;; 57534 215192 607000)) +;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/testcover.el +(autoload 'testcover-start "testcover" "\ +Uses edebug to instrument all macros and functions in FILENAME, then +changes the instrumentation from edebug to testcover--much faster, no +problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is +non-nil, byte-compiles each function after instrumenting. + +\(fn FILENAME &optional BYTE-COMPILE)" t nil) + (autoload 'testcover-this-defun "testcover" "\ Start coverage on function under point. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "testcover" '("testcover-"))) + ;;;*** -;;;### (autoloads nil "tetris" "play/tetris.el" (22195 13278 247727 -;;;;;; 967000)) +;;;### (autoloads nil "tetris" "play/tetris.el" (0 0 0 0)) ;;; Generated autoloads from play/tetris.el (push (purecopy '(tetris 2 1)) package--builtin-versions) @@ -27296,10 +32400,11 @@ tetris-mode keybindings: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tetris" '("tetris-"))) + ;;;*** -;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (22164 57535 -;;;;;; 823192 607000)) +;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27598,10 +32703,11 @@ Major mode to edit DocTeX files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tex-mode" '("tex-" "doctex-font-lock-" "latex-" "plain-tex-mode-map"))) + ;;;*** -;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (22164 57535 -;;;;;; 827192 607000)) +;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27638,10 +32744,11 @@ if large. You can use `Info-split' to do this manually. \(fn &optional NOSPLIT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf"))) + ;;;*** -;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (22221 37190 -;;;;;; 88505 663000)) +;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27723,10 +32830,20 @@ value of `texinfo-mode-hook'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfo" '("texinfo-"))) + +;;;*** + +;;;### (autoloads nil "texnfo-upd" "textmodes/texnfo-upd.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from textmodes/texnfo-upd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texnfo-upd" '("texinfo-"))) + ;;;*** -;;;### (autoloads nil "thai-util" "language/thai-util.el" (22164 -;;;;;; 57534 787192 607000)) +;;;### (autoloads nil "thai-util" "language/thai-util.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -27751,10 +32868,19 @@ Compose Thai characters in the current buffer. \(fn GSTRING)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-"))) + +;;;*** + +;;;### (autoloads nil "thai-word" "language/thai-word.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from language/thai-word.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-word" '("thai-"))) + ;;;*** -;;;### (autoloads nil "thingatpt" "thingatpt.el" (22174 6972 812792 -;;;;;; 520000)) +;;;### (autoloads nil "thingatpt" "thingatpt.el" (0 0 0 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27816,9 +32942,11 @@ Return the Lisp list at point, or nil if none is found. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("form-at-point" "thing-at-point-" "sentence-at-point" "word-at-point" "in-string-p" "end-of-thing" "beginning-of-thing"))) + ;;;*** -;;;### (autoloads nil "thumbs" "thumbs.el" (22164 57535 827192 607000)) +;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -27850,17 +32978,20 @@ In dired, call the setroot program on the image at point. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thumbs" '("thumbs-"))) + ;;;*** -;;;### (autoloads nil "thunk" "emacs-lisp/thunk.el" (22164 57534 -;;;;;; 215192 607000)) +;;;### (autoloads nil "thunk" "emacs-lisp/thunk.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/thunk.el (push (purecopy '(thunk 1 0)) package--builtin-versions) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thunk" '("thunk-"))) + ;;;*** -;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (22164 -;;;;;; 57534 787192 607000)) +;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -27931,10 +33062,11 @@ See also docstring of the function tibetan-compose-region. \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tibet-util" '("tibetan-"))) + ;;;*** -;;;### (autoloads nil "tildify" "textmodes/tildify.el" (22174 6972 -;;;;;; 804792 520000)) +;;;### (autoloads nil "tildify" "textmodes/tildify.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/tildify.el (push (purecopy '(tildify 4 6 1)) package--builtin-versions) @@ -27998,9 +33130,11 @@ variable will be set to the representation. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tildify" '("tildify-"))) + ;;;*** -;;;### (autoloads nil "time" "time.el" (22164 57535 831192 607000)) +;;;### (autoloads nil "time" "time.el" (0 0 0 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -28020,7 +33154,8 @@ This runs the normal hook `display-time-hook' after each update. (defvar display-time-mode nil "\ Non-nil if Display-Time mode is enabled. -See the command `display-time-mode' for a description of this minor mode. +See the `display-time-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `display-time-mode'.") @@ -28060,10 +33195,12 @@ Return a string giving the duration of the Emacs initialization. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "zoneinfo-style-world-list"))) + ;;;*** -;;;### (autoloads nil "time-date" "calendar/time-date.el" (22164 -;;;;;; 57533 859192 607000)) +;;;### (autoloads nil "time-date" "calendar/time-date.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -28071,11 +33208,8 @@ Parse a string DATE that represents a date-time and return a time value. If DATE lacks timezone information, GMT is assumed. \(fn DATE)" nil nil) -(if (or (featurep 'emacs) - (and (fboundp 'float-time) - (subrp (symbol-function 'float-time)))) - (defalias 'time-to-seconds 'float-time) - (autoload 'time-to-seconds "time-date")) + +(defalias 'time-to-seconds 'float-time) (autoload 'seconds-to-time "time-date" "\ Convert SECONDS to a time value. @@ -28093,10 +33227,7 @@ TIME should be either a time value or a date-time string. \(fn TIME)" nil nil) -(defalias 'subtract-time 'time-subtract) -(autoload 'time-add "time-date") -(autoload 'time-subtract "time-date") -(autoload 'time-less-p "time-date") +(define-obsolete-function-alias 'subtract-time 'time-subtract "26.1") (autoload 'date-to-day "time-date" "\ Return the number of days between year 1 and DATE. @@ -28164,10 +33295,11 @@ Convert the time interval in seconds to a short string. \(fn DELAY)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-date" '("seconds-to-string" "time-" "encode-time-value" "with-decoded-time-value"))) + ;;;*** -;;;### (autoloads nil "time-stamp" "time-stamp.el" (22220 16330 899423 -;;;;;; 271000)) +;;;### (autoloads nil "time-stamp" "time-stamp.el" (0 0 0 0)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -28205,16 +33337,19 @@ With ARG, turn time stamping on if and only if arg is positive. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-stamp" '("time-stamp-"))) + ;;;*** -;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (22164 -;;;;;; 57533 883192 607000)) +;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/timeclock.el (push (purecopy '(timeclock 2 6 1)) package--builtin-versions) (defvar timeclock-mode-line-display nil "\ Non-nil if Timeclock-Mode-Line-Display mode is enabled. -See the command `timeclock-mode-line-display' for a description of this minor mode. +See the `timeclock-mode-line-display' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `timeclock-mode-line-display'.") @@ -28315,9 +33450,12 @@ relative only to the time worked today, and not to past time. \(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timeclock" '("timeclock-"))) + ;;;*** -;;;### (autoloads nil "timer-list" "emacs-lisp/timer-list.el" t) +;;;### (autoloads nil "timer-list" "emacs-lisp/timer-list.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from emacs-lisp/timer-list.el (autoload 'timer-list "timer-list" "\ @@ -28326,10 +33464,19 @@ List all timers in a buffer. \(fn &optional IGNORE-AUTO NONCONFIRM)" t nil) (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timer-list" '("timer-list-"))) + +;;;*** + +;;;### (autoloads nil "timezone" "timezone.el" (0 0 0 0)) +;;; Generated autoloads from timezone.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timezone" '("timezone-"))) + ;;;*** ;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el" -;;;;;; (22164 57534 755192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -28349,9 +33496,18 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". \(fn &optional FORCE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "miscdic-convert" "ctlau-" "ziranma-converter" "py-converter" "quail-" "quick-" "tit-" "tsang-"))) + +;;;*** + +;;;### (autoloads nil "tls" "net/tls.el" (0 0 0 0)) +;;; Generated autoloads from net/tls.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tls" '("open-tls-stream" "tls-"))) + ;;;*** -;;;### (autoloads nil "tmm" "tmm.el" (22164 57535 831192 607000)) +;;;### (autoloads nil "tmm" "tmm.el" (0 0 0 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -28391,20 +33547,23 @@ Its value should be an event that has a binding in MENU. \(fn MENU &optional IN-POPUP DEFAULT-ITEM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tmm" '("tmm-"))) + ;;;*** -;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (22220 -;;;;;; 16330 595423 271000)) +;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-show "todo-mode" "\ Visit a todo file and display one of its categories. -When invoked in Todo mode, prompt for which todo file to visit. -When invoked outside of Todo mode with non-nil prefix argument -SOLICIT-FILE prompt for which todo file to visit; otherwise visit -`todo-default-todo-file'. Subsequent invocations from outside -of Todo mode revisit this file or, with option +When invoked in Todo mode, Todo Archive mode or Todo Filtered +Items mode, or when invoked anywhere else with a prefix argument, +prompt for which todo file to visit. When invoked outside of a +Todo mode buffer without a prefix argument, visit +`todo-default-todo-file'. Subsequent invocations from outside of +Todo mode revisit this file or, with option `todo-show-current-file' non-nil (the default), whichever todo file was last visited. @@ -28433,9 +33592,6 @@ by default. The done items are hidden, but typing items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category. -Invoking this command in Todo Archive mode visits the -corresponding todo file, displaying the corresponding category. - \(fn &optional SOLICIT-FILE INTERACTIVE)" t nil) (autoload 'todo-mode "todo-mode" "\ @@ -28459,10 +33615,11 @@ Mode for displaying and reprioritizing top priority Todo. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "todo-mode" '("todo-"))) + ;;;*** -;;;### (autoloads nil "tool-bar" "tool-bar.el" (22164 57535 831192 -;;;;;; 607000)) +;;;### (autoloads nil "tool-bar" "tool-bar.el" (0 0 0 0)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -28530,10 +33687,18 @@ holds a keymap. \(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tool-bar" '("tool-bar-"))) + +;;;*** + +;;;### (autoloads nil "tooltip" "tooltip.el" (0 0 0 0)) +;;; Generated autoloads from tooltip.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tooltip" '("tooltip-"))) + ;;;*** -;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (22164 57534 215192 -;;;;;; 607000)) +;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28544,10 +33709,11 @@ to a tcp server on another machine. \(fn PROCESS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tq" '("tq-"))) + ;;;*** -;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (22164 57534 -;;;;;; 215192 607000)) +;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28590,10 +33756,11 @@ the output buffer or changing the window configuration. (defalias 'trace-function 'trace-function-foreground) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trace" '("untrace-" "trace-" "inhibit-trace"))) + ;;;*** -;;;### (autoloads nil "tramp" "net/tramp.el" (22191 16060 585822 -;;;;;; 179000)) +;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28622,21 +33789,11 @@ On W32 systems, the volume letter must be ignored.") Value for `tramp-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") -(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\ +(defvar tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (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. -When tramp.el is loaded, this regular expression is prepended to -`file-name-handler-alist', and that is searched sequentially. Thus, -if the Tramp entry appears rather early in the `file-name-handler-alist' -and is a bit too general, then some files might be considered Tramp -files which are not really Tramp files. - -Please note that the entry in `file-name-handler-alist' is made when -this file (tramp.el) is loaded. This means that this variable must be set -before loading tramp.el. Alternatively, `file-name-handler-alist' can be -updated after changing this variable. - -Also see `tramp-file-name-structure'.") +This regexp should match Tramp file names but no other file +names. When calling `tramp-register-file-name-handlers', the +initial value is overwritten by the car of `tramp-file-name-structure'.") (defconst tramp-completion-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/[^/]\\{2,\\}\\'" "\\`/[^/]*\\'") "\ Value for `tramp-completion-file-name-regexp' for unified remoting. @@ -28659,20 +33816,12 @@ updated after changing this variable. Also see `tramp-file-name-structure'.") -(defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "\ -Alist of completion handler functions. -Used for file names matching `tramp-file-name-regexp'. Operations -not mentioned here will be handled by Tramp's file name handler -functions, or the normal Emacs functions.") - (defun tramp-completion-run-real-handler (operation args) "\ Invoke `tramp-file-name-handler' for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (let* ((inhibit-file-name-handlers (\` (tramp-completion-file-name-handler cygwin-mount-name-hook-function cygwin-mount-map-drive-hook-function \, (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers)))) (inhibit-file-name-operation operation)) (apply operation args))) - -(defun tramp-completion-file-name-handler (operation &rest args) "\ -Invoke Tramp file name completion handler. -Falls back to normal file name handler if no Tramp file name handler exists." (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and fn tramp-mode (or (eq tramp-syntax (quote sep)) (featurep (quote tramp)) (and (boundp (quote partial-completion-mode)) (symbol-value (quote partial-completion-mode))) (featurep (quote ido)) (featurep (quote icicles)))) (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args)))) +(defun tramp-completion-file-name-handler (operation &rest args) + (tramp-completion-run-real-handler operation args)) (defun tramp-autoload-file-name-handler (operation &rest args) "\ Load Tramp file name handler, and perform OPERATION." (let ((default-directory temporary-file-directory)) (load "tramp" nil t)) (apply operation args)) @@ -28683,47 +33832,119 @@ Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add (tramp-register-autoload-file-name-handlers) (autoload 'tramp-unload-file-name-handlers "tramp" "\ - +Unload Tramp file name handlers from `file-name-handler-alist'. \(fn)" nil nil) -(autoload 'tramp-completion-handle-file-name-all-completions "tramp" "\ -Like `file-name-all-completions' for partial Tramp files. - -\(fn FILENAME DIRECTORY)" nil nil) +(defvar tramp-completion-mode nil "\ +If non-nil, external packages signal that they are in file name completion. -(autoload 'tramp-completion-handle-file-name-completion "tramp" "\ -Like `file-name-completion' for Tramp files. - -\(fn FILENAME DIRECTORY &optional PREDICATE)" nil nil) +This is necessary, because Tramp uses a heuristic depending on last +input event. This fails when external packages use other characters +but <TAB>, <SPACE> or ?\\? for file name completion. This variable +should never be set globally, the intention is to let-bind it.") (autoload 'tramp-unload-tramp "tramp" "\ Discard Tramp from loading remote files. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp" '("tramp-" "with-"))) + +;;;*** + +;;;### (autoloads nil "tramp-adb" "net/tramp-adb.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-adb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-adb" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tramp-cache" "net/tramp-cache.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-cache.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cache" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tramp-cmds" "net/tramp-cmds.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-cmds.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cmds" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tramp-compat" "net/tramp-compat.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from net/tramp-compat.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-compat" '("tramp-"))) + ;;;*** -;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (22168 54586 -;;;;;; 890696 972000)) +;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ - +Reenable Ange-FTP, when Tramp is unloaded. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-ftp" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tramp-gvfs" "net/tramp-gvfs.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-gvfs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-call-method"))) + +;;;*** + +;;;### (autoloads nil "tramp-gw" "net/tramp-gw.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-gw.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-gw" '("tramp-gw-" "socks-"))) + +;;;*** + +;;;### (autoloads nil "tramp-sh" "net/tramp-sh.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-sh.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-sh" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tramp-smb" "net/tramp-smb.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-smb.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-smb" '("tramp-smb-"))) + +;;;*** + +;;;### (autoloads nil "tramp-uu" "net/tramp-uu.el" (0 0 0 0)) +;;; Generated autoloads from net/tramp-uu.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-uu" '("tramp-uu"))) + ;;;*** -;;;### (autoloads nil "trampver" "net/trampver.el" (22168 54586 978696 -;;;;;; 972000)) +;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 0 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 3 1 -1)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) + +;;;*** + +;;;### (autoloads nil "tree-widget" "tree-widget.el" (0 0 0 0)) +;;; Generated autoloads from tree-widget.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tree-widget" '("tree-widget-"))) ;;;*** -;;;### (autoloads nil "tutorial" "tutorial.el" (22164 57535 831192 -;;;;;; 607000)) +;;;### (autoloads nil "tutorial" "tutorial.el" (0 0 0 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28745,10 +33966,11 @@ resumed later. \(fn &optional ARG DONT-ASK-FOR-REVERT)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--"))) + ;;;*** -;;;### (autoloads nil "tv-util" "language/tv-util.el" (21855 577 -;;;;;; 57945 485000)) +;;;### (autoloads nil "tv-util" "language/tv-util.el" (0 0 0 0)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -28756,10 +33978,12 @@ resumed later. \(fn FROM TO FONT-OBJECT STRING)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tv-util" '("tai-viet-"))) + ;;;*** -;;;### (autoloads nil "two-column" "textmodes/two-column.el" (22164 -;;;;;; 57535 827192 607000)) +;;;### (autoloads nil "two-column" "textmodes/two-column.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -28804,15 +34028,17 @@ First column's text sSs Second column's text \(fn ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "two-column" '("2C-"))) + ;;;*** -;;;### (autoloads nil "type-break" "type-break.el" (22195 13278 467727 -;;;;;; 967000)) +;;;### (autoloads nil "type-break" "type-break.el" (0 0 0 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ Non-nil if Type-Break mode is enabled. -See the command `type-break-mode' for a description of this minor mode. +See the `type-break-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `type-break-mode'.") @@ -28937,9 +34163,11 @@ FRAC should be the inverse of the fractional value; for example, a value of \(fn WPM &optional WORDLEN FRAC)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "type-break" '("timep" "type-break-"))) + ;;;*** -;;;### (autoloads nil "uce" "mail/uce.el" (22164 57534 843192 607000)) +;;;### (autoloads nil "uce" "mail/uce.el" (0 0 0 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -28950,10 +34178,12 @@ You might need to set `uce-mail-reader' before using this. \(fn &optional IGNORED)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uce" '("uce-"))) + ;;;*** ;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el" -;;;;;; (22164 57534 755192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -29016,10 +34246,12 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. \(fn STR)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs"))) + ;;;*** -;;;### (autoloads nil "underline" "textmodes/underline.el" (22164 -;;;;;; 57535 827192 607000)) +;;;### (autoloads nil "underline" "textmodes/underline.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -29039,8 +34271,15 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "unrmail" "mail/unrmail.el" (22164 57534 843192 -;;;;;; 607000)) +;;;### (autoloads "actual autoloads are elsewhere" "undigest" "mail/undigest.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from mail/undigest.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "undigest" '("rmail-"))) + +;;;*** + +;;;### (autoloads nil "unrmail" "mail/unrmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -29058,10 +34297,11 @@ The variable `unrmail-mbox-format' controls which mbox format to use. \(fn FILE TO-FILE)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unrmail" '("unrmail-mbox-format"))) + ;;;*** -;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (22164 57534 -;;;;;; 215192 607000)) +;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29071,9 +34311,11 @@ UNSAFEP-VARS is a list of symbols with local bindings. \(fn FORM &optional UNSAFEP-VARS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unsafep" '("unsafep-" "safe-functions"))) + ;;;*** -;;;### (autoloads nil "url" "url/url.el" (22164 57535 839192 607000)) +;;;### (autoloads nil "url" "url/url.el" (0 0 0 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -29116,12 +34358,25 @@ Return the buffer containing the data, or nil if there are no data associated with it (the case for dired, info, or mailto URLs that need no further processing). URL is either a string or a parsed URL. -\(fn URL &optional SILENT INHIBIT-COOKIES)" nil nil) +If SILENT is non-nil, don't do any messaging while retrieving. +If INHIBIT-COOKIES is non-nil, refuse to store cookies. If +TIMEOUT is passed, it should be a number that says (in seconds) +how long to wait for a response before giving up. + +\(fn URL &optional SILENT INHIBIT-COOKIES TIMEOUT)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url" '("url-"))) + +;;;*** + +;;;### (autoloads nil "url-about" "url/url-about.el" (0 0 0 0)) +;;; Generated autoloads from url/url-about.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-about" '("url-"))) ;;;*** -;;;### (autoloads nil "url-auth" "url/url-auth.el" (22164 57535 835192 -;;;;;; 607000)) +;;;### (autoloads nil "url-auth" "url/url-auth.el" (0 0 0 0)) ;;; Generated autoloads from url/url-auth.el (autoload 'url-get-authentication "url-auth" "\ @@ -29160,10 +34415,11 @@ RATING a rating between 1 and 10 of the strength of the authentication. \(fn TYPE &optional FUNCTION RATING)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-auth" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-cache" "url/url-cache.el" (22164 57535 -;;;;;; 835192 607000)) +;;;### (autoloads nil "url-cache" "url/url-cache.el" (0 0 0 0)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -29182,10 +34438,11 @@ Extract FNAM from the local disk cache. \(fn FNAM)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cache" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-cid" "url/url-cid.el" (22164 57535 835192 -;;;;;; 607000)) +;;;### (autoloads nil "url-cid" "url/url-cid.el" (0 0 0 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -29193,10 +34450,18 @@ Extract FNAM from the local disk cache. \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cid" '("url-cid-gnus"))) + ;;;*** -;;;### (autoloads nil "url-dav" "url/url-dav.el" (22164 57535 835192 -;;;;;; 607000)) +;;;### (autoloads nil "url-cookie" "url/url-cookie.el" (0 0 0 0)) +;;; Generated autoloads from url/url-cookie.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cookie" '("url-cookie"))) + +;;;*** + +;;;### (autoloads nil "url-dav" "url/url-dav.el" (0 0 0 0)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -29228,10 +34493,32 @@ added to this list, so most requests can just pass in nil. \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dav" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-file" "url/url-file.el" (22164 57535 835192 -;;;;;; 607000)) +;;;### (autoloads nil "url-dired" "url/url-dired.el" (0 0 0 0)) +;;; Generated autoloads from url/url-dired.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dired" '("url-"))) + +;;;*** + +;;;### (autoloads nil "url-domsuf" "url/url-domsuf.el" (0 0 0 0)) +;;; Generated autoloads from url/url-domsuf.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-domsuf" '("url-domsuf-"))) + +;;;*** + +;;;### (autoloads nil "url-expand" "url/url-expand.el" (0 0 0 0)) +;;; Generated autoloads from url/url-expand.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-expand" '("url-"))) + +;;;*** + +;;;### (autoloads nil "url-file" "url/url-file.el" (0 0 0 0)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -29239,10 +34526,25 @@ Handle file: and ftp: URLs. \(fn URL CALLBACK CBARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-file" '("url-file-"))) + +;;;*** + +;;;### (autoloads nil "url-ftp" "url/url-ftp.el" (0 0 0 0)) +;;; Generated autoloads from url/url-ftp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ftp" '("url-ftp"))) + ;;;*** -;;;### (autoloads nil "url-gw" "url/url-gw.el" (22218 60997 164333 -;;;;;; 743000)) +;;;### (autoloads nil "url-future" "url/url-future.el" (0 0 0 0)) +;;; Generated autoloads from url/url-future.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-future" '("url-future-"))) + +;;;*** + +;;;### (autoloads nil "url-gw" "url/url-gw.el" (0 0 0 0)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -29261,15 +34563,18 @@ overriding the value of `url-gateway-method'. \(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-gw" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (22164 -;;;;;; 57535 835192 607000)) +;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ Non-nil if Url-Handler mode is enabled. -See the command `url-handler-mode' for a description of this minor mode. +See the `url-handler-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `url-handler-mode'.") @@ -29323,9 +34628,18 @@ if it had been inserted from a file named URL. \(fn URL &optional VISIT BEG END REPLACE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-handlers" '("url-"))) + +;;;*** + +;;;### (autoloads nil "url-history" "url/url-history.el" (0 0 0 0)) +;;; Generated autoloads from url/url-history.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-history" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-http" "url/url-http.el" t) +;;;### (autoloads nil "url-http" "url/url-http.el" (0 0 0 0)) ;;; Generated autoloads from url/url-http.el (autoload 'url-default-expander "url-expand") @@ -29335,10 +34649,18 @@ if it had been inserted from a file named URL. (autoload 'url-https-file-readable-p "url-http") (autoload 'url-https-file-attributes "url-http") +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-http" '("url-h"))) + +;;;*** + +;;;### (autoloads nil "url-imap" "url/url-imap.el" (0 0 0 0)) +;;; Generated autoloads from url/url-imap.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-imap" '("url-imap"))) + ;;;*** -;;;### (autoloads nil "url-irc" "url/url-irc.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-irc" "url/url-irc.el" (0 0 0 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -29346,10 +34668,11 @@ if it had been inserted from a file named URL. \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-irc" '("url-irc-"))) + ;;;*** -;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (0 0 0 0)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -29360,10 +34683,11 @@ URL can be a URL string, or a URL vector of the type returned by \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ldap" '("url-ldap-"))) + ;;;*** -;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (22164 57535 -;;;;;; 839192 607000)) +;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (0 0 0 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -29376,10 +34700,18 @@ Handle the mailto: URL syntax. \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-mailto" '("url-mail-goto-field"))) + +;;;*** + +;;;### (autoloads nil "url-methods" "url/url-methods.el" (0 0 0 0)) +;;; Generated autoloads from url/url-methods.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-methods" '("url-scheme-"))) + ;;;*** -;;;### (autoloads nil "url-misc" "url/url-misc.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-misc" "url/url-misc.el" (0 0 0 0)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -29408,10 +34740,11 @@ Fetch a data URL (RFC 2397). \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-misc" '("url-do-terminal-emulator"))) + ;;;*** -;;;### (autoloads nil "url-news" "url/url-news.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-news" "url/url-news.el" (0 0 0 0)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29424,10 +34757,18 @@ Fetch a data URL (RFC 2397). \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-news" '("url-news-"))) + +;;;*** + +;;;### (autoloads nil "url-nfs" "url/url-nfs.el" (0 0 0 0)) +;;; Generated autoloads from url/url-nfs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-nfs" '("url-nfs"))) + ;;;*** -;;;### (autoloads nil "url-ns" "url/url-ns.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-ns" "url/url-ns.el" (0 0 0 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -29465,10 +34806,11 @@ Fetch a data URL (RFC 2397). \(fn KEY &optional DEFAULT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ns" '("url-ns-"))) + ;;;*** -;;;### (autoloads nil "url-parse" "url/url-parse.el" (22164 57535 -;;;;;; 839192 607000)) +;;;### (autoloads nil "url-parse" "url/url-parse.el" (0 0 0 0)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -29517,10 +34859,11 @@ parses to \(fn URL)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-parse" '("url-"))) + ;;;*** -;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (22164 57535 -;;;;;; 839192 607000)) +;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (0 0 0 0)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -29528,10 +34871,18 @@ Setup variables that expose info about you and your system. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-privacy" '("url-device-type"))) + ;;;*** -;;;### (autoloads nil "url-queue" "url/url-queue.el" (22200 31055 -;;;;;; 590669 23000)) +;;;### (autoloads nil "url-proxy" "url/url-proxy.el" (0 0 0 0)) +;;; Generated autoloads from url/url-proxy.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-proxy" '("url-"))) + +;;;*** + +;;;### (autoloads nil "url-queue" "url/url-queue.el" (0 0 0 0)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -29543,10 +34894,11 @@ The variable `url-queue-timeout' sets a timeout. \(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-queue" '("url-queue"))) + ;;;*** -;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (22174 6972 -;;;;;; 820792 520000)) +;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (0 0 0 0)) ;;; Generated autoloads from url/url-tramp.el (defvar url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") "\ @@ -29562,10 +34914,11 @@ would have been passed to OPERATION. \(fn OPERATION &rest ARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-tramp" '("url-tramp-convert-"))) + ;;;*** -;;;### (autoloads nil "url-util" "url/url-util.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-util" "url/url-util.el" (0 0 0 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29731,10 +35084,18 @@ This uses `url-current-object', set locally to the buffer. \(fn &optional NO-SHOW)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-util" '("url-"))) + ;;;*** -;;;### (autoloads nil "userlock" "userlock.el" (22164 57535 839192 -;;;;;; 607000)) +;;;### (autoloads nil "url-vars" "url/url-vars.el" (0 0 0 0)) +;;; Generated autoloads from url/url-vars.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-vars" '("url-"))) + +;;;*** + +;;;### (autoloads nil "userlock" "userlock.el" (0 0 0 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29749,6 +35110,11 @@ in any way you like. \(fn FILE OPPONENT)" nil nil) +(autoload 'userlock--ask-user-about-supersession-threat "userlock" "\ + + +\(fn FN)" nil nil) + (autoload 'ask-user-about-supersession-threat "userlock" "\ Ask a user who is about to modify an obsolete buffer what to do. This function has two choices: it can return, in which case the modification @@ -29760,10 +35126,11 @@ The buffer in question is current when this function is called. \(fn FN)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "userlock" '("ask-user-about-" "userlock--check-content-unchanged" "file-"))) + ;;;*** -;;;### (autoloads nil "utf-7" "international/utf-7.el" (22164 57534 -;;;;;; 755192 607000)) +;;;### (autoloads nil "utf-7" "international/utf-7.el" (0 0 0 0)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -29786,10 +35153,11 @@ The buffer in question is current when this function is called. \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf-7" '("utf-7-"))) + ;;;*** -;;;### (autoloads nil "utf7" "international/utf7.el" (22221 37189 -;;;;;; 924505 663000)) +;;;### (autoloads nil "utf7" "international/utf7.el" (0 0 0 0)) ;;; Generated autoloads from international/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29797,10 +35165,11 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. \(fn STRING &optional FOR-IMAP)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf7" '("utf7-"))) + ;;;*** -;;;### (autoloads nil "uudecode" "mail/uudecode.el" (22164 57534 -;;;;;; 843192 607000)) +;;;### (autoloads nil "uudecode" "mail/uudecode.el" (0 0 0 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29822,9 +35191,11 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. \(fn START END &optional FILE-NAME)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uudecode" '("uudecode-"))) + ;;;*** -;;;### (autoloads nil "vc" "vc/vc.el" (22164 57535 887192 607000)) +;;;### (autoloads nil "vc" "vc/vc.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -29853,6 +35224,10 @@ backend of FILE. If FILE is not registered, then the first backend in `vc-handled-backends' that declares itself responsible for FILE is returned. +Note that if FILE is a symbolic link, it will not be resolved -- +the responsible backend system for the symbolic link itself will +be reported. + \(fn FILE)" nil nil) (autoload 'vc-next-action "vc" "\ @@ -30138,10 +35513,11 @@ Return the branch part of a revision number REV. \(fn REV)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc" '("vc-" "with-vc-properties"))) + ;;;*** -;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (22164 57535 -;;;;;; 863192 607000)) +;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -30178,10 +35554,11 @@ should be applied to the background or to the foreground. \(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-annotate" '("vc-"))) + ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (22164 57535 863192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -30195,10 +35572,11 @@ Name of the format file in a .bzr directory.") (load "vc-bzr" nil t) (vc-bzr-registered file)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-bzr" '("vc-bzr-"))) + ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (22164 57535 863192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) "Return non-nil if file F is registered with CVS." @@ -30207,10 +35585,18 @@ Name of the format file in a .bzr directory.") (load "vc-cvs" nil t) (vc-cvs-registered f))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-cvs" '("vc-cvs-"))) + +;;;*** + +;;;### (autoloads nil "vc-dav" "vc/vc-dav.el" (0 0 0 0)) +;;; Generated autoloads from vc/vc-dav.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dav" '("vc-dav-"))) + ;;;*** -;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (22164 57535 867192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -30232,10 +35618,12 @@ These are the commands available for use in the file status buffer: \(fn DIR &optional BACKEND)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dir" '("vc-"))) + ;;;*** -;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (22164 -;;;;;; 57535 867192 607000)) +;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -30256,10 +35644,18 @@ case, and the process object in the asynchronous case. \(fn BUFFER OKSTATUS COMMAND FILE-OR-LIST &rest FLAGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dispatcher" '("vc-"))) + +;;;*** + +;;;### (autoloads nil "vc-filewise" "vc/vc-filewise.el" (0 0 0 0)) +;;; Generated autoloads from vc/vc-filewise.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-filewise" '("vc-"))) + ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (22226 55133 180211 -;;;;;; 947000)) +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) "Return non-nil if FILE is registered with git." @@ -30268,9 +35664,11 @@ case, and the process object in the asynchronous case. (load "vc-git" nil t) (vc-git-registered file)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-git" '("vc-git-"))) + ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (22201 51907 668435 567000)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -30279,10 +35677,11 @@ case, and the process object in the asynchronous case. (load "vc-hg" nil t) (vc-hg-registered file)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-hg" '("vc-hg-"))) + ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (22189 60739 313741 -;;;;;; 19000)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN" "\ @@ -30296,10 +35695,11 @@ Name of the monotone directory's format file.") (load "vc-mtn" nil t) (vc-mtn-registered file)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-mtn" '("vc-mtn-"))) + ;;;*** -;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (22164 57535 883192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -30310,10 +35710,11 @@ For a description of possible values, see `vc-check-master-templates'.") (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-rcs" '("vc-r"))) + ;;;*** -;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (22164 57535 883192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -30329,10 +35730,11 @@ Return the name of a master file in the SCCS project directory. Does not check whether the file exists but returns nil if it does not find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) (when project-dir (if (file-name-absolute-p project-dir) (setq dirs (quote ("SCCS" ""))) (setq dirs (quote ("src/SCCS" "src" "source/SCCS" "source"))) (setq project-dir (expand-file-name (concat "~" project-dir)))) (while (and (not dir) dirs) (setq dir (expand-file-name (car dirs) project-dir)) (unless (file-directory-p dir) (setq dir nil) (setq dirs (cdr dirs)))) (and dir (expand-file-name (concat "s." basename) dir))))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-sccs" '("vc-sccs-"))) + ;;;*** -;;;### (autoloads nil "vc-src" "vc/vc-src.el" (22164 57535 883192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-src" "vc/vc-src.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-src.el (defvar vc-src-master-templates (purecopy '("%s.src/%s,v")) "\ @@ -30343,10 +35745,11 @@ For a description of possible values, see `vc-check-master-templates'.") (defun vc-src-registered (f) (vc-default-registered 'src f)) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-src" '("vc-src-"))) + ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (22164 57535 887192 -;;;;;; 607000)) +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) (let ((admin-dir (cond ((and (eq system-type 'windows-nt) @@ -30357,10 +35760,19 @@ For a description of possible values, see `vc-check-master-templates'.") (load "vc-svn" nil t) (vc-svn-registered f)))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-svn" '("vc-svn-"))) + +;;;*** + +;;;### (autoloads nil "vcursor" "vcursor.el" (0 0 0 0)) +;;; Generated autoloads from vcursor.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vcursor" '("vcursor-"))) + ;;;*** -;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (22164 -;;;;;; 57535 579192 607000)) +;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/vera-mode.el (push (purecopy '(vera-mode 2 28)) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -30416,10 +35828,12 @@ Key bindings: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vera-mode" '("vera-"))) + ;;;*** ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (22164 57535 607192 607000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30556,10 +35970,12 @@ Key bindings specific to `verilog-mode-map' are: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "verilog-mode" '("vl-" "verilog-" "electric-verilog-"))) + ;;;*** -;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (22189 -;;;;;; 60739 197741 19000)) +;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -30927,7 +36343,7 @@ Usage: SPECIAL MENUES: As an alternative to the speedbar, an index menu can be added (set option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu - (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up + (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the @@ -31111,10 +36527,12 @@ Key bindings: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vhdl-mode" '("vhdl-"))) + ;;;*** -;;;### (autoloads nil "viet-util" "language/viet-util.el" (22164 -;;;;;; 57534 787192 607000)) +;;;### (autoloads nil "viet-util" "language/viet-util.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -31156,9 +36574,11 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp"))) + ;;;*** -;;;### (autoloads nil "view" "view.el" (22164 57535 891192 607000)) +;;;### (autoloads nil "view" "view.el" (0 0 0 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31341,7 +36761,7 @@ x exchanges point and mark. Mark ring is pushed at start of every successful search and when jump to line occurs. The mark is set on jump to buffer start or end. \\[point-to-register] save current position in character register. -' go to position saved in character register. +\\=' go to position saved in character register. s do forward incremental search. r do reverse incremental search. \\[View-search-regexp-forward] searches forward for regular expression, starting after current page. @@ -31412,10 +36832,11 @@ Exit View mode and make the current buffer editable. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "view" '("view-" "View-"))) + ;;;*** -;;;### (autoloads nil "viper" "emulation/viper.el" (22164 57534 239192 -;;;;;; 607000)) +;;;### (autoloads nil "viper" "emulation/viper.el" (0 0 0 0)) ;;; Generated autoloads from emulation/viper.el (push (purecopy '(viper 3 14 1)) package--builtin-versions) @@ -31430,10 +36851,95 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper" '("viper-" "set-viper-state-in-major-mode" "this-major-mode-requires-vi-state"))) + +;;;*** + +;;;### (autoloads nil "viper-cmd" "emulation/viper-cmd.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from emulation/viper-cmd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-cmd" '("viper-"))) + +;;;*** + +;;;### (autoloads nil "viper-ex" "emulation/viper-ex.el" (0 0 0 0)) +;;; Generated autoloads from emulation/viper-ex.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-ex" '("ex-" "viper-"))) + +;;;*** + +;;;### (autoloads nil "viper-init" "emulation/viper-init.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/viper-init.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-init" '("viper-"))) + +;;;*** + +;;;### (autoloads nil "viper-keym" "emulation/viper-keym.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/viper-keym.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-keym" '("viper-" "ex-read-filename-map"))) + +;;;*** + +;;;### (autoloads nil "viper-macs" "emulation/viper-macs.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/viper-macs.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-macs" '("viper-" "ex-"))) + +;;;*** + +;;;### (autoloads nil "viper-mous" "emulation/viper-mous.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/viper-mous.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-mous" '("viper-"))) + +;;;*** + +;;;### (autoloads nil "viper-util" "emulation/viper-util.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from emulation/viper-util.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-util" '("viper"))) + +;;;*** + +;;;### (autoloads nil "vt-control" "vt-control.el" (0 0 0 0)) +;;; Generated autoloads from vt-control.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt-control" '("vt-"))) + +;;;*** + +;;;### (autoloads nil "vt100-led" "vt100-led.el" (0 0 0 0)) +;;; Generated autoloads from vt100-led.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt100-led" '("led-"))) + +;;;*** + +;;;### (autoloads nil "w32-fns" "w32-fns.el" (0 0 0 0)) +;;; Generated autoloads from w32-fns.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-fns" '("w32-"))) + +;;;*** + +;;;### (autoloads nil "w32-vars" "w32-vars.el" (0 0 0 0)) +;;; Generated autoloads from w32-vars.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-vars" '("w32-"))) + ;;;*** -;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (22164 -;;;;;; 57534 215192 607000)) +;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31521,9 +37027,11 @@ this is equivalent to `display-warning', using \(fn MESSAGE &rest ARGS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "warnings" '("warning-" "log-warning-minimum-level" "display-warning-minimum-level"))) + ;;;*** -;;;### (autoloads nil "wdired" "wdired.el" (22226 55133 224211 947000)) +;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0)) ;;; Generated autoloads from wdired.el (push (purecopy '(wdired 2 0)) package--builtin-versions) @@ -31539,10 +37047,11 @@ See `wdired-mode'. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wdired" '("wdired-"))) + ;;;*** -;;;### (autoloads nil "webjump" "net/webjump.el" (22164 57535 31192 -;;;;;; 607000)) +;;;### (autoloads nil "webjump" "net/webjump.el" (0 0 0 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31556,10 +37065,12 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "webjump" '("webjump-"))) + ;;;*** -;;;### (autoloads nil "which-func" "progmodes/which-func.el" (22164 -;;;;;; 57535 635192 607000)) +;;;### (autoloads nil "which-func" "progmodes/which-func.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31568,7 +37079,8 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke (defvar which-function-mode nil "\ Non-nil if Which-Function mode is enabled. -See the command `which-function-mode' for a description of this minor mode. +See the `which-function-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `which-function-mode'.") @@ -31587,18 +37099,21 @@ in certain major modes. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "which-func" '("which-func"))) + ;;;*** -;;;### (autoloads nil "whitespace" "whitespace.el" (22164 57535 899192 -;;;;;; 607000)) +;;;### (autoloads nil "whitespace" "whitespace.el" (0 0 0 0)) ;;; Generated autoloads from whitespace.el (push (purecopy '(whitespace 13 2 2)) package--builtin-versions) (autoload 'whitespace-mode "whitespace" "\ Toggle whitespace visualization (Whitespace mode). With a prefix argument ARG, enable Whitespace mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'. @@ -31608,8 +37123,10 @@ See also `whitespace-style', `whitespace-newline' and (autoload 'whitespace-newline-mode "whitespace" "\ Toggle newline visualization (Whitespace Newline mode). With a prefix argument ARG, enable Whitespace Newline mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. +is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. Use `whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE @@ -31622,7 +37139,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'. (defvar global-whitespace-mode nil "\ Non-nil if Global Whitespace mode is enabled. -See the command `global-whitespace-mode' for a description of this minor mode. +See the `global-whitespace-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-whitespace-mode'.") @@ -31632,8 +37150,10 @@ or call the function `global-whitespace-mode'.") (autoload 'global-whitespace-mode "whitespace" "\ Toggle whitespace visualization globally (Global Whitespace mode). With a prefix argument ARG, enable Global Whitespace mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable it if ARG is omitted or nil. +is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'. @@ -31642,7 +37162,8 @@ See also `whitespace-style', `whitespace-newline' and (defvar global-whitespace-newline-mode nil "\ Non-nil if Global Whitespace-Newline mode is enabled. -See the command `global-whitespace-newline-mode' for a description of this minor mode. +See the `global-whitespace-newline-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `global-whitespace-newline-mode'.") @@ -31652,8 +37173,10 @@ or call the function `global-whitespace-newline-mode'.") (autoload 'global-whitespace-newline-mode "whitespace" "\ Toggle global newline visualization (Global Whitespace Newline mode). With a prefix argument ARG, enable Global Whitespace Newline mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable it if ARG is omitted or nil. +if ARG is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. Use `global-whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including @@ -31826,13 +37349,13 @@ The problems cleaned up are: If `whitespace-style' includes the value `empty', remove all empty lines at beginning and/or end of buffer. -3. 8 or more SPACEs at beginning of line. +3. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by + TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -31849,7 +37372,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -6. 8 or more SPACEs after TAB. +6. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -31868,13 +37391,13 @@ Cleanup some blank problems at region. The problems cleaned up are: -1. 8 or more SPACEs at beginning of line. +1. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by TABs, + if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -31891,7 +37414,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -4. 8 or more SPACEs after TAB. +4. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -31920,13 +37443,8 @@ non-nil. If FORCE is non-nil or \\[universal-argument] was pressed just before calling `whitespace-report-region' interactively, it -forces `whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab +forces all classes of whitespace problem to be considered +significant. If REPORT-IF-BOGUS is t, it reports only when there are any whitespace problems in buffer; if it is `never', it does not @@ -31938,9 +37456,9 @@ Report if some of the following whitespace problems exist: empty 1. empty lines at beginning of buffer. empty 2. empty lines at end of buffer. trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. + indentation 4. line starts with `tab-width' or more SPACEs. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. * If `indent-tabs-mode' is nil: empty 1. empty lines at beginning of buffer. @@ -31948,7 +37466,7 @@ Report if some of the following whitespace problems exist: trailing 3. SPACEs or TABs at end of line. indentation 4. TABS at beginning of line. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. See `whitespace-style' for documentation. See also `whitespace-cleanup' and `whitespace-cleanup-region' for @@ -31956,10 +37474,11 @@ cleaning up these problems. \(fn START END &optional FORCE REPORT-IF-BOGUS)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "whitespace" '("whitespace-"))) + ;;;*** -;;;### (autoloads nil "wid-browse" "wid-browse.el" (22164 57535 899192 -;;;;;; 607000)) +;;;### (autoloads nil "wid-browse" "wid-browse.el" (0 0 0 0)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -31985,10 +37504,11 @@ if ARG is omitted or nil. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-browse" '("widget-"))) + ;;;*** -;;;### (autoloads nil "wid-edit" "wid-edit.el" (22164 57535 915192 -;;;;;; 607000)) +;;;### (autoloads nil "wid-edit" "wid-edit.el" (0 0 0 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32028,10 +37548,11 @@ Setup current buffer so editing string widgets works. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-edit" '("widget-"))) + ;;;*** -;;;### (autoloads nil "windmove" "windmove.el" (22164 57535 919192 -;;;;;; 607000)) +;;;### (autoloads nil "windmove" "windmove.el" (0 0 0 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -32081,14 +37602,17 @@ Default MODIFIER is `shift'. \(fn &optional MODIFIER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "windmove" '("windmove-"))) + ;;;*** -;;;### (autoloads nil "winner" "winner.el" (22164 57535 935192 607000)) +;;;### (autoloads nil "winner" "winner.el" (0 0 0 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ Non-nil if Winner mode is enabled. -See the command `winner-mode' for a description of this minor mode. +See the `winner-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `winner-mode'.") @@ -32099,14 +37623,22 @@ or call the function `winner-mode'.") Toggle Winner mode on or off. With a prefix argument ARG, enable Winner mode if ARG is positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. -\\{winner-mode-map} +the mode if ARG is omitted or nil, and toggle it if ARG is ‘toggle’. + +Winner mode is a global minor mode that records the changes in +the window configuration (i.e. how the frames are partitioned +into windows) so that the changes can be \"undone\" using the +command `winner-undo'. By default this one is bound to the key +sequence `C-c <left>'. If you change your mind (while undoing), +you can press `C-c <right>' (calling `winner-redo'). \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "winner" '("winner-"))) + ;;;*** -;;;### (autoloads nil "woman" "woman.el" (22220 16330 963423 271000)) +;;;### (autoloads nil "woman" "woman.el" (0 0 0 0)) ;;; Generated autoloads from woman.el (push (purecopy '(woman 0 551)) package--builtin-versions) @@ -32153,9 +37685,18 @@ Default bookmark handler for Woman buffers. \(fn BOOKMARK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "woman" '("woman" "WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp"))) + +;;;*** + +;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0)) +;;; Generated autoloads from x-dnd.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "x-dnd" '("x-dnd-"))) + ;;;*** -;;;### (autoloads nil "xml" "xml.el" (22164 57535 943192 607000)) +;;;### (autoloads nil "xml" "xml.el" (0 0 0 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -32209,10 +37750,11 @@ Both features can be combined by providing a cons cell \(fn &optional BEG END BUFFER PARSE-DTD PARSE-NS)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xml" '("xml-"))) + ;;;*** -;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (22171 30780 172984 -;;;;;; 795000)) +;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (0 0 0 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32228,10 +37770,11 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. \(fn &optional LIMIT)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xmltok" '("xmltok-"))) + ;;;*** -;;;### (autoloads nil "xref" "progmodes/xref.el" (22220 16330 839423 -;;;;;; 271000)) +;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/xref.el (autoload 'xref-find-backend "xref" "\ @@ -32296,15 +37839,31 @@ IGNORES is a list of glob patterns. \(fn REGEXP FILES DIR IGNORES)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xref" '("xref-"))) + +;;;*** + +;;;### (autoloads nil "xscheme" "progmodes/xscheme.el" (0 0 0 0)) +;;; Generated autoloads from progmodes/xscheme.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xscheme" '("xscheme-" "start-scheme" "scheme-" "exit-scheme-interaction-mode" "verify-xscheme-buffer" "local-" "global-set-scheme-interaction-buffer" "run-scheme" "reset-scheme" "default-xscheme-runlight"))) + ;;;*** -;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (22164 57535 947192 -;;;;;; 607000)) +;;;### (autoloads nil "xsd-regexp" "nxml/xsd-regexp.el" (0 0 0 0)) +;;; Generated autoloads from nxml/xsd-regexp.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xsd-regexp" '("xsdre-"))) + +;;;*** + +;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (0 0 0 0)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ Non-nil if Xterm-Mouse mode is enabled. -See the command `xterm-mouse-mode' for a description of this minor mode. +See the `xterm-mouse-mode' command +for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `xterm-mouse-mode'.") @@ -32326,10 +37885,11 @@ down the SHIFT key while pressing the mouse button. \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-"))) + ;;;*** -;;;### (autoloads nil "xwidget" "xwidget.el" (22195 13278 495727 -;;;;;; 967000)) +;;;### (autoloads nil "xwidget" "xwidget.el" (0 0 0 0)) ;;; Generated autoloads from xwidget.el (autoload 'xwidget-webkit-browse-url "xwidget" "\ @@ -32339,9 +37899,11 @@ Interactively, URL defaults to the string looking like a url around point. \(fn URL &optional NEW-SESSION)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xwidget" '("xwidget-"))) + ;;;*** -;;;### (autoloads nil "yenc" "mail/yenc.el" (22221 37189 964505 663000)) +;;;### (autoloads nil "yenc" "mail/yenc.el" (0 0 0 0)) ;;; Generated autoloads from mail/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -32354,9 +37916,18 @@ Extract file name from an yenc header. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "yenc" '("yenc-"))) + +;;;*** + +;;;### (autoloads nil "zeroconf" "net/zeroconf.el" (0 0 0 0)) +;;; Generated autoloads from net/zeroconf.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zeroconf" '("zeroconf-"))) + ;;;*** -;;;### (autoloads nil "zone" "play/zone.el" (22164 57535 307192 607000)) +;;;### (autoloads nil "zone" "play/zone.el" (0 0 0 0)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -32364,225 +37935,120 @@ Zone out, completely. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zone" '("zone-"))) + ;;;*** -;;;### (autoloads nil nil ("calc/calc-aent.el" "calc/calc-alg.el" -;;;;;; "calc/calc-arith.el" "calc/calc-bin.el" "calc/calc-comb.el" -;;;;;; "calc/calc-cplx.el" "calc/calc-embed.el" "calc/calc-ext.el" -;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el" -;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el" -;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el" -;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el" -;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el" -;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el" -;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el" -;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el" -;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el" -;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el" -;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el" -;;;;;; "calc/calcsel2.el" "calendar/cal-bahai.el" "calendar/cal-coptic.el" -;;;;;; "calendar/cal-french.el" "calendar/cal-html.el" "calendar/cal-islam.el" -;;;;;; "calendar/cal-iso.el" "calendar/cal-julian.el" "calendar/cal-loaddefs.el" -;;;;;; "calendar/cal-mayan.el" "calendar/cal-menu.el" "calendar/cal-move.el" -;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el" -;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el" -;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el" -;;;;;; "cedet/cedet-idutils.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" +;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "buff-menu.el" +;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-loaddefs.el" +;;;;;; "calc/calc-misc.el" "calc/calc-yank.el" "calendar/cal-loaddefs.el" +;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "case-table.el" ;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el" -;;;;;; "cedet/ede/custom.el" "cedet/ede/detect.el" "cedet/ede/dired.el" -;;;;;; "cedet/ede/emacs.el" "cedet/ede/files.el" "cedet/ede/generic.el" -;;;;;; "cedet/ede/linux.el" "cedet/ede/loaddefs.el" "cedet/ede/locate.el" -;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" -;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" -;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" -;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" -;;;;;; "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" "cedet/ede/proj.el" -;;;;;; "cedet/ede/project-am.el" "cedet/ede/shell.el" "cedet/ede/simple.el" -;;;;;; "cedet/ede/source.el" "cedet/ede/speedbar.el" "cedet/ede/srecode.el" -;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el" -;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/debug.el" -;;;;;; "cedet/semantic/analyze/fcn.el" "cedet/semantic/analyze/refs.el" -;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el" -;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" -;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el" -;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" -;;;;;; "cedet/semantic/db-debug.el" "cedet/semantic/db-ebrowse.el" -;;;;;; "cedet/semantic/db-el.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" -;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-javascript.el" -;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el" -;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate.el" +;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" +;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" +;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" +;;;;;; "cedet/ede/shell.el" "cedet/ede/speedbar.el" "cedet/ede/system.el" +;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" +;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" +;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/el.el" +;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make.el" +;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/complete.el" +;;;;;; "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" +;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-mode.el" +;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el" ;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" -;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/ede-grammar.el" -;;;;;; "cedet/semantic/edit.el" "cedet/semantic/find.el" "cedet/semantic/format.el" -;;;;;; "cedet/semantic/fw.el" "cedet/semantic/grammar-wy.el" "cedet/semantic/grammar.el" -;;;;;; "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" -;;;;;; "cedet/semantic/idle.el" "cedet/semantic/imenu.el" "cedet/semantic/java.el" -;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el" -;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/sb.el" "cedet/semantic/scope.el" -;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el" -;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/filter.el" +;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el" +;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/html.el" +;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el" +;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" +;;;;;; "cedet/semantic/loaddefs.el" "cedet/semantic/mru-bookmark.el" +;;;;;; "cedet/semantic/scope.el" "cedet/semantic/senator.el" "cedet/semantic/sort.el" +;;;;;; "cedet/semantic/symref.el" "cedet/semantic/symref/cscope.el" ;;;;;; "cedet/semantic/symref/global.el" "cedet/semantic/symref/grep.el" ;;;;;; "cedet/semantic/symref/idutils.el" "cedet/semantic/symref/list.el" ;;;;;; "cedet/semantic/tag-file.el" "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el" ;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el" -;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el" ;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el" -;;;;;; "cedet/semantic/wisent/python.el" "cedet/semantic/wisent/wisent.el" -;;;;;; "cedet/srecode/args.el" "cedet/srecode/compile.el" "cedet/srecode/cpp.el" -;;;;;; "cedet/srecode/ctxt.el" "cedet/srecode/dictionary.el" "cedet/srecode/document.el" -;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el" -;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el" -;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el" -;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el" -;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt.el" "cedet/srecode/table.el" -;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "cus-dep.el" -;;;;;; "dframe.el" "dired-aux.el" "dired-loaddefs.el" "dired-x.el" -;;;;;; "dom.el" "dos-fns.el" "dos-vars.el" "dos-w32.el" "dynamic-setting.el" -;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" -;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" -;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" +;;;;;; "cedet/semantic/wisent/python.el" "cedet/srecode/compile.el" +;;;;;; "cedet/srecode/cpp.el" "cedet/srecode/document.el" "cedet/srecode/el.el" +;;;;;; "cedet/srecode/expandproto.el" "cedet/srecode/getset.el" +;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/loaddefs.el" +;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/srt.el" +;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "composite.el" +;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-loaddefs.el" +;;;;;; "dired-x.el" "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" +;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-generic.el" "emacs-lisp/cl-loaddefs.el" +;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" "emacs-lisp/cl-seq.el" ;;;;;; "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-loaddefs.el" -;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el" -;;;;;; "emacs-lisp/generator.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" -;;;;;; "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el" -;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/edt-lk201.el" -;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el" "emulation/edt-vt100.el" -;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el" "emulation/viper-init.el" -;;;;;; "emulation/viper-keym.el" "emulation/viper-macs.el" "emulation/viper-mous.el" -;;;;;; "emulation/viper-util.el" "erc/erc-backend.el" "erc/erc-goodies.el" -;;;;;; "erc/erc-ibuffer.el" "erc/erc-lang.el" "eshell/em-alias.el" -;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el" -;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el" -;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el" -;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el" -;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el" -;;;;;; "eshell/em-xtra.el" "eshell/esh-arg.el" "eshell/esh-cmd.el" -;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el" -;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el" -;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "format-spec.el" -;;;;;; "fringe.el" "generic-x.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el" -;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cloud.el" "gnus/gnus-cus.el" -;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el" -;;;;;; "gnus/gnus-icalendar.el" "gnus/gnus-int.el" "gnus/gnus-logic.el" -;;;;;; "gnus/gnus-mh.el" "gnus/gnus-rfc1843.el" "gnus/gnus-salt.el" -;;;;;; "gnus/gnus-score.el" "gnus/gnus-srvr.el" "gnus/gnus-topic.el" -;;;;;; "gnus/gnus-undo.el" "gnus/gnus-util.el" "gnus/gnus-uu.el" -;;;;;; "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/legacy-gnus-agent.el" -;;;;;; "gnus/mail-source.el" "gnus/messcompat.el" "gnus/mm-archive.el" -;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/mm-util.el" -;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/nnagent.el" -;;;;;; "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" "gnus/nneething.el" -;;;;;; "gnus/nngateway.el" "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnir.el" -;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmairix.el" "gnus/nnmbox.el" -;;;;;; "gnus/nnmh.el" "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el" -;;;;;; "gnus/nnrss.el" "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el" -;;;;;; "gnus/nnweb.el" "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" -;;;;;; "hex-util.el" "hfy-cmap.el" "htmlfontify-loaddefs.el" "ibuf-ext.el" -;;;;;; "ibuffer-loaddefs.el" "image/compface.el" "international/charscript.el" -;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el" -;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/rfc1843.el" -;;;;;; "international/uni-bidi.el" "international/uni-brackets.el" -;;;;;; "international/uni-category.el" "international/uni-combining.el" -;;;;;; "international/uni-comment.el" "international/uni-decimal.el" -;;;;;; "international/uni-decomposition.el" "international/uni-digit.el" -;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el" -;;;;;; "international/uni-name.el" "international/uni-numeric.el" -;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el" -;;;;;; "international/uni-uppercase.el" "kermit.el" "language/hanja-util.el" -;;;;;; "language/thai-word.el" "ldefs-boot.el" "leim/quail/arabic.el" -;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" -;;;;;; "leim/quail/czech.el" "leim/quail/ethiopic.el" "leim/quail/georgian.el" -;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el" -;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/indian.el" -;;;;;; "leim/quail/ipa-praat.el" "leim/quail/ipa.el" "leim/quail/japanese.el" -;;;;;; "leim/quail/lao.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" -;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/lrt.el" -;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el" -;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/rfc1345.el" -;;;;;; "leim/quail/sgml-input.el" "leim/quail/sisheng.el" "leim/quail/slovak.el" -;;;;;; "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" "leim/quail/thai.el" -;;;;;; "leim/quail/tibetan.el" "leim/quail/viqr.el" "leim/quail/vntelex.el" -;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" -;;;;;; "mail/ietf-drums.el" "mail/mail-parse.el" "mail/mail-prsvr.el" -;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2045.el" -;;;;;; "mail/rfc2047.el" "mail/rfc2231.el" "mail/rfc2368.el" "mail/rfc822.el" -;;;;;; "mail/rmail-loaddefs.el" "mail/rmail-spam-filter.el" "mail/rmailedit.el" -;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" -;;;;;; "mail/rmailsum.el" "mail/undigest.el" "mh-e/mh-acros.el" -;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el" -;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el" -;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el" -;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el" -;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el" -;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el" -;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mwheel.el" -;;;;;; "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" "net/eudcb-ldap.el" -;;;;;; "net/eudcb-mab.el" "net/hmac-def.el" "net/hmac-md5.el" "net/imap.el" -;;;;;; "net/ldap.el" "net/mailcap.el" "net/mairix.el" "net/newsticker.el" -;;;;;; "net/nsm.el" "net/puny.el" "net/rfc2104.el" "net/sasl-cram.el" -;;;;;; "net/sasl-digest.el" "net/sasl-scram-rfc.el" "net/sasl.el" -;;;;;; "net/shr-color.el" "net/sieve-manage.el" "net/soap-inspect.el" -;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" -;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el" -;;;;;; "net/tramp-gw.el" "net/tramp-loaddefs.el" "net/tramp-sh.el" -;;;;;; "net/tramp-smb.el" "net/tramp-uu.el" "net/zeroconf.el" "notifications.el" -;;;;;; "nxml/nxml-enc.el" "nxml/nxml-maint.el" "nxml/nxml-ns.el" -;;;;;; "nxml/nxml-outln.el" "nxml/nxml-parse.el" "nxml/nxml-rap.el" -;;;;;; "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el" "nxml/rng-maint.el" -;;;;;; "nxml/rng-match.el" "nxml/rng-parse.el" "nxml/rng-pttrn.el" -;;;;;; "nxml/rng-uri.el" "nxml/rng-util.el" "nxml/xsd-regexp.el" -;;;;;; "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" "org/ob-awk.el" -;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-core.el" -;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el" -;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el" -;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el" -;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el" -;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" "org/ob-matlab.el" -;;;;;; "org/ob-maxima.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el" -;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el" -;;;;;; "org/ob-python.el" "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" -;;;;;; "org/ob-scala.el" "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" -;;;;;; "org/ob-shen.el" "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" -;;;;;; "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-attach.el" -;;;;;; "org/org-bbdb.el" "org/org-bibtex.el" "org/org-clock.el" -;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-datetree.el" -;;;;;; "org/org-docview.el" "org/org-element.el" "org/org-entities.el" -;;;;;; "org/org-eshell.el" "org/org-faces.el" "org/org-feed.el" -;;;;;; "org/org-footnote.el" "org/org-gnus.el" "org/org-habit.el" -;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-info.el" "org/org-inlinetask.el" -;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-list.el" "org/org-loaddefs.el" -;;;;;; "org/org-macro.el" "org/org-mhe.el" "org/org-mobile.el" "org/org-mouse.el" -;;;;;; "org/org-pcomplete.el" "org/org-plot.el" "org/org-protocol.el" -;;;;;; "org/org-rmail.el" "org/org-src.el" "org/org-table.el" "org/org-timer.el" -;;;;;; "org/org-w3m.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" +;;;;;; "emacs-lisp/eieio-loaddefs.el" "emacs-lisp/eieio-opt.el" +;;;;;; "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el" +;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" "emacs-lisp/map-ynp.el" +;;;;;; "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el" +;;;;;; "env.el" "epa-hook.el" "eshell/em-alias.el" "eshell/em-banner.el" +;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" +;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" +;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" +;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" +;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el" +;;;;;; "eshell/esh-groups.el" "facemenu.el" "faces.el" "files.el" +;;;;;; "font-core.el" "font-lock.el" "format.el" "frame.el" "help.el" +;;;;;; "hfy-cmap.el" "htmlfontify-loaddefs.el" "ibuf-ext.el" "ibuffer-loaddefs.el" +;;;;;; "indent.el" "international/characters.el" "international/charprop.el" +;;;;;; "international/charscript.el" "international/cp51932.el" +;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" +;;;;;; "international/uni-brackets.el" "international/uni-category.el" +;;;;;; "international/uni-combining.el" "international/uni-comment.el" +;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" +;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" +;;;;;; "international/uni-mirrored.el" "international/uni-name.el" +;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" +;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" +;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" +;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el" +;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el" +;;;;;; "language/european.el" "language/georgian.el" "language/greek.el" +;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el" +;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el" +;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el" +;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el" +;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el" +;;;;;; "ldefs-boot.el" "leim/quail/arabic.el" "leim/quail/croatian.el" +;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el" +;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el" +;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el" +;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" +;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el" +;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el" +;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/rfc1345.el" "leim/quail/sgml-input.el" +;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" +;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el" +;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmail-loaddefs.el" +;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" +;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" +;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el" +;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" +;;;;;; "obarray.el" "org/ob-core.el" "org/ob-keys.el" "org/ob-lob.el" +;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" +;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-clock.el" +;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el" +;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" +;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-loaddefs.el" +;;;;;; "org/org-mobile.el" "org/org-plot.el" "org/org-table.el" +;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" ;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" ;;;;;; "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" -;;;;;; "org/ox.el" "play/gametree.el" "progmodes/ada-prj.el" "progmodes/cc-align.el" -;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el" -;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el" -;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el" -;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el" -;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el" -;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" -;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-print-loaddefs.el" -;;;;;; "ps-samp.el" "registry.el" "rtree.el" "sb-image.el" "scroll-bar.el" -;;;;;; "soundex.el" "subdirs.el" "svg.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" -;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" +;;;;;; "org/ox.el" "progmodes/elisp-mode.el" "progmodes/prog-mode.el" +;;;;;; "ps-def.el" "ps-mule.el" "ps-print-loaddefs.el" "register.el" +;;;;;; "replace.el" "rfn-eshadow.el" "select.el" "simple.el" "startup.el" +;;;;;; "subdirs.el" "subr.el" "textmodes/fill.el" "textmodes/page.el" +;;;;;; "textmodes/paragraphs.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" ;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" "textmodes/reftex-index.el" ;;;;;; "textmodes/reftex-loaddefs.el" "textmodes/reftex-parse.el" ;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el" -;;;;;; "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" -;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el" -;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el" -;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" -;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el" -;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" -;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" -;;;;;; "vc/vc-filewise.el" "vcursor.el" "vt-control.el" "vt100-led.el" -;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") t) +;;;;;; "textmodes/text-mode.el" "uniquify.el" "vc/ediff-hook.el" +;;;;;; "vc/vc-hooks.el" "version.el" "widget.el" "window.el") (0 +;;;;;; 0 0 0)) ;;;*** diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index 2ff64add6fe..e12c002e244 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -1473,6 +1473,131 @@ keys as being transformed into ( and ) respectively. For ( and ), use ("/" ?б) ("?" ?Б) ("\\" ?') ("|" ?Ы)) +;; This is a slight modification of the `cyrillic-yawerty' input +;; method. In addition to the standard Russian letters, the Tuvan +;; alphabet introduces three letters: `Ң', `Ө' and `Ү'. They were made +;; available in combination with `/' and `N', `T' and `Y' respectively. +(quail-define-package + "cyrillic-tuvan" "Tuvan" "ҢӨҮ" nil + "ЯВЕРТЫ Roman transcription of the Tuvan alphabet + +When preceded by a `/', the letters `N', `T' and `Y' change +as follows. + + keytop | N T Y n t y + --------+------------------ + input | Ң Ө Ү ң ө ү" + nil t t t t nil nil nil nil nil t) + +;; 1! 2ё 3ъ 4Ё 5% 6^ 7& 8* 9( 0) -_ Ч Ю +;; Я В Е Р Т Ы У И О П Ш Щ +;; А С Д Ф Г Х Й К Л ;: '" Э +;; З Ь Ц Ж Б Н М ,< .> /? + +(quail-define-rules + ("1" ?1) + ("2" ?2) + ("3" ?3) + ("4" ?4) + ("5" ?5) + ("6" ?6) + ("7" ?7) + ("8" ?8) + ("9" ?9) + ("0" ?0) + ("-" ?-) + ("=" ?ч) + ("`" ?ю) + ("q" ?я) + ("w" ?в) + ("e" ?е) + ("r" ?р) + ("t" ?т) + ("y" ?ы) + ("u" ?у) + ("i" ?и) + ("o" ?о) + ("p" ?п) + ("[" ?ш) + ("]" ?щ) + ("a" ?а) + ("s" ?с) + ("d" ?д) + ("f" ?ф) + ("g" ?г) + ("h" ?х) + ("j" ?й) + ("k" ?к) + ("l" ?л) + (";" ?\;) + ("'" ?') + ("\\" ?э) + ("z" ?з) + ("x" ?ь) + ("c" ?ц) + ("v" ?ж) + ("b" ?б) + ("n" ?н) + ("m" ?м) + ("," ?,) + ("." ?.) + ("/" ?/) + + ("!" ?!) + ("@" ?ё) + ("#" ?ъ) + ("$" ?Ё) + ("%" ?%) + ("^" ?^) + ("&" ?&) + ("*" ?*) + ("(" ?\() + (")" ?\)) + ("_" ?_) + ("+" ?Ч) + ("~" ?Ю) + ("Q" ?Я) + ("W" ?В) + ("E" ?Е) + ("R" ?Р) + ("T" ?Т) + ("Y" ?Ы) + ("U" ?У) + ("I" ?И) + ("O" ?О) + ("P" ?П) + ("{" ?Ш) + ("}" ?Щ) + ("A" ?А) + ("S" ?С) + ("D" ?Д) + ("F" ?Ф) + ("G" ?Г) + ("H" ?Х) + ("J" ?Й) + ("K" ?К) + ("L" ?Л) + (":" ?:) + ("\"" ?\") + ("|" ?Э) + ("Z" ?З) + ("X" ?Ь) + ("C" ?Ц) + ("V" ?Ж) + ("B" ?Б) + ("N" ?Н) + ("M" ?М) + ("<" ?<) + (">" ?>) + ("?" ??) + + ("/n" ?ң) + ("/t" ?ө) + ("/y" ?ү) + ("/N" ?Ң) + ("/T" ?Ө) + ("/Y" ?Ү)) + ;; Local Variables: ;; coding: utf-8 ;; End: diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el index 365c3c51059..ddb4af53db3 100644 --- a/lisp/leim/quail/czech.el +++ b/lisp/leim/quail/czech.el @@ -142,18 +142,7 @@ ("=[" ?\[) ("=]" ?\]) ("={" ?{) - ("=}" ?}) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("=}" ?})) (quail-define-package "czech-qwerty" "Czech" "CZ" t @@ -260,18 +249,7 @@ ("=[" ?\[) ("=]" ?\]) ("={" ?{) - ("=}" ?}) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("=}" ?})) (quail-define-package "czech-prog-1" "Czech" "CZ" t @@ -350,18 +328,7 @@ All other keys are the same as on standard US keyboard." ("++U" ?Ů) ("+++U" ?Ü) ("+Y" ?Ý) - ("+Z" ?Ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("+Z" ?Ž)) (quail-define-package "czech-prog-2" "Czech" "CZ" t @@ -440,18 +407,7 @@ All other keys are the same as on standard US keyboard." ("++U" ?Ů) ("+++U" ?Ü) ("+Y" ?Ý) - ("+Z" ?Ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("+Z" ?Ž)) (quail-define-package "czech-prog-3" "Czech" "CZ" t @@ -552,17 +508,6 @@ All other keys are the same as on standard US keyboard." ("+u" ?ů) ("+=u" ?ü) ("=y" ?ý) - ("+z" ?ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("+z" ?ž)) ;;; czech.el ends here diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 1c92f6bb38f..728e3529218 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -470,4 +470,105 @@ Full key sequences are listed below:") "tamil-inscript" "Tamil" "TmlIS" "Tamil keyboard Inscript.") +;; Probhat Input Method +(quail-define-package + "bengali-probhat" "Bengali" "BngPB" t + "Probhat keyboard for Bengali/Bangla" nil t nil nil nil nil nil nil nil nil t) + +(quail-define-rules + ("!" ?!) + ("1" ?১) + ("@" ?@) + ("2" ?২) + ("#" ?#) + ("3" ?৩) + ("$" ?৳) + ("4" ?৪) + ("%" ?%) + ("5" ?৫) + ("^" ?^) + ("6" ?৬) + ("&" ?ঞ) + ("7" ?৭) + ("*" ?ৎ) + ("8" ?৮) + ("(" ?\() + ("9" ?৯) + (")" ?\)) + ("0" ?০) + ("_" ?_) + ("-" ?-) + ("+" ?+) + ("=" ?=) + ("Q" ?ধ) + ("q" ?দ) + ("W" ?ঊ) + ("w" ?ূ) + ("E" ?ঈ) + ("e" ?ী) + ("R" ?ড়) + ("r" ?র) + ("T" ?ঠ) + ("t" ?ট) + ("Y" ?ঐ) + ("y" ?এ) + ("U" ?উ) + ("u" ?ু) + ("I" ?ই) + ("i" ?ি) + ("O" ?ঔ) + ("o" ?ও) + ("P" ?ফ) + ("p" ?প) + ("{" ?ৈ) + ("[" ?ে) + ("}" ?ৌ) + ("]" ?ো) + ("A" ?অ) + ("a" ?া) + ("S" ?ষ) + ("s" ?স) + ("D" ?ঢ) + ("d" ?ড) + ("F" ?থ) + ("f" ?ত) + ("G" ?ঘ) + ("g" ?গ) + ("H" ?ঃ) + ("h" ?হ) + ("J" ?ঝ) + ("j" ?জ) + ("K" ?খ) + ("k" ?ক) + ("L" ?ং) + ("l" ?ল) + (":" ?:) + (";" ?\;) + ("\"" ?\") + ("'" ?') + ("|" ?॥) + ("" ?) + ("~" ?~) + ("`" ?) + ("Z" ?য) + ("z" ?য়) + ("X" ?ঢ়) + ("x" ?শ) + ("C" ?ছ) + ("c" ?চ) + ("V" ?ঋ) + ("v" ?আ) + ("B" ?ভ) + ("b" ?ব) + ("N" ?ণ) + ("n" ?ন) + ("M" ?ঙ) + ("m" ?ম) + ("<" ?ৃ) + ("," ?,) + (">" ?ঁ) + ("." ?।) + ("?" ?\?) + ("/" ?্)) + ;;; indian.el ends here diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index c265add83c1..fb3d2ba4902 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -239,10 +239,15 @@ system, including many technical ones. Examples: "\\`\\([^- ]+\\) SIGN\\'") ((lambda (name char) - (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase) - (match-string 2 name)))) + ;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL" + ;; (which is \varphi) are reversed in `ucs-names', so we define + ;; them manually. + (unless (string-match-p "\\<PHI\\>" name) + (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase) + (match-string 2 name))))) "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'") + ("\\phi" ?ϕ) ("\\Box" ?□) ("\\Bumpeq" ?≎) ("\\Cap" ?⋒) @@ -628,12 +633,17 @@ system, including many technical ones. Examples: ("\\vDash" ?⊨) ((lambda (name char) - (concat "\\var" (downcase (match-string 1 name)))) + ;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL" + ;; (which is \varphi) are reversed in `ucs-names', so we define + ;; them manually. + (unless (string-match-p "\\<PHI\\>" name) + (concat "\\var" (downcase (match-string 1 name))))) "\\`GREEK \\([^- ]+\\) SYMBOL\\'") + ("\\varphi" ?φ) ("\\varprime" ?′) ("\\varpropto" ?∝) - ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var. + ("\\varsigma" ?ς) ("\\vartriangleleft" ?⊲) ("\\vartriangleright" ?⊳) ("\\vdash" ?⊢) diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index 078f9f99fab..dd23add9064 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -35,6 +35,9 @@ ;; Maintainer: Włodek Bzyl <matwb@univ.gda.pl> ;; ;; latin-[89]-prefix: Dave Love <fx@gnu.org> +;; +;; polish-prefix: +;; Author: Wojciech Gac <wojciech.s.gac@gmail.com> ;; You might make extra input sequences on the basis of the X ;; locale/*/Compose files (which have both prefix and postfix @@ -188,6 +191,7 @@ diaeresis | \" | \"i -> ï \"\" -> ¨ tilde | ~ | ~n -> ñ cedilla | ~ | ~c -> ç + middle dot | ~ | ~. -> · symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ " nil t nil nil nil nil nil nil nil nil t) @@ -223,6 +227,7 @@ ("~<" ?\«) ("~!" ?¡) ("~?" ?¿) + ("~." ?·) ("~ " ?~) ) @@ -702,6 +707,93 @@ Key translation rules are: (".z" ?ż) ) +(quail-define-package + "polish-prefix" "Polish" "PL>" nil + "Input method for Polish, Kashubian, Kurpie and Silesian. +Similar in spirit to `polish-slash', but uses the most intuitive +prefix for each diacritic. In addition to ordinary Polish diacritics, +this input method also contains characters from the Kashubian, Kurpie +and Silesian (both Steuer and Ślabikŏrzowy szrajbōnek) scripts." + nil t t nil nil nil nil nil nil nil t) + +(quail-define-rules + (",a" ?ą) + (",A" ?Ą) + ("/a" ?á) + ("/A" ?Á) + ("'a" ?á) + ("'A" ?Á) + ("\\a" ?à) + ("\\A" ?À) + ("`a" ?à) + ("`A" ?À) + (".a" ?å) + (".A" ?Å) + ("~a" ?ã) + ("~A" ?Ã) + ("/c" ?ć) + ("/C" ?Ć) + ("'c" ?ć) + ("'C" ?Ć) + ("'e" ?é) + ("'E" ?É) + ("/e" ?é) + ("/E" ?É) + (",e" ?ę) + (",E" ?Ę) + (":e" ?ë) + (":E" ?Ë) + (":i" ?ï) + (":I" ?Ï) + ("/l" ?ł) + ("/L" ?Ł) + ("/n" ?ń) + ("/N" ?Ń) + ("'n" ?ń) + ("'N" ?Ń) + ("`o" ?ò) + ("`O" ?Ò) + ("\\o" ?ò) + ("\\O" ?Ò) + ("'o" ?ó) + ("'O" ?Ó) + ("/o" ?ó) + ("/O" ?Ó) + ("^o" ?ô) + ("^O" ?Ô) + ("-o" ?ō) + ("-O" ?Ō) + ("~o" ?õ) + ("~O" ?Õ) + ("#o" ?ŏ) + ("#O" ?Ŏ) + ("/s" ?ś) + ("/S" ?Ś) + ("'s" ?ś) + ("'S" ?Ś) + ("`u" ?ù) + ("`U" ?Ù) + (".u" ?ů) + (".U" ?Ů) + ("/z" ?ź) + ("/Z" ?Ź) + ("'z" ?ź) + ("'Z" ?Ź) + (".z" ?ż) + (".Z" ?Ż) + ;; Explicit input of prefix characters. Normally, to input a prefix + ;; character itself, one needs to press <Tab>. Definitions below + ;; allow to input those characters by entering them twice. + ("//" ?/) + ("\\\\" ?\\) + ("~~" ?~) + ("''" ?') + ("::" ?:) + ("``" ?`) + ("^^" ?^) + (".." ?.) + (",," ?,) + ("--" ?-)) (quail-define-package "polish-slash" "Polish" "PL>" nil diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el index f500016c892..1b50ee37ccd 100644 --- a/lisp/leim/quail/rfc1345.el +++ b/lisp/leim/quail/rfc1345.el @@ -36,2027 +36,1899 @@ E.g. &a' -> á" (quail-define-rules ;; There doesn't seem to be any point in including ASCII. -;; ("&NU" ?\^@) -;; ("&SH" ?\^A) -;; ("&SX" ?\^B) -;; ("&EX" ?\^C) -;; ("&ET" ?\^D) -;; ("&EQ" ?\^E) -;; ("&AK" ?\^F) -;; ("&BL" ?\^G) -;; ("&BS" ?\^H) -;; ("&HT" 9) -;; ("&LF" 10) -;; ("&VT" ?\^K) -;; ("&FF" ?\^L) -;; ("&CR" 13) -;; ("&SO" ?\^N) -;; ("&SI" ?\^O) -;; ("&DL" ?\^P) -;; ("&D1" ?\^Q) -;; ("&D2" ?\^R) -;; ("&D3" ?\^S) -;; ("&D4" ?\^T) -;; ("&NK" ?\^U) -;; ("&SY" ?\^V) -;; ("&EB" ?\^W) -;; ("&CN" ?\^X) -;; ("&EM" ?\^Y) -;; ("&SB" ?\032) ; ^Z in a file causes trouble on MS systems. -;; ("&EC" ?\033) -;; ("&FS" ?\034) -;; ("&GS" ?\035) -;; ("&RS" ?\036) -;; ("&US" ?\037) -;; ("&SP" ?\ ) -;; ("&!" ?\!) -;; ("&\"" ?\") -;; ("&Nb" ?\#) -;; ("&DO" ?\$) -;; ("&%" ?\%) -;; ("&&" ?\&) -;; ("&'" ?\') -;; ("&(" ?\() -;; ("&)" ?\)) -;; ("&*" ?\*) -;; ("&+" ?\+) -;; ("&," ?\,) -;; ("&-" ?\-) -;; ("&." ?\.) -;; ("&/" ?\/) -;; ("&0" ?\0) -;; ("&1" ?\1) -;; ("&2" ?\2) -;; ("&3" ?\3) -;; ("&4" ?\4) -;; ("&5" ?\5) -;; ("&6" ?\6) -;; ("&7" ?\7) -;; ("&8" ?\8) -;; ("&9" ?\9) -;; ("&:" ?\:) -;; ("&;" ?\;) -;; ("&<" ?\<) -;; ("&=" ?\=) -;; ("&>" ?\>) -;; ("&?" ?\?) -;; ("&At" ?\@) -;; ("&A" ?\A) -;; ("&B" ?\B) -;; ("&C" ?\C) -;; ("&D" ?\D) -;; ("&E" ?\E) -;; ("&F" ?\F) -;; ("&G" ?\G) -;; ("&H" ?\H) -;; ("&I" ?\I) -;; ("&J" ?\J) -;; ("&K" ?\K) -;; ("&L" ?\L) -;; ("&M" ?\M) -;; ("&N" ?\N) -;; ("&O" ?\O) -;; ("&P" ?\P) -;; ("&Q" ?\Q) -;; ("&R" ?\R) -;; ("&S" ?\S) -;; ("&T" ?\T) -;; ("&U" ?\U) -;; ("&V" ?\V) -;; ("&W" ?\W) -;; ("&X" ?\X) -;; ("&Y" ?\Y) -;; ("&Z" ?\Z) -;; ("&<(" ?\[) -;; ("&//" ?\\) -;; ("&)>" ?\]) -;; ("&'>" ?\^) -;; ("&_" ?\_) -;; ("&'!" ?\`) -;; ("&a" ?\a) -;; ("&b" ?\b) -;; ("&c" ?\c) -;; ("&d" ?\d) -;; ("&e" ?\e) -;; ("&f" ?\f) -;; ("&g" ?\g) -;; ("&h" ?\h) -;; ("&i" ?\i) -;; ("&j" ?\j) -;; ("&k" ?\k) -;; ("&l" ?\l) -;; ("&m" ?\m) -;; ("&n" ?\n) -;; ("&o" ?\o) -;; ("&p" ?\p) -;; ("&q" ?\q) -;; ("&r" ?\r) -;; ("&s" ?\s) -;; ("&t" ?\t) -;; ("&u" ?\u) -;; ("&v" ?\v) -;; ("&w" ?\w) -;; ("&x" ?\x) -;; ("&y" ?\y) -;; ("&z" ?\z) -;; ("&(!" ?\{) -;; ("&!!" ?\|) -;; ("&!)" ?\}) -;; ("&'?" ?\~) -;; ("&DT" ?\) - ("&PA" ?\) - ("&HO" ?\) - ("&BH" ?\) - ("&NH" ?\) - ("&IN" ?\) - ("&NL" ?\
) - ("&SA" ?\) - ("&ES" ?\) - ("&HS" ?\) - ("&HJ" ?\) - ("&VS" ?\) - ("&PD" ?\) - ("&PU" ?\) - ("&RI" ?\) - ("&S2" ?\) - ("&S3" ?\) - ("&DC" ?\) - ("&P1" ?\) - ("&P2" ?\) - ("&TS" ?\) - ("&CC" ?\) - ("&MW" ?\) - ("&SG" ?\) - ("&EG" ?\) - ("&SS" ?\) - ("&GC" ?\) - ("&SC" ?\) - ("&CI" ?\) - ("&ST" ?\) - ("&OC" ?\) - ("&PM" ?\) - ("&AC" ?\) - ("&NS" ?\ ) - ("&!I" ?\¡) - ("&Ct" ?\¢) - ("&Pd" ?\£) - ("&Cu" ?\¤) - ("&Ye" ?\¥) - ("&BB" ?\¦) - ("&SE" ?\§) - ("&':" ?\¨) - ("&Co" ?\©) - ("&-a" ?\ª) - ("&<<" ?\«) - ("&NO" ?\¬) - ("&--" ?\) - ("&Rg" ?\®) - ("&'m" ?\¯) - ("&DG" ?\°) - ("&+-" ?\±) - ("&2S" ?\²) - ("&3S" ?\³) - ("&''" ?\´) - ("&My" ?\µ) - ("&PI" ?\¶) - ("&.M" ?\·) - ("&'," ?\¸) - ("&1S" ?\¹) - ("&-o" ?\º) - ("&>>" ?\») - ("&14" ?\¼) - ("&12" ?\½) - ("&34" ?\¾) - ("&?I" ?\¿) - ("&A!" ?\À) - ("&A'" ?\Á) - ("&A>" ?\Â) - ("&A?" ?\Ã) - ("&A:" ?\Ä) - ("&AA" ?\Å) - ("&AE" ?\Æ) - ("&C," ?\Ç) - ("&E!" ?\È) - ("&E'" ?\É) - ("&E>" ?\Ê) - ("&E:" ?\Ë) - ("&I!" ?\Ì) - ("&I'" ?\Í) - ("&I>" ?\Î) - ("&I:" ?\Ï) - ("&D-" ?\Ð) - ("&N?" ?\Ñ) - ("&O!" ?\Ò) - ("&O'" ?\Ó) - ("&O>" ?\Ô) - ("&O?" ?\Õ) - ("&O:" ?\Ö) - ("&*X" ?\×) - ("&O/" ?\Ø) - ("&U!" ?\Ù) - ("&U'" ?\Ú) - ("&U>" ?\Û) - ("&U:" ?\Ü) - ("&Y'" ?\Ý) - ("&TH" ?\Þ) - ("&ss" ?\ß) - ("&a!" ?\à) - ("&a'" ?\á) - ("&a>" ?\â) - ("&a?" ?\ã) - ("&a:" ?\ä) - ("&aa" ?\å) - ("&ae" ?\æ) - ("&c," ?\ç) - ("&e!" ?\è) - ("&e'" ?\é) - ("&e>" ?\ê) - ("&e:" ?\ë) - ("&i!" ?\ì) - ("&i'" ?\í) - ("&i>" ?\î) - ("&i:" ?\ï) - ("&d-" ?\ð) - ("&n?" ?\ñ) - ("&o!" ?\ò) - ("&o'" ?\ó) - ("&o>" ?\ô) - ("&o?" ?\õ) - ("&o:" ?\ö) - ("&-:" ?\÷) - ("&o/" ?\ø) - ("&u!" ?\ù) - ("&u'" ?\ú) - ("&u>" ?\û) - ("&u:" ?\ü) - ("&y'" ?\ý) - ("&th" ?\þ) - ("&y:" ?\ÿ) - ("&A-" ?\Ā) - ("&a-" ?\ā) - ("&A(" ?\Ă) - ("&a(" ?\ă) - ("&A;" ?\Ą) - ("&a;" ?\ą) - ("&C'" ?\Ć) - ("&c'" ?\ć) - ("&C>" ?\Ĉ) - ("&c>" ?\ĉ) - ("&C." ?\Ċ) - ("&c." ?\ċ) - ("&C<" ?\Č) - ("&c<" ?\č) - ("&D<" ?\Ď) - ("&d<" ?\ď) - ("&D/" ?\Đ) - ("&d/" ?\đ) - ("&E-" ?\Ē) - ("&e-" ?\ē) - ("&E(" ?\Ĕ) - ("&e(" ?\ĕ) - ("&E." ?\Ė) - ("&e." ?\ė) - ("&E;" ?\Ę) - ("&e;" ?\ę) - ("&E<" ?\Ě) - ("&e<" ?\ě) - ("&G>" ?\Ĝ) - ("&g>" ?\ĝ) - ("&G(" ?\Ğ) - ("&g(" ?\ğ) - ("&G." ?\Ġ) - ("&g." ?\ġ) - ("&G," ?\Ģ) - ("&g," ?\ģ) - ("&H>" ?\Ĥ) - ("&h>" ?\ĥ) - ("&H/" ?\Ħ) - ("&h/" ?\ħ) - ("&I?" ?\Ĩ) - ("&i?" ?\ĩ) - ("&I-" ?\Ī) - ("&i-" ?\ī) - ("&I(" ?\Ĭ) - ("&i(" ?\ĭ) - ("&I;" ?\Į) - ("&i;" ?\į) - ("&I." ?\İ) - ("&i." ?\ı) - ("&IJ" ?\IJ) - ("&ij" ?\ij) - ("&J>" ?\Ĵ) - ("&j>" ?\ĵ) - ("&K," ?\Ķ) - ("&k," ?\ķ) - ("&kk" ?\ĸ) - ("&L'" ?\Ĺ) - ("&l'" ?\ĺ) - ("&L," ?\Ļ) - ("&l," ?\ļ) - ("&L<" ?\Ľ) - ("&l<" ?\ľ) - ("&L." ?\Ŀ) - ("&l." ?\ŀ) - ("&L/" ?\Ł) - ("&l/" ?\ł) - ("&N'" ?\Ń) - ("&n'" ?\ń) - ("&N," ?\Ņ) - ("&n," ?\ņ) - ("&N<" ?\Ň) - ("&n<" ?\ň) - ("&'n" ?\ʼn) - ("&NG" ?\Ŋ) - ("&ng" ?\ŋ) - ("&O-" ?\Ō) - ("&o-" ?\ō) - ("&O(" ?\Ŏ) - ("&o(" ?\ŏ) - ("&O\"" ?\Ő) - ("&o\"" ?\ő) - ("&OE" ?\Œ) - ("&oe" ?\œ) - ("&R'" ?\Ŕ) - ("&r'" ?\ŕ) - ("&R," ?\Ŗ) - ("&r," ?\ŗ) - ("&R<" ?\Ř) - ("&r<" ?\ř) - ("&S'" ?\Ś) - ("&s'" ?\ś) - ("&S>" ?\Ŝ) - ("&s>" ?\ŝ) - ("&S," ?\Ş) - ("&s," ?\ş) - ("&S<" ?\Š) - ("&s<" ?\š) - ("&T," ?\Ţ) - ("&t," ?\ţ) - ("&T<" ?\Ť) - ("&t<" ?\ť) - ("&T/" ?\Ŧ) - ("&t/" ?\ŧ) - ("&U?" ?\Ũ) - ("&u?" ?\ũ) - ("&U-" ?\Ū) - ("&u-" ?\ū) - ("&U(" ?\Ŭ) - ("&u(" ?\ŭ) - ("&U0" ?\Ů) - ("&u0" ?\ů) - ("&U\"" ?\Ű) - ("&u\"" ?\ű) - ("&U;" ?\Ų) - ("&u;" ?\ų) - ("&W>" ?\Ŵ) - ("&w>" ?\ŵ) - ("&Y>" ?\Ŷ) - ("&y>" ?\ŷ) - ("&Y:" ?\Ÿ) - ("&Z'" ?\Ź) - ("&z'" ?\ź) - ("&Z." ?\Ż) - ("&z." ?\ż) - ("&Z<" ?\Ž) - ("&z<" ?\ž) - ("&s1" ?\ſ) - ("&b/" ?\ƀ) - ("&B2" ?\Ɓ) - ("&C2" ?\Ƈ) - ("&c2" ?\ƈ) - ("&F2" ?\Ƒ) - ("&f2" ?\ƒ) - ("&K2" ?\Ƙ) - ("&k2" ?\ƙ) - ("&O9" ?\Ơ) - ("&o9" ?\ơ) - ("&OI" ?\Ƣ) - ("&oi" ?\ƣ) - ("&yr" ?\Ʀ) - ("&U9" ?\Ư) - ("&u9" ?\ư) - ("&Z/" ?\Ƶ) - ("&z/" ?\ƶ) - ("&ED" ?\Ʒ) - ("&DZ<" ?\DŽ) - ("&Dz<" ?\Dž) - ("&dz<" ?\dž) - ("&LJ3" ?\LJ) - ("&Lj3" ?\Lj) - ("&lj3" ?\lj) - ("&NJ3" ?\NJ) - ("&Nj3" ?\Nj) - ("&nj3" ?\nj) - ("&A<" ?\Ǎ) - ("&a<" ?\ǎ) - ("&I<" ?\Ǐ) - ("&i<" ?\ǐ) - ("&O<" ?\Ǒ) - ("&o<" ?\ǒ) - ("&U<" ?\Ǔ) - ("&u<" ?\ǔ) - ("&U:-" ?\Ǖ) - ("&u:-" ?\ǖ) - ("&U:'" ?\Ǘ) - ("&u:'" ?\ǘ) - ("&U:<" ?\Ǚ) - ("&u:<" ?\ǚ) - ("&U:!" ?\Ǜ) - ("&u:!" ?\ǜ) - ("&e1" ?\ǝ) - ("&A1" ?\Ǟ) - ("&a1" ?\ǟ) - ("&A7" ?\Ǡ) - ("&a7" ?\ǡ) - ("&A3" ?\Ǣ) - ("&a3" ?\ǣ) - ("&G/" ?\Ǥ) - ("&g/" ?\ǥ) - ("&G<" ?\Ǧ) - ("&g<" ?\ǧ) - ("&K<" ?\Ǩ) - ("&k<" ?\ǩ) - ("&O;" ?\Ǫ) - ("&o;" ?\ǫ) - ("&O1" ?\Ǭ) - ("&o1" ?\ǭ) - ("&EZ" ?\Ǯ) - ("&ez" ?\ǯ) - ("&j<" ?\ǰ) - ("&DZ3" ?\DZ) - ("&Dz3" ?\Dz) - ("&dz3" ?\dz) - ("&G'" ?\Ǵ) - ("&g'" ?\ǵ) - ("&AA'" ?\Ǻ) - ("&aa'" ?\ǻ) - ("&AE'" ?\Ǽ) - ("&ae'" ?\ǽ) - ("&O/'" ?\Ǿ) - ("&o/'" ?\ǿ) - ("&A!!" ?\Ȁ) - ("&a!!" ?\ȁ) - ("&A)" ?\Ȃ) - ("&a)" ?\ȃ) - ("&E!!" ?\Ȅ) - ("&e!!" ?\ȅ) - ("&E)" ?\Ȇ) - ("&e)" ?\ȇ) - ("&I!!" ?\Ȉ) - ("&i!!" ?\ȉ) - ("&I)" ?\Ȋ) - ("&i)" ?\ȋ) - ("&O!!" ?\Ȍ) - ("&o!!" ?\ȍ) - ("&O)" ?\Ȏ) - ("&o)" ?\ȏ) - ("&R!!" ?\Ȑ) - ("&r!!" ?\ȑ) - ("&R)" ?\Ȓ) - ("&r)" ?\ȓ) - ("&U!!" ?\Ȕ) - ("&u!!" ?\ȕ) - ("&U)" ?\Ȗ) - ("&u)" ?\ȗ) - ("&r1" ?\ɼ) - ("&ed" ?\ʒ) - ("&;S" ?\ʻ) - ("&1>" ?\ˆ) - ("&'<" ?\ˇ) - ("&1-" ?\ˉ) - ("&1!" ?\ˋ) - ("&'(" ?\˘) - ("&'." ?\˙) - ("&'0" ?\˚) - ("&';" ?\˛) - ("&1?" ?\˜) - ("&'\"" ?\˝) - ("&'G" ?\ʹ) - ("&,G" ?\͵) - ("&j3" ?\ͺ) - ("&?%" ?\;) - ("&'*" ?\΄) - ("&'%" ?\΅) - ("&A%" ?\Ά) - ("&.*" ?\·) - ("&E%" ?\Έ) - ("&Y%" ?\Ή) - ("&I%" ?\Ί) - ("&O%" ?\Ό) - ("&U%" ?\Ύ) - ("&W%" ?\Ώ) - ("&i3" ?\ΐ) - ("&A*" ?\Α) - ("&B*" ?\Β) - ("&G*" ?\Γ) - ("&D*" ?\Δ) - ("&E*" ?\Ε) - ("&Z*" ?\Ζ) - ("&Y*" ?\Η) - ("&H*" ?\Θ) - ("&I*" ?\Ι) - ("&K*" ?\Κ) - ("&L*" ?\Λ) - ("&M*" ?\Μ) - ("&N*" ?\Ν) - ("&C*" ?\Ξ) - ("&O*" ?\Ο) - ("&P*" ?\Π) - ("&R*" ?\Ρ) - ("&S*" ?\Σ) - ("&T*" ?\Τ) - ("&U*" ?\Υ) - ("&F*" ?\Φ) - ("&X*" ?\Χ) - ("&Q*" ?\Ψ) - ("&W*" ?\Ω) - ("&J*" ?\Ϊ) - ("&V*" ?\Ϋ) - ("&a%" ?\ά) - ("&e%" ?\έ) - ("&y%" ?\ή) - ("&i%" ?\ί) - ("&u3" ?\ΰ) - ("&a*" ?\α) - ("&b*" ?\β) - ("&g*" ?\γ) - ("&d*" ?\δ) - ("&e*" ?\ε) - ("&z*" ?\ζ) - ("&y*" ?\η) - ("&h*" ?\θ) - ("&i*" ?\ι) - ("&k*" ?\κ) - ("&l*" ?\λ) - ("&m*" ?\μ) - ("&n*" ?\ν) - ("&c*" ?\ξ) - ("&o*" ?\ο) - ("&p*" ?\π) - ("&r*" ?\ρ) - ("&*s" ?\ς) - ("&s*" ?\σ) - ("&t*" ?\τ) - ("&u*" ?\υ) - ("&f*" ?\φ) - ("&x*" ?\χ) - ("&q*" ?\ψ) - ("&w*" ?\ω) - ("&j*" ?\ϊ) - ("&v*" ?\ϋ) - ("&o%" ?\ό) - ("&u%" ?\ύ) - ("&w%" ?\ώ) - ("&b3" ?\ϐ) - ("&T3" ?\Ϛ) - ("&M3" ?\Ϝ) - ("&K3" ?\Ϟ) - ("&P3" ?\Ϡ) - ("&IO" ?\Ё) - ("&D%" ?\Ђ) - ("&G%" ?\Ѓ) - ("&IE" ?\Є) - ("&DS" ?\Ѕ) - ("&II" ?\І) - ("&YI" ?\Ї) - ("&J%" ?\Ј) - ("&LJ" ?\Љ) - ("&NJ" ?\Њ) - ("&Ts" ?\Ћ) - ("&KJ" ?\Ќ) - ("&V%" ?\Ў) - ("&DZ" ?\Џ) - ("&A=" ?\А) - ("&B=" ?\Б) - ("&V=" ?\В) - ("&G=" ?\Г) - ("&D=" ?\Д) - ("&E=" ?\Е) - ("&Z%" ?\Ж) - ("&Z=" ?\З) - ("&I=" ?\И) - ("&J=" ?\Й) - ("&K=" ?\К) - ("&L=" ?\Л) - ("&M=" ?\М) - ("&N=" ?\Н) - ("&O=" ?\О) - ("&P=" ?\П) - ("&R=" ?\Р) - ("&S=" ?\С) - ("&T=" ?\Т) - ("&U=" ?\У) - ("&F=" ?\Ф) - ("&H=" ?\Х) - ("&C=" ?\Ц) - ("&C%" ?\Ч) - ("&S%" ?\Ш) - ("&Sc" ?\Щ) - ("&=\"" ?\Ъ) - ("&Y=" ?\Ы) - ("&%\"" ?\Ь) - ("&JE" ?\Э) - ("&JU" ?\Ю) - ("&JA" ?\Я) - ("&a=" ?\а) - ("&b=" ?\б) - ("&v=" ?\в) - ("&g=" ?\г) - ("&d=" ?\д) - ("&e=" ?\е) - ("&z%" ?\ж) - ("&z=" ?\з) - ("&i=" ?\и) - ("&j=" ?\й) - ("&k=" ?\к) - ("&l=" ?\л) - ("&m=" ?\м) - ("&n=" ?\н) - ("&o=" ?\о) - ("&p=" ?\п) - ("&r=" ?\р) - ("&s=" ?\с) - ("&t=" ?\т) - ("&u=" ?\у) - ("&f=" ?\ф) - ("&h=" ?\х) - ("&c=" ?\ц) - ("&c%" ?\ч) - ("&s%" ?\ш) - ("&sc" ?\щ) - ("&='" ?\ъ) - ("&y=" ?\ы) - ("&%'" ?\ь) - ("&je" ?\э) - ("&ju" ?\ю) - ("&ja" ?\я) - ("&io" ?\ё) - ("&d%" ?\ђ) - ("&g%" ?\ѓ) - ("&ie" ?\є) - ("&ds" ?\ѕ) - ("&ii" ?\і) - ("&yi" ?\ї) - ("&j%" ?\ј) - ("&lj" ?\љ) - ("&nj" ?\њ) - ("&ts" ?\ћ) - ("&kj" ?\ќ) - ("&v%" ?\ў) - ("&dz" ?\џ) - ("&Y3" ?\Ѣ) - ("&y3" ?\ѣ) - ("&O3" ?\Ѫ) - ("&o3" ?\ѫ) - ("&F3" ?\Ѳ) - ("&f3" ?\ѳ) - ("&V3" ?\Ѵ) - ("&v3" ?\ѵ) - ("&C3" ?\Ҁ) - ("&c3" ?\ҁ) - ("&G3" ?\Ґ) - ("&g3" ?\ґ) - ("&A+" ?\א) - ("&B+" ?\ב) - ("&G+" ?\ג) - ("&D+" ?\ד) - ("&H+" ?\ה) - ("&W+" ?\ו) - ("&Z+" ?\ז) - ("&X+" ?\ח) - ("&Tj" ?\ט) - ("&J+" ?\י) - ("&K%" ?\ך) - ("&K+" ?\כ) - ("&L+" ?\ל) - ("&M%" ?\ם) - ("&M+" ?\מ) - ("&N%" ?\ן) - ("&N+" ?\נ) - ("&S+" ?\ס) - ("&E+" ?\ע) - ("&P%" ?\ף) - ("&P+" ?\פ) - ("&Zj" ?\ץ) - ("&ZJ" ?\צ) - ("&Q+" ?\ק) - ("&R+" ?\ר) - ("&Sh" ?\ש) - ("&T+" ?\ת) - ("&,+" ?\،) - ("&;+" ?\؛) - ("&?+" ?\؟) - ("&H'" ?\ء) - ("&aM" ?\آ) - ("&aH" ?\أ) - ("&wH" ?\ؤ) - ("&ah" ?\إ) - ("&yH" ?\ئ) - ("&a+" ?\ا) - ("&b+" ?\ب) - ("&tm" ?\ة) - ("&t+" ?\ت) - ("&tk" ?\ث) - ("&g+" ?\ج) - ("&hk" ?\ح) - ("&x+" ?\خ) - ("&d+" ?\د) - ("&dk" ?\ذ) - ("&r+" ?\ر) - ("&z+" ?\ز) - ("&s+" ?\س) - ("&sn" ?\ش) - ("&c+" ?\ص) - ("&dd" ?\ض) - ("&tj" ?\ط) - ("&zH" ?\ظ) - ("&e+" ?\ع) - ("&i+" ?\غ) - ("&++" ?\ـ) - ("&f+" ?\ف) - ("&q+" ?\ق) - ("&k+" ?\ك) - ("&l+" ?\ل) - ("&m+" ?\م) - ("&n+" ?\ن) - ("&h+" ?\ه) - ("&w+" ?\و) - ("&j+" ?\ى) - ("&y+" ?\ي) - ("&:+" ?\ً) - ("&\"+" ?\ٌ) - ("&=+" ?\ٍ) - ("&/+" ?\َ) - ("&'+" ?\ُ) - ("&1+" ?\ِ) - ("&3+" ?\ّ) - ("&0+" ?\ْ) - ("&0a" ?\٠) - ("&1a" ?\١) - ("&2a" ?\٢) - ("&3a" ?\٣) - ("&4a" ?\٤) - ("&5a" ?\٥) - ("&6a" ?\٦) - ("&7a" ?\٧) - ("&8a" ?\٨) - ("&9a" ?\٩) - ("&aS" ?\ٰ) - ("&p+" ?\پ) - ("&hH" ?\ځ) - ("&tc" ?\چ) - ("&zj" ?\ژ) - ("&v+" ?\ڤ) - ("&gf" ?\گ) - ("&A-0" ?\Ḁ) - ("&a-0" ?\ḁ) - ("&B." ?\Ḃ) - ("&b." ?\ḃ) - ("&B-." ?\Ḅ) - ("&b-." ?\ḅ) - ("&B_" ?\Ḇ) - ("&b_" ?\ḇ) - ("&C,'" ?\Ḉ) - ("&c,'" ?\ḉ) - ("&D." ?\Ḋ) - ("&d." ?\ḋ) - ("&D-." ?\Ḍ) - ("&d-." ?\ḍ) - ("&D_" ?\Ḏ) - ("&d_" ?\ḏ) - ("&D," ?\Ḑ) - ("&d," ?\ḑ) - ("&D->" ?\Ḓ) - ("&d->" ?\ḓ) - ("&E-!" ?\Ḕ) - ("&e-!" ?\ḕ) - ("&E-'" ?\Ḗ) - ("&e-'" ?\ḗ) - ("&E->" ?\Ḙ) - ("&e->" ?\ḙ) - ("&E-?" ?\Ḛ) - ("&e-?" ?\ḛ) - ("&E,(" ?\Ḝ) - ("&e,(" ?\ḝ) - ("&F." ?\Ḟ) - ("&f." ?\ḟ) - ("&G-" ?\Ḡ) - ("&g-" ?\ḡ) - ("&H." ?\Ḣ) - ("&h." ?\ḣ) - ("&H-." ?\Ḥ) - ("&h-." ?\ḥ) - ("&H:" ?\Ḧ) - ("&h:" ?\ḧ) - ("&H," ?\Ḩ) - ("&h," ?\ḩ) - ("&H-(" ?\Ḫ) - ("&h-(" ?\ḫ) - ("&I-?" ?\Ḭ) - ("&i-?" ?\ḭ) - ("&I:'" ?\Ḯ) - ("&i:'" ?\ḯ) - ("&K'" ?\Ḱ) - ("&k'" ?\ḱ) - ("&K-." ?\Ḳ) - ("&k-." ?\ḳ) - ("&K_" ?\Ḵ) - ("&k_" ?\ḵ) - ("&L-." ?\Ḷ) - ("&l-." ?\ḷ) - ("&L_" ?\Ḻ) - ("&l_" ?\ḻ) - ("&L->" ?\Ḽ) - ("&l->" ?\ḽ) - ("&M'" ?\Ḿ) - ("&m'" ?\ḿ) - ("&M." ?\Ṁ) - ("&m." ?\ṁ) - ("&M-." ?\Ṃ) - ("&m-." ?\ṃ) - ("&N." ?\Ṅ) - ("&n." ?\ṅ) - ("&N-." ?\Ṇ) - ("&n-." ?\ṇ) - ("&N_" ?\Ṉ) - ("&n_" ?\ṉ) - ("&N->" ?\Ṋ) - ("&n->" ?\ṋ) - ("&O?'" ?\Ṍ) - ("&o?'" ?\ṍ) - ("&O?:" ?\Ṏ) - ("&o?:" ?\ṏ) - ("&O-!" ?\Ṑ) - ("&o-!" ?\ṑ) - ("&O-'" ?\Ṓ) - ("&o-'" ?\ṓ) - ("&P'" ?\Ṕ) - ("&p'" ?\ṕ) - ("&P." ?\Ṗ) - ("&p." ?\ṗ) - ("&R." ?\Ṙ) - ("&r." ?\ṙ) - ("&R-." ?\Ṛ) - ("&r-." ?\ṛ) - ("&R_" ?\Ṟ) - ("&r_" ?\ṟ) - ("&S." ?\Ṡ) - ("&s." ?\ṡ) - ("&S-." ?\Ṣ) - ("&s-." ?\ṣ) - ("&S'." ?\Ṥ) - ("&s'." ?\ṥ) - ("&S<." ?\Ṧ) - ("&s<." ?\ṧ) - ("&T." ?\Ṫ) - ("&t." ?\ṫ) - ("&T-." ?\Ṭ) - ("&t-." ?\ṭ) - ("&T_" ?\Ṯ) - ("&t_" ?\ṯ) - ("&T->" ?\Ṱ) - ("&t->" ?\ṱ) - ("&U-?" ?\Ṵ) - ("&u-?" ?\ṵ) - ("&U->" ?\Ṷ) - ("&u->" ?\ṷ) - ("&U?'" ?\Ṹ) - ("&u?'" ?\ṹ) - ("&U-:" ?\Ṻ) - ("&u-:" ?\ṻ) - ("&V?" ?\Ṽ) - ("&v?" ?\ṽ) - ("&V-." ?\Ṿ) - ("&v-." ?\ṿ) - ("&W!" ?\Ẁ) - ("&w!" ?\ẁ) - ("&W'" ?\Ẃ) - ("&w'" ?\ẃ) - ("&W:" ?\Ẅ) - ("&w:" ?\ẅ) - ("&W." ?\Ẇ) - ("&w." ?\ẇ) - ("&W-." ?\Ẉ) - ("&w-." ?\ẉ) - ("&X." ?\Ẋ) - ("&x." ?\ẋ) - ("&X:" ?\Ẍ) - ("&x:" ?\ẍ) - ("&Y." ?\Ẏ) - ("&y." ?\ẏ) - ("&Z>" ?\Ẑ) - ("&z>" ?\ẑ) - ("&Z-." ?\Ẓ) - ("&z-." ?\ẓ) - ("&Z_" ?\Ẕ) - ("&z_" ?\ẕ) - ("&A-." ?\Ạ) - ("&a-." ?\ạ) - ("&A2" ?\Ả) - ("&a2" ?\ả) - ("&A>'" ?\Ấ) - ("&a>'" ?\ấ) - ("&A>!" ?\Ầ) - ("&a>!" ?\ầ) - ("&A>2" ?\Ẩ) - ("&a>2" ?\ẩ) - ("&A>?" ?\Ẫ) - ("&a>?" ?\ẫ) - ("&A('" ?\Ắ) - ("&a('" ?\ắ) - ("&A(!" ?\Ằ) - ("&a(!" ?\ằ) - ("&A(2" ?\Ẳ) - ("&a(2" ?\ẳ) - ("&A(?" ?\Ẵ) - ("&a(?" ?\ẵ) - ("&E-." ?\Ẹ) - ("&e-." ?\ẹ) - ("&E2" ?\Ẻ) - ("&e2" ?\ẻ) - ("&E?" ?\Ẽ) - ("&e?" ?\ẽ) - ("&E>'" ?\Ế) - ("&e>'" ?\ế) - ("&E>!" ?\Ề) - ("&e>!" ?\ề) - ("&E>2" ?\Ể) - ("&e>2" ?\ể) - ("&E>?" ?\Ễ) - ("&e>?" ?\ễ) - ("&I2" ?\Ỉ) - ("&i2" ?\ỉ) - ("&I-." ?\Ị) - ("&i-." ?\ị) - ("&O-." ?\Ọ) - ("&o-." ?\ọ) - ("&O2" ?\Ỏ) - ("&o2" ?\ỏ) - ("&O>'" ?\Ố) - ("&o>'" ?\ố) - ("&O>!" ?\Ồ) - ("&o>!" ?\ồ) - ("&O>2" ?\Ổ) - ("&o>2" ?\ổ) - ("&O>?" ?\Ỗ) - ("&o>?" ?\ỗ) - ("&O9'" ?\Ớ) - ("&o9'" ?\ớ) - ("&O9!" ?\Ờ) - ("&o9!" ?\ờ) - ("&O92" ?\Ở) - ("&o92" ?\ở) - ("&O9?" ?\Ỡ) - ("&o9?" ?\ỡ) - ("&U-." ?\Ụ) - ("&u-." ?\ụ) - ("&U2" ?\Ủ) - ("&u2" ?\ủ) - ("&U9'" ?\Ứ) - ("&u9'" ?\ứ) - ("&U9!" ?\Ừ) - ("&u9!" ?\ừ) - ("&U92" ?\Ử) - ("&u92" ?\ử) - ("&U9?" ?\Ữ) - ("&u9?" ?\ữ) - ("&Y!" ?\Ỳ) - ("&y!" ?\ỳ) - ("&Y-." ?\Ỵ) - ("&y-." ?\ỵ) - ("&Y2" ?\Ỷ) - ("&y2" ?\ỷ) - ("&Y?" ?\Ỹ) - ("&y?" ?\ỹ) - ("&a*," ?\ἀ) - ("&a*;" ?\ἁ) - ("&A*," ?\Ἀ) - ("&A*;" ?\Ἁ) - ("&e*," ?\ἐ) - ("&e*;" ?\ἑ) - ("&E*," ?\Ἐ) - ("&E*;" ?\Ἑ) - ("&y*," ?\ἠ) - ("&y*;" ?\ἡ) - ("&Y*," ?\Ἠ) - ("&Y*;" ?\Ἡ) - ("&i*," ?\ἰ) - ("&i*;" ?\ἱ) - ("&I*," ?\Ἰ) - ("&I*;" ?\Ἱ) - ("&o*," ?\ὀ) - ("&o*;" ?\ὁ) - ("&O*," ?\Ὀ) - ("&O*;" ?\Ὁ) - ("&u*," ?\ὐ) - ("&u*;" ?\ὑ) - ("&U*;" ?\Ὑ) - ("&w*," ?\ὠ) - ("&w*;" ?\ὡ) - ("&W*," ?\Ὠ) - ("&W*;" ?\Ὡ) - ("&a*!" ?\ὰ) - ("&a*'" ?\ά) - ("&e*!" ?\ὲ) - ("&e*'" ?\έ) - ("&y*!" ?\ὴ) - ("&y*'" ?\ή) - ("&i*!" ?\ὶ) - ("&i*'" ?\ί) - ("&o*!" ?\ὸ) - ("&o*'" ?\ό) - ("&u*!" ?\ὺ) - ("&u*'" ?\ύ) - ("&w*!" ?\ὼ) - ("&w*'" ?\ώ) - ("&a*(" ?\ᾰ) - ("&a*-" ?\ᾱ) - ("&a*j" ?\ᾳ) - ("&a*?" ?\ᾶ) - ("&A*(" ?\Ᾰ) - ("&A*-" ?\Ᾱ) - ("&A*!" ?\Ὰ) - ("&A*'" ?\Ά) - ("&A*J" ?\ᾼ) - ("&)*" ?\᾽) - ("&J3" ?\ι) - ("&,," ?\᾿) - ("&?*" ?\῀) - ("&?:" ?\῁) - ("&y*j" ?\ῃ) - ("&y*?" ?\ῆ) - ("&E*'" ?\Έ) - ("&Y*!" ?\Ὴ) - ("&Y*'" ?\Ή) - ("&Y*J" ?\ῌ) - ("&,!" ?\῍) - ("&,'" ?\῎) - ("&?," ?\῏) - ("&i*(" ?\ῐ) - ("&i*-" ?\ῑ) - ("&i*?" ?\ῖ) - ("&I*(" ?\Ῐ) - ("&I*-" ?\Ῑ) - ("&I*!" ?\Ὶ) - ("&I*'" ?\Ί) - ("&;!" ?\῝) - ("&;'" ?\῞) - ("&?;" ?\῟) - ("&u*(" ?\ῠ) - ("&u*-" ?\ῡ) - ("&r*," ?\ῤ) - ("&r*;" ?\ῥ) - ("&u*?" ?\ῦ) - ("&U*(" ?\Ῠ) - ("&U*-" ?\Ῡ) - ("&U*!" ?\Ὺ) - ("&U*'" ?\Ύ) - ("&R*;" ?\Ῥ) - ("&!:" ?\῭) - ("&:'" ?\΅) - ("&!*" ?\`) - ("&w*j" ?\ῳ) - ("&w*?" ?\ῶ) - ("&O*!" ?\Ὸ) - ("&O*'" ?\Ό) - ("&W*!" ?\Ὼ) - ("&W*'" ?\Ώ) - ("&W*J" ?\ῼ) - ("&/*" ?\´) - ("&;;" ?\῾) - ("&1N" ?\ ) - ("&1M" ?\ ) - ("&3M" ?\ ) - ("&4M" ?\ ) - ("&6M" ?\ ) - ("&1T" ?\ ) - ("&1H" ?\ ) - ("&LR" ?\) - ("&RL" ?\) - ("&-1" ?\‐) - ("&-N" ?\–) - ("&-M" ?\—) - ("&-3" ?\―) - ("&!2" ?\‖) - ("&=2" ?\‗) - ("&'6" ?\‘) - ("&'9" ?\’) - ("&.9" ?\‚) - ("&9'" ?\‛) - ("&\"6" ?\“) - ("&\"9" ?\”) - ("&:9" ?\„) - ("&9\"" ?\‟) - ("&/-" ?\†) - ("&/=" ?\‡) - ("&sb" ?\•) - ("&3b" ?\‣) - ("&.." ?\‥) - ("&.3" ?\…) - ("&.-" ?\‧) - ("&%0" ?\‰) - ("&1'" ?\′) - ("&2'" ?\″) - ("&3'" ?\‴) - ("&1\"" ?\‵) - ("&2\"" ?\‶) - ("&3\"" ?\‷) - ("&Ca" ?\‸) - ("&<1" ?\‹) - ("&>1" ?\›) - ("&:X" ?\※) - ("&!*2" ?\‼) - ("&'-" ?\‾) - ("&-b" ?\⁃) - ("&/f" ?\⁄) - ("&0S" ?\⁰) - ("&4S" ?\⁴) - ("&5S" ?\⁵) - ("&6S" ?\⁶) - ("&7S" ?\⁷) - ("&8S" ?\⁸) - ("&9S" ?\⁹) - ("&+S" ?\⁺) - ("&-S" ?\⁻) - ("&=S" ?\⁼) - ("&(S" ?\⁽) - ("&)S" ?\⁾) - ("&nS" ?\ⁿ) - ("&0s" ?\₀) - ("&1s" ?\₁) - ("&2s" ?\₂) - ("&3s" ?\₃) - ("&4s" ?\₄) - ("&5s" ?\₅) - ("&6s" ?\₆) - ("&7s" ?\₇) - ("&8s" ?\₈) - ("&9s" ?\₉) - ("&+s" ?\₊) - ("&-s" ?\₋) - ("&=s" ?\₌) - ("&(s" ?\₍) - ("&)s" ?\₎) - ("&Ff" ?\₣) - ("&Li" ?\₤) - ("&Pt" ?\₧) - ("&W=" ?\₩) - ("&NSh" ?\₪) - ("&Eu" ?\€) - ("&\"7" ?\⃑) - ("&oC" ?\℃) - ("&co" ?\℅) - ("&oF" ?\℉) - ("&N0" ?\№) - ("&PO" ?\℗) - ("&Rx" ?\℞) - ("&SM" ?\℠) - ("&TM" ?\™) - ("&Om" ?\Ω) - ("&AO" ?\Å) - ("&Est" ?\℮) - ("&13" ?\⅓) - ("&23" ?\⅔) - ("&15" ?\⅕) - ("&25" ?\⅖) - ("&35" ?\⅗) - ("&45" ?\⅘) - ("&16" ?\⅙) - ("&56" ?\⅚) - ("&18" ?\⅛) - ("&38" ?\⅜) - ("&58" ?\⅝) - ("&78" ?\⅞) - ("&1R" ?\Ⅰ) - ("&2R" ?\Ⅱ) - ("&3R" ?\Ⅲ) - ("&4R" ?\Ⅳ) - ("&5R" ?\Ⅴ) - ("&6R" ?\Ⅵ) - ("&7R" ?\Ⅶ) - ("&8R" ?\Ⅷ) - ("&9R" ?\Ⅸ) - ("&aR" ?\Ⅹ) - ("&bR" ?\Ⅺ) - ("&cR" ?\Ⅻ) - ("&50R" ?\Ⅼ) - ("&1r" ?\ⅰ) - ("&2r" ?\ⅱ) - ("&3r" ?\ⅲ) - ("&4r" ?\ⅳ) - ("&5r" ?\ⅴ) - ("&6r" ?\ⅵ) - ("&7r" ?\ⅶ) - ("&8r" ?\ⅷ) - ("&9r" ?\ⅸ) - ("&ar" ?\ⅹ) - ("&br" ?\ⅺ) - ("&cr" ?\ⅻ) - ("&50r" ?\ⅼ) - ("&<-" ?\←) - ("&-!" ?\↑) - ("&->" ?\→) - ("&-v" ?\↓) - ("&<>" ?\↔) - ("&UD" ?\↕) - ("&<!!" ?\↖) - ("&//>" ?\↗) - ("&!!>" ?\↘) - ("&<//" ?\↙) - ("&UD-" ?\↨) - ("&>V" ?\⇀) - ("&<=" ?\⇐) - ("&=>" ?\⇒) - ("&==" ?\⇔) - ("&FA" ?\∀) - ("&dP" ?\∂) - ("&TE" ?\∃) - ("&/0" ?\∅) - ("&DE" ?\∆) - ("&NB" ?\∇) - ("&(-" ?\∈) - ("&-)" ?\∋) - ("&FP" ?\∎) - ("&*P" ?\∏) - ("&+Z" ?\∑) - ("&-2" ?\−) - ("&-+" ?\∓) - ("&.+" ?\∔) - ("&*-" ?\∗) - ("&Ob" ?\∘) - ("&Sb" ?\∙) - ("&RT" ?\√) - ("&0(" ?\∝) - ("&00" ?\∞) - ("&-L" ?\∟) - ("&-V" ?\∠) - ("&PP" ?\∥) - ("&AN" ?\∧) - ("&OR" ?\∨) - ("&(U" ?\∩) - ("&)U" ?\∪) - ("&In" ?\∫) - ("&DI" ?\∬) - ("&Io" ?\∮) - ("&.:" ?\∴) - ("&:." ?\∵) - ("&:R" ?\∶) - ("&::" ?\∷) - ("&?1" ?\∼) - ("&CG" ?\∾) - ("&?-" ?\≃) - ("&?=" ?\≅) - ("&?2" ?\≈) - ("&=?" ?\≌) - ("&HI" ?\≓) - ("&!=" ?\≠) - ("&=3" ?\≡) - ("&=<" ?\≤) - ("&>=" ?\≥) - ("&<*" ?\≪) - ("&*>" ?\≫) - ("&!<" ?\≮) - ("&!>" ?\≯) - ("&(C" ?\⊂) - ("&)C" ?\⊃) - ("&(_" ?\⊆) - ("&)_" ?\⊇) - ("&0." ?\⊙) - ("&02" ?\⊚) - ("&-T" ?\⊥) - ("&.P" ?\⋅) - ("&:3" ?\⋮) - ("&Eh" ?\⌂) - ("&<7" ?\⌈) - ("&>7" ?\⌉) - ("&7<" ?\⌊) - ("&7>" ?\⌋) - ("&NI" ?\⌐) - ("&(A" ?\⌒) - ("&TR" ?\⌕) - ("&88" ?\⌘) - ("&Iu" ?\⌠) - ("&Il" ?\⌡) - ("&</" ?\〈) - ("&/>" ?\〉) - ("&Vs" ?\␣) - ("&1h" ?\⑀) - ("&3h" ?\⑁) - ("&2h" ?\⑂) - ("&4h" ?\⑃) - ("&1j" ?\⑆) - ("&2j" ?\⑇) - ("&3j" ?\⑈) - ("&4j" ?\⑉) - ("&1-o" ?\①) - ("&2-o" ?\②) - ("&3-o" ?\③) - ("&4-o" ?\④) - ("&5-o" ?\⑤) - ("&6-o" ?\⑥) - ("&7-o" ?\⑦) - ("&8-o" ?\⑧) - ("&9-o" ?\⑨) - ("&(1)" ?\⑴) - ("&(2)" ?\⑵) - ("&(3)" ?\⑶) - ("&(4)" ?\⑷) - ("&(5)" ?\⑸) - ("&(6)" ?\⑹) - ("&(7)" ?\⑺) - ("&(8)" ?\⑻) - ("&(9)" ?\⑼) - ("&1." ?\⒈) - ("&2." ?\⒉) - ("&3." ?\⒊) - ("&4." ?\⒋) - ("&5." ?\⒌) - ("&6." ?\⒍) - ("&7." ?\⒎) - ("&8." ?\⒏) - ("&9." ?\⒐) - ("&10." ?\⒑) - ("&11." ?\⒒) - ("&12." ?\⒓) - ("&13." ?\⒔) - ("&14." ?\⒕) - ("&15." ?\⒖) - ("&16." ?\⒗) - ("&17." ?\⒘) - ("&18." ?\⒙) - ("&19." ?\⒚) - ("&20." ?\⒛) - ("&(a)" ?\⒜) - ("&(b)" ?\⒝) - ("&(c)" ?\⒞) - ("&(d)" ?\⒟) - ("&(e)" ?\⒠) - ("&(f)" ?\⒡) - ("&(g)" ?\⒢) - ("&(h)" ?\⒣) - ("&(i)" ?\⒤) - ("&(j)" ?\⒥) - ("&(k)" ?\⒦) - ("&(l)" ?\⒧) - ("&(m)" ?\⒨) - ("&(n)" ?\⒩) - ("&(o)" ?\⒪) - ("&(p)" ?\⒫) - ("&(q)" ?\⒬) - ("&(r)" ?\⒭) - ("&(s)" ?\⒮) - ("&(t)" ?\⒯) - ("&(u)" ?\⒰) - ("&(v)" ?\⒱) - ("&(w)" ?\⒲) - ("&(x)" ?\⒳) - ("&(y)" ?\⒴) - ("&(z)" ?\⒵) - ("&A-o" ?\Ⓐ) - ("&B-o" ?\Ⓑ) - ("&C-o" ?\Ⓒ) - ("&D-o" ?\Ⓓ) - ("&E-o" ?\Ⓔ) - ("&F-o" ?\Ⓕ) - ("&G-o" ?\Ⓖ) - ("&H-o" ?\Ⓗ) - ("&I-o" ?\Ⓘ) - ("&J-o" ?\Ⓙ) - ("&K-o" ?\Ⓚ) - ("&L-o" ?\Ⓛ) - ("&M-o" ?\Ⓜ) - ("&N-o" ?\Ⓝ) - ("&O-o" ?\Ⓞ) - ("&P-o" ?\Ⓟ) - ("&Q-o" ?\Ⓠ) - ("&R-o" ?\Ⓡ) - ("&S-o" ?\Ⓢ) - ("&T-o" ?\Ⓣ) - ("&U-o" ?\Ⓤ) - ("&V-o" ?\Ⓥ) - ("&W-o" ?\Ⓦ) - ("&X-o" ?\Ⓧ) - ("&Y-o" ?\Ⓨ) - ("&Z-o" ?\Ⓩ) - ("&a-o" ?\ⓐ) - ("&b-o" ?\ⓑ) - ("&c-o" ?\ⓒ) - ("&d-o" ?\ⓓ) - ("&e-o" ?\ⓔ) - ("&f-o" ?\ⓕ) - ("&g-o" ?\ⓖ) - ("&h-o" ?\ⓗ) - ("&i-o" ?\ⓘ) - ("&j-o" ?\ⓙ) - ("&k-o" ?\ⓚ) - ("&l-o" ?\ⓛ) - ("&m-o" ?\ⓜ) - ("&n-o" ?\ⓝ) - ("&o-o" ?\ⓞ) - ("&p-o" ?\ⓟ) - ("&q-o" ?\ⓠ) - ("&r-o" ?\ⓡ) - ("&s-o" ?\ⓢ) - ("&t-o" ?\ⓣ) - ("&u-o" ?\ⓤ) - ("&v-o" ?\ⓥ) - ("&w-o" ?\ⓦ) - ("&x-o" ?\ⓧ) - ("&y-o" ?\ⓨ) - ("&z-o" ?\ⓩ) - ("&0-o" ?\⓪) - ("&hh" ?\─) - ("&HH-" ?\━) - ("&vv" ?\│) - ("&VV-" ?\┃) - ("&3-" ?\┄) - ("&3_" ?\┅) - ("&3!" ?\┆) - ("&3/" ?\┇) - ("&4-" ?\┈) - ("&4_" ?\┉) - ("&4!" ?\┊) - ("&4/" ?\┋) - ("&dr" ?\┌) - ("&dR-" ?\┍) - ("&Dr-" ?\┎) - ("&DR-" ?\┏) - ("&dl" ?\┐) - ("&dL-" ?\┑) - ("&Dl-" ?\┒) - ("&LD-" ?\┓) - ("&ur" ?\└) - ("&uR-" ?\┕) - ("&Ur-" ?\┖) - ("&UR-" ?\┗) - ("&ul" ?\┘) - ("&uL-" ?\┙) - ("&Ul-" ?\┚) - ("&UL-" ?\┛) - ("&vr" ?\├) - ("&vR-" ?\┝) - ("&Udr" ?\┞) - ("&uDr" ?\┟) - ("&Vr-" ?\┠) - ("&UdR" ?\┡) - ("&uDR" ?\┢) - ("&VR-" ?\┣) - ("&vl" ?\┤) - ("&vL-" ?\┥) - ("&Udl" ?\┦) - ("&uDl" ?\┧) - ("&Vl-" ?\┨) - ("&UdL" ?\┩) - ("&uDL" ?\┪) - ("&VL-" ?\┫) - ("&dh" ?\┬) - ("&dLr" ?\┭) - ("&dlR" ?\┮) - ("&dH-" ?\┯) - ("&Dh-" ?\┰) - ("&DLr" ?\┱) - ("&DlR" ?\┲) - ("&DH-" ?\┳) - ("&uh" ?\┴) - ("&uLr" ?\┵) - ("&ulR" ?\┶) - ("&uH-" ?\┷) - ("&Uh-" ?\┸) - ("&ULr" ?\┹) - ("&UlR" ?\┺) - ("&UH-" ?\┻) - ("&vh" ?\┼) - ("&vLr" ?\┽) - ("&vlR" ?\┾) - ("&vH-" ?\┿) - ("&Udh" ?\╀) - ("&uDh" ?\╁) - ("&Vh-" ?\╂) - ("&UdH" ?\╇) - ("&uDH" ?\╈) - ("&VLr" ?\╉) - ("&VlR" ?\╊) - ("&VH-" ?\╋) - ("&HH" ?\═) - ("&VV" ?\║) - ("&dR" ?\╒) - ("&Dr" ?\╓) - ("&DR" ?\╔) - ("&dL" ?\╕) - ("&Dl" ?\╖) - ("&LD" ?\╗) - ("&uR" ?\╘) - ("&Ur" ?\╙) - ("&UR" ?\╚) - ("&uL" ?\╛) - ("&Ul" ?\╜) - ("&UL" ?\╝) - ("&vR" ?\╞) - ("&Vr" ?\╟) - ("&VR" ?\╠) - ("&vL" ?\╡) - ("&Vl" ?\╢) - ("&VL" ?\╣) - ("&dH" ?\╤) - ("&Dh" ?\╥) - ("&DH" ?\╦) - ("&uH" ?\╧) - ("&Uh" ?\╨) - ("&UH" ?\╩) - ("&vH" ?\╪) - ("&Vh" ?\╫) - ("&VH" ?\╬) - ("&FD" ?\╱) - ("&BD" ?\╲) - ("&TB" ?\▀) - ("&LB" ?\▄) - ("&FB" ?\█) - ("&lB" ?\▌) - ("&RB" ?\▐) - ("&.S" ?\░) - ("&:S" ?\▒) - ("&?S" ?\▓) - ("&fS" ?\■) - ("&OS" ?\□) - ("&RO" ?\▢) - ("&Rr" ?\▣) - ("&RF" ?\▤) - ("&RY" ?\▥) - ("&RH" ?\▦) - ("&RZ" ?\▧) - ("&RK" ?\▨) - ("&RX" ?\▩) - ("&sB" ?\▪) - ("&SR" ?\▬) - ("&Or" ?\▭) - ("&UT" ?\▲) - ("&uT" ?\△) - ("&Tr" ?\▷) - ("&PR" ?\►) - ("&Dt" ?\▼) - ("&dT" ?\▽) - ("&Tl" ?\◁) - ("&PL" ?\◄) - ("&Db" ?\◆) - ("&Dw" ?\◇) - ("&LZ" ?\◊) - ("&0m" ?\○) - ("&0o" ?\◎) - ("&0M" ?\●) - ("&0L" ?\◐) - ("&0R" ?\◑) - ("&Sn" ?\◘) - ("&Ic" ?\◙) - ("&Fd" ?\◢) - ("&Bd" ?\◣) - ("&Ci" ?\◯) - ("&*2" ?\★) - ("&*1" ?\☆) - ("&TEL" ?\☎) - ("&tel" ?\☏) - ("&<H" ?\☜) - ("&>H" ?\☞) - ("&0u" ?\☺) - ("&0U" ?\☻) - ("&SU" ?\☼) - ("&Fm" ?\♀) - ("&Ml" ?\♂) - ("&cS" ?\♠) - ("&cH" ?\♡) - ("&cD" ?\♢) - ("&cC" ?\♣) - ("&cS-" ?\♤) - ("&cH-" ?\♥) - ("&cD-" ?\♦) - ("&cC-" ?\♧) - ("&Md" ?\♩) - ("&M8" ?\♪) - ("&M2" ?\♫) - ("&M16" ?\♬) - ("&Mb" ?\♭) - ("&Mx" ?\♮) - ("&MX" ?\♯) - ("&OK" ?\✓) - ("&XX" ?\✗) - ("&-X" ?\✠) - ("&IS" ?\ ) - ("&,_" ?\、) - ("&._" ?\。) - ("&+\"" ?\〃) - ("&JIS" ?\〄) - ("&*_" ?\々) - ("&;_" ?\〆) - ("&0_" ?\〇) - ("&<+" ?\《) - ("&>+" ?\》) - ("&<'" ?\「) - ("&>'" ?\」) - ("&<\"" ?\『) - ("&>\"" ?\』) - ("&(\"" ?\【) - ("&)\"" ?\】) - ("&=T" ?\〒) - ("&=_" ?\〓) - ("&('" ?\〔) - ("&)'" ?\〕) - ("&(I" ?\〖) - ("&)I" ?\〗) - ("&-?" ?\〜) - ("&A5" ?\ぁ) - ("&a5" ?\あ) - ("&I5" ?\ぃ) - ("&i5" ?\い) - ("&U5" ?\ぅ) - ("&u5" ?\う) - ("&E5" ?\ぇ) - ("&e5" ?\え) - ("&O5" ?\ぉ) - ("&o5" ?\お) - ("&ka" ?\か) - ("&ga" ?\が) - ("&ki" ?\き) - ("&gi" ?\ぎ) - ("&ku" ?\く) - ("&gu" ?\ぐ) - ("&ke" ?\け) - ("&ge" ?\げ) - ("&ko" ?\こ) - ("&go" ?\ご) - ("&sa" ?\さ) - ("&za" ?\ざ) - ("&si" ?\し) - ("&zi" ?\じ) - ("&su" ?\す) - ("&zu" ?\ず) - ("&se" ?\せ) - ("&ze" ?\ぜ) - ("&so" ?\そ) - ("&zo" ?\ぞ) - ("&ta" ?\た) - ("&da" ?\だ) - ("&ti" ?\ち) - ("&di" ?\ぢ) - ("&tU" ?\っ) - ("&tu" ?\つ) - ("&du" ?\づ) - ("&te" ?\て) - ("&de" ?\で) - ("&to" ?\と) - ("&do" ?\ど) - ("&na" ?\な) - ("&ni" ?\に) - ("&nu" ?\ぬ) - ("&ne" ?\ね) - ("&no" ?\の) - ("&ha" ?\は) - ("&ba" ?\ば) - ("&pa" ?\ぱ) - ("&hi" ?\ひ) - ("&bi" ?\び) - ("&pi" ?\ぴ) - ("&hu" ?\ふ) - ("&bu" ?\ぶ) - ("&pu" ?\ぷ) - ("&he" ?\へ) - ("&be" ?\べ) - ("&pe" ?\ぺ) - ("&ho" ?\ほ) - ("&bo" ?\ぼ) - ("&po" ?\ぽ) - ("&ma" ?\ま) - ("&mi" ?\み) - ("&mu" ?\む) - ("&me" ?\め) - ("&mo" ?\も) - ("&yA" ?\ゃ) - ("&ya" ?\や) - ("&yU" ?\ゅ) - ("&yu" ?\ゆ) - ("&yO" ?\ょ) - ("&yo" ?\よ) - ("&ra" ?\ら) - ("&ri" ?\り) - ("&ru" ?\る) - ("&re" ?\れ) - ("&ro" ?\ろ) - ("&wA" ?\ゎ) - ("&wa" ?\わ) - ("&wi" ?\ゐ) - ("&we" ?\ゑ) - ("&wo" ?\を) - ("&n5" ?\ん) - ("&vu" ?\ゔ) - ("&\"5" ?\゛) - ("&05" ?\゜) - ("&*5" ?\ゝ) - ("&+5" ?\ゞ) - ("&a6" ?\ァ) - ("&A6" ?\ア) - ("&i6" ?\ィ) - ("&I6" ?\イ) - ("&u6" ?\ゥ) - ("&U6" ?\ウ) - ("&e6" ?\ェ) - ("&E6" ?\エ) - ("&o6" ?\ォ) - ("&O6" ?\オ) - ("&Ka" ?\カ) - ("&Ga" ?\ガ) - ("&Ki" ?\キ) - ("&Gi" ?\ギ) - ("&Ku" ?\ク) - ("&Gu" ?\グ) - ("&Ke" ?\ケ) - ("&Ge" ?\ゲ) - ("&Ko" ?\コ) - ("&Go" ?\ゴ) - ("&Sa" ?\サ) - ("&Za" ?\ザ) - ("&Si" ?\シ) - ("&Zi" ?\ジ) - ("&Su" ?\ス) - ("&Zu" ?\ズ) - ("&Se" ?\セ) - ("&Ze" ?\ゼ) - ("&So" ?\ソ) - ("&Zo" ?\ゾ) - ("&Ta" ?\タ) - ("&Da" ?\ダ) - ("&Ti" ?\チ) - ("&Di" ?\ヂ) - ("&TU" ?\ッ) - ("&Tu" ?\ツ) - ("&Du" ?\ヅ) - ("&Te" ?\テ) - ("&De" ?\デ) - ("&To" ?\ト) - ("&Do" ?\ド) - ("&Na" ?\ナ) - ("&Ni" ?\ニ) - ("&Nu" ?\ヌ) - ("&Ne" ?\ネ) - ("&No" ?\ノ) - ("&Ha" ?\ハ) - ("&Ba" ?\バ) - ("&Pa" ?\パ) - ("&Hi" ?\ヒ) - ("&Bi" ?\ビ) - ("&Pi" ?\ピ) - ("&Hu" ?\フ) - ("&Bu" ?\ブ) - ("&Pu" ?\プ) - ("&He" ?\ヘ) - ("&Be" ?\ベ) - ("&Pe" ?\ペ) - ("&Ho" ?\ホ) - ("&Bo" ?\ボ) - ("&Po" ?\ポ) - ("&Ma" ?\マ) - ("&Mi" ?\ミ) - ("&Mu" ?\ム) - ("&Me" ?\メ) - ("&Mo" ?\モ) - ("&YA" ?\ャ) - ("&Ya" ?\ヤ) - ("&YU" ?\ュ) - ("&Yu" ?\ユ) - ("&YO" ?\ョ) - ("&Yo" ?\ヨ) - ("&Ra" ?\ラ) - ("&Ri" ?\リ) - ("&Ru" ?\ル) - ("&Re" ?\レ) - ("&Ro" ?\ロ) - ("&WA" ?\ヮ) - ("&Wa" ?\ワ) - ("&Wi" ?\ヰ) - ("&We" ?\ヱ) - ("&Wo" ?\ヲ) - ("&N6" ?\ン) - ("&Vu" ?\ヴ) - ("&KA" ?\ヵ) - ("&KE" ?\ヶ) - ("&Va" ?\ヷ) - ("&Vi" ?\ヸ) - ("&Ve" ?\ヹ) - ("&Vo" ?\ヺ) - ("&.6" ?\・) - ("&-6" ?\ー) - ("&*6" ?\ヽ) - ("&+6" ?\ヾ) - ("&b4" ?\ㄅ) - ("&p4" ?\ㄆ) - ("&m4" ?\ㄇ) - ("&f4" ?\ㄈ) - ("&d4" ?\ㄉ) - ("&t4" ?\ㄊ) - ("&n4" ?\ㄋ) - ("&l4" ?\ㄌ) - ("&g4" ?\ㄍ) - ("&k4" ?\ㄎ) - ("&h4" ?\ㄏ) - ("&j4" ?\ㄐ) - ("&q4" ?\ㄑ) - ("&x4" ?\ㄒ) - ("&zh" ?\ㄓ) - ("&ch" ?\ㄔ) - ("&sh" ?\ㄕ) - ("&r4" ?\ㄖ) - ("&z4" ?\ㄗ) - ("&c4" ?\ㄘ) - ("&s4" ?\ㄙ) - ("&a4" ?\ㄚ) - ("&o4" ?\ㄛ) - ("&e4" ?\ㄜ) - ("&eh4" ?\ㄝ) - ("&ai" ?\ㄞ) - ("&ei" ?\ㄟ) - ("&au" ?\ㄠ) - ("&ou" ?\ㄡ) - ("&an" ?\ㄢ) - ("&en" ?\ㄣ) - ("&aN" ?\ㄤ) - ("&eN" ?\ㄥ) - ("&er" ?\ㄦ) - ("&i4" ?\ㄧ) - ("&u4" ?\ㄨ) - ("&iu" ?\ㄩ) - ("&v4" ?\ㄪ) - ("&nG" ?\ㄫ) - ("&gn" ?\ㄬ) - ("&1c" ?\㈠) - ("&2c" ?\㈡) - ("&3c" ?\㈢) - ("&4c" ?\㈣) - ("&5c" ?\㈤) - ("&6c" ?\㈥) - ("&7c" ?\㈦) - ("&8c" ?\㈧) - ("&9c" ?\㈨) - ("&10c" ?\㈩) - ("&KSC" ?\㉿) - ("&am" ?\㏂) - ("&pm" ?\㏘) - ("&\"3" ?\) - ("&\"1" ?\) - ("&\"!" ?\) - ("&\"'" ?\) - ("&\">" ?\) - ("&\"?" ?\) - ("&\"-" ?\) - ("&\"(" ?\) - ("&\"." ?\) - ("&\":" ?\) - ("&\"0" ?\) - ("&\"," ?\) - ("&\"_" ?\) - ("&\"\"" ?\) - ("&\";" ?\) - ("&\"<" ?\) - ("&\"=" ?\) - ("&\"/" ?\) - ("&\"p" ?\) - ("&\"d" ?\) - ("&\"i" ?\) - ("&+_" ?\) - ("&a+:" ?\) - ("&Tel" ?\) - ("&UA" ?\) - ("&UB" ?\) - ("&t3" ?\) - ("&m3" ?\) - ("&k3" ?\) - ("&p3" ?\) - ("&Mc" ?\) - ("&Fl" ?\) - ("&Ss" ?\) - ("&Ch" ?\) - ("&CH" ?\) - ("&__" ?\) - ("&/c" ?\) - ("&ff" ?\ff) - ("&fi" ?\fi) - ("&fl" ?\fl) - ("&ffi" ?\ffi) - ("&ffl" ?\ffl) - ("&St" ?\ſt) - ("&st" ?\st) - ("&3+;" ?\ﹽ) - ("&aM." ?\ﺂ) - ("&aH." ?\ﺄ) - ("&ah." ?\ﺈ) - ("&a+-" ?\ﺍ) - ("&a+." ?\ﺎ) - ("&b+-" ?\ﺏ) - ("&b+." ?\ﺐ) - ("&b+," ?\ﺑ) - ("&b+;" ?\ﺒ) - ("&tm-" ?\ﺓ) - ("&tm." ?\ﺔ) - ("&t+-" ?\ﺕ) - ("&t+." ?\ﺖ) - ("&t+," ?\ﺗ) - ("&t+;" ?\ﺘ) - ("&tk-" ?\ﺙ) - ("&tk." ?\ﺚ) - ("&tk," ?\ﺛ) - ("&tk;" ?\ﺜ) - ("&g+-" ?\ﺝ) - ("&g+." ?\ﺞ) - ("&g+," ?\ﺟ) - ("&g+;" ?\ﺠ) - ("&hk-" ?\ﺡ) - ("&hk." ?\ﺢ) - ("&hk," ?\ﺣ) - ("&hk;" ?\ﺤ) - ("&x+-" ?\ﺥ) - ("&x+." ?\ﺦ) - ("&x+," ?\ﺧ) - ("&x+;" ?\ﺨ) - ("&d+-" ?\ﺩ) - ("&d+." ?\ﺪ) - ("&dk-" ?\ﺫ) - ("&dk." ?\ﺬ) - ("&r+-" ?\ﺭ) - ("&r+." ?\ﺮ) - ("&z+-" ?\ﺯ) - ("&z+." ?\ﺰ) - ("&s+-" ?\ﺱ) - ("&s+." ?\ﺲ) - ("&s+," ?\ﺳ) - ("&s+;" ?\ﺴ) - ("&sn-" ?\ﺵ) - ("&sn." ?\ﺶ) - ("&sn," ?\ﺷ) - ("&sn;" ?\ﺸ) - ("&c+-" ?\ﺹ) - ("&c+." ?\ﺺ) - ("&c+," ?\ﺻ) - ("&c+;" ?\ﺼ) - ("&dd-" ?\ﺽ) - ("&dd." ?\ﺾ) - ("&dd," ?\ﺿ) - ("ⅆ" ?\ﻀ) - ("&tj-" ?\ﻁ) - ("&tj." ?\ﻂ) - ("&tj," ?\ﻃ) - ("&tj;" ?\ﻄ) - ("&zH-" ?\ﻅ) - ("&zH." ?\ﻆ) - ("&zH," ?\ﻇ) - ("&zH;" ?\ﻈ) - ("&e+-" ?\ﻉ) - ("&e+." ?\ﻊ) - ("&e+," ?\ﻋ) - ("&e+;" ?\ﻌ) - ("&i+-" ?\ﻍ) - ("&i+." ?\ﻎ) - ("&i+," ?\ﻏ) - ("&i+;" ?\ﻐ) - ("&f+-" ?\ﻑ) - ("&f+." ?\ﻒ) - ("&f+," ?\ﻓ) - ("&f+;" ?\ﻔ) - ("&q+-" ?\ﻕ) - ("&q+." ?\ﻖ) - ("&q+," ?\ﻗ) - ("&q+;" ?\ﻘ) - ("&k+-" ?\ﻙ) - ("&k+." ?\ﻚ) - ("&k+," ?\ﻛ) - ("&k+;" ?\ﻜ) - ("&l+-" ?\ﻝ) - ("&l+." ?\ﻞ) - ("&l+," ?\ﻟ) - ("&l+;" ?\ﻠ) - ("&m+-" ?\ﻡ) - ("&m+." ?\ﻢ) - ("&m+," ?\ﻣ) - ("&m+;" ?\ﻤ) - ("&n+-" ?\ﻥ) - ("&n+." ?\ﻦ) - ("&n+," ?\ﻧ) - ("&n+;" ?\ﻨ) - ("&h+-" ?\ﻩ) - ("&h+." ?\ﻪ) - ("&h+," ?\ﻫ) - ("&h+;" ?\ﻬ) - ("&w+-" ?\ﻭ) - ("&w+." ?\ﻮ) - ("&j+-" ?\ﻯ) - ("&j+." ?\ﻰ) - ("&y+-" ?\ﻱ) - ("&y+." ?\ﻲ) - ("&y+," ?\ﻳ) - ("&y+;" ?\ﻴ) - ("&lM-" ?\ﻵ) - ("&lM." ?\ﻶ) - ("&lH-" ?\ﻷ) - ("&lH." ?\ﻸ) - ("&lh-" ?\ﻹ) - ("&lh." ?\ﻺ) - ("&la-" ?\ﻻ) - ("&la." ?\ﻼ) + ("&PA" ?\200) + ("&HO" ?\201) + ("&BH" ?\202) + ("&NH" ?\203) + ("&IN" ?\204) + ("&NL" ?\205) + ("&SA" ?\206) + ("&ES" ?\207) + ("&HS" ?\210) + ("&HJ" ?\211) + ("&VS" ?\212) + ("&PD" ?\213) + ("&PU" ?\214) + ("&RI" ?\215) + ("&S2" ?\216) + ("&S3" ?\217) + ("&DC" ?\220) + ("&P1" ?\221) + ("&P2" ?\222) + ("&TS" ?\223) + ("&CC" ?\224) + ("&MW" ?\225) + ("&SG" ?\226) + ("&EG" ?\227) + ("&SS" ?\230) + ("&GC" ?\231) + ("&SC" ?\232) + ("&CI" ?\233) + ("&ST" ?\234) + ("&OC" ?\235) + ("&PM" ?\236) + ("&AC" ?\237) + ("&NS" ? ) + ("&!I" ?¡) + ("&Ct" ?¢) + ("&Pd" ?£) + ("&Cu" ?¤) + ("&Ye" ?¥) + ("&BB" ?¦) + ("&SE" ?§) + ("&':" ?¨) + ("&Co" ?©) + ("&-a" ?ª) + ("&<<" ?«) + ("&NO" ?¬) + ("&--" ?) + ("&Rg" ?®) + ("&'m" ?¯) + ("&DG" ?°) + ("&+-" ?±) + ("&2S" ?²) + ("&3S" ?³) + ("&''" ?´) + ("&My" ?µ) + ("&PI" ?¶) + ("&.M" ?·) + ("&'," ?¸) + ("&1S" ?¹) + ("&-o" ?º) + ("&>>" ?») + ("&14" ?¼) + ("&12" ?½) + ("&34" ?¾) + ("&?I" ?¿) + ("&A!" ?À) + ("&A'" ?Á) + ("&A>" ?Â) + ("&A?" ?Ã) + ("&A:" ?Ä) + ("&AA" ?Å) + ("&AE" ?Æ) + ("&C," ?Ç) + ("&E!" ?È) + ("&E'" ?É) + ("&E>" ?Ê) + ("&E:" ?Ë) + ("&I!" ?Ì) + ("&I'" ?Í) + ("&I>" ?Î) + ("&I:" ?Ï) + ("&D-" ?Ð) + ("&N?" ?Ñ) + ("&O!" ?Ò) + ("&O'" ?Ó) + ("&O>" ?Ô) + ("&O?" ?Õ) + ("&O:" ?Ö) + ("&*X" ?×) + ("&O/" ?Ø) + ("&U!" ?Ù) + ("&U'" ?Ú) + ("&U>" ?Û) + ("&U:" ?Ü) + ("&Y'" ?Ý) + ("&TH" ?Þ) + ("&ss" ?ß) + ("&a!" ?à) + ("&a'" ?á) + ("&a>" ?â) + ("&a?" ?ã) + ("&a:" ?ä) + ("&aa" ?å) + ("&ae" ?æ) + ("&c," ?ç) + ("&e!" ?è) + ("&e'" ?é) + ("&e>" ?ê) + ("&e:" ?ë) + ("&i!" ?ì) + ("&i'" ?í) + ("&i>" ?î) + ("&i:" ?ï) + ("&d-" ?ð) + ("&n?" ?ñ) + ("&o!" ?ò) + ("&o'" ?ó) + ("&o>" ?ô) + ("&o?" ?õ) + ("&o:" ?ö) + ("&-:" ?÷) + ("&o/" ?ø) + ("&u!" ?ù) + ("&u'" ?ú) + ("&u>" ?û) + ("&u:" ?ü) + ("&y'" ?ý) + ("&th" ?þ) + ("&y:" ?ÿ) + ("&A-" ?Ā) + ("&a-" ?ā) + ("&A(" ?Ă) + ("&a(" ?ă) + ("&A;" ?Ą) + ("&a;" ?ą) + ("&C'" ?Ć) + ("&c'" ?ć) + ("&C>" ?Ĉ) + ("&c>" ?ĉ) + ("&C." ?Ċ) + ("&c." ?ċ) + ("&C<" ?Č) + ("&c<" ?č) + ("&D<" ?Ď) + ("&d<" ?ď) + ("&D/" ?Đ) + ("&d/" ?đ) + ("&E-" ?Ē) + ("&e-" ?ē) + ("&E(" ?Ĕ) + ("&e(" ?ĕ) + ("&E." ?Ė) + ("&e." ?ė) + ("&E;" ?Ę) + ("&e;" ?ę) + ("&E<" ?Ě) + ("&e<" ?ě) + ("&G>" ?Ĝ) + ("&g>" ?ĝ) + ("&G(" ?Ğ) + ("&g(" ?ğ) + ("&G." ?Ġ) + ("&g." ?ġ) + ("&G," ?Ģ) + ("&g," ?ģ) + ("&H>" ?Ĥ) + ("&h>" ?ĥ) + ("&H/" ?Ħ) + ("&h/" ?ħ) + ("&I?" ?Ĩ) + ("&i?" ?ĩ) + ("&I-" ?Ī) + ("&i-" ?ī) + ("&I(" ?Ĭ) + ("&i(" ?ĭ) + ("&I;" ?Į) + ("&i;" ?į) + ("&I." ?İ) + ("&i." ?ı) + ("&IJ" ?IJ) + ("&ij" ?ij) + ("&J>" ?Ĵ) + ("&j>" ?ĵ) + ("&K," ?Ķ) + ("&k," ?ķ) + ("&kk" ?ĸ) + ("&L'" ?Ĺ) + ("&l'" ?ĺ) + ("&L," ?Ļ) + ("&l," ?ļ) + ("&L<" ?Ľ) + ("&l<" ?ľ) + ("&L." ?Ŀ) + ("&l." ?ŀ) + ("&L/" ?Ł) + ("&l/" ?ł) + ("&N'" ?Ń) + ("&n'" ?ń) + ("&N," ?Ņ) + ("&n," ?ņ) + ("&N<" ?Ň) + ("&n<" ?ň) + ("&'n" ?ʼn) + ("&NG" ?Ŋ) + ("&ng" ?ŋ) + ("&O-" ?Ō) + ("&o-" ?ō) + ("&O(" ?Ŏ) + ("&o(" ?ŏ) + ("&O\"" ?Ő) + ("&o\"" ?ő) + ("&OE" ?Œ) + ("&oe" ?œ) + ("&R'" ?Ŕ) + ("&r'" ?ŕ) + ("&R," ?Ŗ) + ("&r," ?ŗ) + ("&R<" ?Ř) + ("&r<" ?ř) + ("&S'" ?Ś) + ("&s'" ?ś) + ("&S>" ?Ŝ) + ("&s>" ?ŝ) + ("&S," ?Ş) + ("&s," ?ş) + ("&S<" ?Š) + ("&s<" ?š) + ("&T," ?Ţ) + ("&t," ?ţ) + ("&T<" ?Ť) + ("&t<" ?ť) + ("&T/" ?Ŧ) + ("&t/" ?ŧ) + ("&U?" ?Ũ) + ("&u?" ?ũ) + ("&U-" ?Ū) + ("&u-" ?ū) + ("&U(" ?Ŭ) + ("&u(" ?ŭ) + ("&U0" ?Ů) + ("&u0" ?ů) + ("&U\"" ?Ű) + ("&u\"" ?ű) + ("&U;" ?Ų) + ("&u;" ?ų) + ("&W>" ?Ŵ) + ("&w>" ?ŵ) + ("&Y>" ?Ŷ) + ("&y>" ?ŷ) + ("&Y:" ?Ÿ) + ("&Z'" ?Ź) + ("&z'" ?ź) + ("&Z." ?Ż) + ("&z." ?ż) + ("&Z<" ?Ž) + ("&z<" ?ž) + ("&s1" ?ſ) + ("&b/" ?ƀ) + ("&B2" ?Ɓ) + ("&C2" ?Ƈ) + ("&c2" ?ƈ) + ("&F2" ?Ƒ) + ("&f2" ?ƒ) + ("&K2" ?Ƙ) + ("&k2" ?ƙ) + ("&O9" ?Ơ) + ("&o9" ?ơ) + ("&OI" ?Ƣ) + ("&oi" ?ƣ) + ("&yr" ?Ʀ) + ("&U9" ?Ư) + ("&u9" ?ư) + ("&Z/" ?Ƶ) + ("&z/" ?ƶ) + ("&ED" ?Ʒ) + ("&DZ<" ?DŽ) + ("&Dz<" ?Dž) + ("&dz<" ?dž) + ("&LJ3" ?LJ) + ("&Lj3" ?Lj) + ("&lj3" ?lj) + ("&NJ3" ?NJ) + ("&Nj3" ?Nj) + ("&nj3" ?nj) + ("&A<" ?Ǎ) + ("&a<" ?ǎ) + ("&I<" ?Ǐ) + ("&i<" ?ǐ) + ("&O<" ?Ǒ) + ("&o<" ?ǒ) + ("&U<" ?Ǔ) + ("&u<" ?ǔ) + ("&U:-" ?Ǖ) + ("&u:-" ?ǖ) + ("&U:'" ?Ǘ) + ("&u:'" ?ǘ) + ("&U:<" ?Ǚ) + ("&u:<" ?ǚ) + ("&U:!" ?Ǜ) + ("&u:!" ?ǜ) + ("&e1" ?ǝ) + ("&A1" ?Ǟ) + ("&a1" ?ǟ) + ("&A7" ?Ǡ) + ("&a7" ?ǡ) + ("&A3" ?Ǣ) + ("&a3" ?ǣ) + ("&G/" ?Ǥ) + ("&g/" ?ǥ) + ("&G<" ?Ǧ) + ("&g<" ?ǧ) + ("&K<" ?Ǩ) + ("&k<" ?ǩ) + ("&O;" ?Ǫ) + ("&o;" ?ǫ) + ("&O1" ?Ǭ) + ("&o1" ?ǭ) + ("&EZ" ?Ǯ) + ("&ez" ?ǯ) + ("&j<" ?ǰ) + ("&DZ3" ?DZ) + ("&Dz3" ?Dz) + ("&dz3" ?dz) + ("&G'" ?Ǵ) + ("&g'" ?ǵ) + ("&AA'" ?Ǻ) + ("&aa'" ?ǻ) + ("&AE'" ?Ǽ) + ("&ae'" ?ǽ) + ("&O/'" ?Ǿ) + ("&o/'" ?ǿ) + ("&A!!" ?Ȁ) + ("&a!!" ?ȁ) + ("&A)" ?Ȃ) + ("&a)" ?ȃ) + ("&E!!" ?Ȅ) + ("&e!!" ?ȅ) + ("&E)" ?Ȇ) + ("&e)" ?ȇ) + ("&I!!" ?Ȉ) + ("&i!!" ?ȉ) + ("&I)" ?Ȋ) + ("&i)" ?ȋ) + ("&O!!" ?Ȍ) + ("&o!!" ?ȍ) + ("&O)" ?Ȏ) + ("&o)" ?ȏ) + ("&R!!" ?Ȑ) + ("&r!!" ?ȑ) + ("&R)" ?Ȓ) + ("&r)" ?ȓ) + ("&U!!" ?Ȕ) + ("&u!!" ?ȕ) + ("&U)" ?Ȗ) + ("&u)" ?ȗ) + ("&r1" ?ɼ) + ("&ed" ?ʒ) + ("&;S" ?ʻ) + ("&1>" ?ˆ) + ("&'<" ?ˇ) + ("&1-" ?ˉ) + ("&1!" ?ˋ) + ("&'(" ?˘) + ("&'." ?˙) + ("&'0" ?˚) + ("&';" ?˛) + ("&1?" ?˜) + ("&'\"" ?˝) + ("&'G" ?ʹ) + ("&,G" ?͵) + ("&j3" ?ͺ) + ("&?%" ?;) + ("&'*" ?΄) + ("&'%" ?΅) + ("&A%" ?Ά) + ("&.*" ?·) + ("&E%" ?Έ) + ("&Y%" ?Ή) + ("&I%" ?Ί) + ("&O%" ?Ό) + ("&U%" ?Ύ) + ("&W%" ?Ώ) + ("&i3" ?ΐ) + ("&A*" ?Α) + ("&B*" ?Β) + ("&G*" ?Γ) + ("&D*" ?Δ) + ("&E*" ?Ε) + ("&Z*" ?Ζ) + ("&Y*" ?Η) + ("&H*" ?Θ) + ("&I*" ?Ι) + ("&K*" ?Κ) + ("&L*" ?Λ) + ("&M*" ?Μ) + ("&N*" ?Ν) + ("&C*" ?Ξ) + ("&O*" ?Ο) + ("&P*" ?Π) + ("&R*" ?Ρ) + ("&S*" ?Σ) + ("&T*" ?Τ) + ("&U*" ?Υ) + ("&F*" ?Φ) + ("&X*" ?Χ) + ("&Q*" ?Ψ) + ("&W*" ?Ω) + ("&J*" ?Ϊ) + ("&V*" ?Ϋ) + ("&a%" ?ά) + ("&e%" ?έ) + ("&y%" ?ή) + ("&i%" ?ί) + ("&u3" ?ΰ) + ("&a*" ?α) + ("&b*" ?β) + ("&g*" ?γ) + ("&d*" ?δ) + ("&e*" ?ε) + ("&z*" ?ζ) + ("&y*" ?η) + ("&h*" ?θ) + ("&i*" ?ι) + ("&k*" ?κ) + ("&l*" ?λ) + ("&m*" ?μ) + ("&n*" ?ν) + ("&c*" ?ξ) + ("&o*" ?ο) + ("&p*" ?π) + ("&r*" ?ρ) + ("&*s" ?ς) + ("&s*" ?σ) + ("&t*" ?τ) + ("&u*" ?υ) + ("&f*" ?φ) + ("&x*" ?χ) + ("&q*" ?ψ) + ("&w*" ?ω) + ("&j*" ?ϊ) + ("&v*" ?ϋ) + ("&o%" ?ό) + ("&u%" ?ύ) + ("&w%" ?ώ) + ("&b3" ?ϐ) + ("&T3" ?Ϛ) + ("&M3" ?Ϝ) + ("&K3" ?Ϟ) + ("&P3" ?Ϡ) + ("&IO" ?Ё) + ("&D%" ?Ђ) + ("&G%" ?Ѓ) + ("&IE" ?Є) + ("&DS" ?Ѕ) + ("&II" ?І) + ("&YI" ?Ї) + ("&J%" ?Ј) + ("&LJ" ?Љ) + ("&NJ" ?Њ) + ("&Ts" ?Ћ) + ("&KJ" ?Ќ) + ("&V%" ?Ў) + ("&DZ" ?Џ) + ("&A=" ?А) + ("&B=" ?Б) + ("&V=" ?В) + ("&G=" ?Г) + ("&D=" ?Д) + ("&E=" ?Е) + ("&Z%" ?Ж) + ("&Z=" ?З) + ("&I=" ?И) + ("&J=" ?Й) + ("&K=" ?К) + ("&L=" ?Л) + ("&M=" ?М) + ("&N=" ?Н) + ("&O=" ?О) + ("&P=" ?П) + ("&R=" ?Р) + ("&S=" ?С) + ("&T=" ?Т) + ("&U=" ?У) + ("&F=" ?Ф) + ("&H=" ?Х) + ("&C=" ?Ц) + ("&C%" ?Ч) + ("&S%" ?Ш) + ("&Sc" ?Щ) + ("&=\"" ?Ъ) + ("&Y=" ?Ы) + ("&%\"" ?Ь) + ("&JE" ?Э) + ("&JU" ?Ю) + ("&JA" ?Я) + ("&a=" ?а) + ("&b=" ?б) + ("&v=" ?в) + ("&g=" ?г) + ("&d=" ?д) + ("&e=" ?е) + ("&z%" ?ж) + ("&z=" ?з) + ("&i=" ?и) + ("&j=" ?й) + ("&k=" ?к) + ("&l=" ?л) + ("&m=" ?м) + ("&n=" ?н) + ("&o=" ?о) + ("&p=" ?п) + ("&r=" ?р) + ("&s=" ?с) + ("&t=" ?т) + ("&u=" ?у) + ("&f=" ?ф) + ("&h=" ?х) + ("&c=" ?ц) + ("&c%" ?ч) + ("&s%" ?ш) + ("&sc" ?щ) + ("&='" ?ъ) + ("&y=" ?ы) + ("&%'" ?ь) + ("&je" ?э) + ("&ju" ?ю) + ("&ja" ?я) + ("&io" ?ё) + ("&d%" ?ђ) + ("&g%" ?ѓ) + ("&ie" ?є) + ("&ds" ?ѕ) + ("&ii" ?і) + ("&yi" ?ї) + ("&j%" ?ј) + ("&lj" ?љ) + ("&nj" ?њ) + ("&ts" ?ћ) + ("&kj" ?ќ) + ("&v%" ?ў) + ("&dz" ?џ) + ("&Y3" ?Ѣ) + ("&y3" ?ѣ) + ("&O3" ?Ѫ) + ("&o3" ?ѫ) + ("&F3" ?Ѳ) + ("&f3" ?ѳ) + ("&V3" ?Ѵ) + ("&v3" ?ѵ) + ("&C3" ?Ҁ) + ("&c3" ?ҁ) + ("&G3" ?Ґ) + ("&g3" ?ґ) + ("&A+" ?א) + ("&B+" ?ב) + ("&G+" ?ג) + ("&D+" ?ד) + ("&H+" ?ה) + ("&W+" ?ו) + ("&Z+" ?ז) + ("&X+" ?ח) + ("&Tj" ?ט) + ("&J+" ?י) + ("&K%" ?ך) + ("&K+" ?כ) + ("&L+" ?ל) + ("&M%" ?ם) + ("&M+" ?מ) + ("&N%" ?ן) + ("&N+" ?נ) + ("&S+" ?ס) + ("&E+" ?ע) + ("&P%" ?ף) + ("&P+" ?פ) + ("&Zj" ?ץ) + ("&ZJ" ?צ) + ("&Q+" ?ק) + ("&R+" ?ר) + ("&Sh" ?ש) + ("&T+" ?ת) + ("&,+" ?،) + ("&;+" ?؛) + ("&?+" ?؟) + ("&H'" ?ء) + ("&aM" ?آ) + ("&aH" ?أ) + ("&wH" ?ؤ) + ("&ah" ?إ) + ("&yH" ?ئ) + ("&a+" ?ا) + ("&b+" ?ب) + ("&tm" ?ة) + ("&t+" ?ت) + ("&tk" ?ث) + ("&g+" ?ج) + ("&hk" ?ح) + ("&x+" ?خ) + ("&d+" ?د) + ("&dk" ?ذ) + ("&r+" ?ر) + ("&z+" ?ز) + ("&s+" ?س) + ("&sn" ?ش) + ("&c+" ?ص) + ("&dd" ?ض) + ("&tj" ?ط) + ("&zH" ?ظ) + ("&e+" ?ع) + ("&i+" ?غ) + ("&++" ?ـ) + ("&f+" ?ف) + ("&q+" ?ق) + ("&k+" ?ك) + ("&l+" ?ل) + ("&m+" ?م) + ("&n+" ?ن) + ("&h+" ?ه) + ("&w+" ?و) + ("&j+" ?ى) + ("&y+" ?ي) + ("&:+" ?ً) + ("&\"+" ?ٌ) + ("&=+" ?ٍ) + ("&/+" ?َ) + ("&'+" ?ُ) + ("&1+" ?ِ) + ("&3+" ?ّ) + ("&0+" ?ْ) + ("&0a" ?٠) + ("&1a" ?١) + ("&2a" ?٢) + ("&3a" ?٣) + ("&4a" ?٤) + ("&5a" ?٥) + ("&6a" ?٦) + ("&7a" ?٧) + ("&8a" ?٨) + ("&9a" ?٩) + ("&aS" ?ٰ) + ("&p+" ?پ) + ("&hH" ?ځ) + ("&tc" ?چ) + ("&zj" ?ژ) + ("&v+" ?ڤ) + ("&gf" ?گ) + ("&A-0" ?Ḁ) + ("&a-0" ?ḁ) + ("&B." ?Ḃ) + ("&b." ?ḃ) + ("&B-." ?Ḅ) + ("&b-." ?ḅ) + ("&B_" ?Ḇ) + ("&b_" ?ḇ) + ("&C,'" ?Ḉ) + ("&c,'" ?ḉ) + ("&D." ?Ḋ) + ("&d." ?ḋ) + ("&D-." ?Ḍ) + ("&d-." ?ḍ) + ("&D_" ?Ḏ) + ("&d_" ?ḏ) + ("&D," ?Ḑ) + ("&d," ?ḑ) + ("&D->" ?Ḓ) + ("&d->" ?ḓ) + ("&E-!" ?Ḕ) + ("&e-!" ?ḕ) + ("&E-'" ?Ḗ) + ("&e-'" ?ḗ) + ("&E->" ?Ḙ) + ("&e->" ?ḙ) + ("&E-?" ?Ḛ) + ("&e-?" ?ḛ) + ("&E,(" ?Ḝ) + ("&e,(" ?ḝ) + ("&F." ?Ḟ) + ("&f." ?ḟ) + ("&G-" ?Ḡ) + ("&g-" ?ḡ) + ("&H." ?Ḣ) + ("&h." ?ḣ) + ("&H-." ?Ḥ) + ("&h-." ?ḥ) + ("&H:" ?Ḧ) + ("&h:" ?ḧ) + ("&H," ?Ḩ) + ("&h," ?ḩ) + ("&H-(" ?Ḫ) + ("&h-(" ?ḫ) + ("&I-?" ?Ḭ) + ("&i-?" ?ḭ) + ("&I:'" ?Ḯ) + ("&i:'" ?ḯ) + ("&K'" ?Ḱ) + ("&k'" ?ḱ) + ("&K-." ?Ḳ) + ("&k-." ?ḳ) + ("&K_" ?Ḵ) + ("&k_" ?ḵ) + ("&L-." ?Ḷ) + ("&l-." ?ḷ) + ("&L_" ?Ḻ) + ("&l_" ?ḻ) + ("&L->" ?Ḽ) + ("&l->" ?ḽ) + ("&M'" ?Ḿ) + ("&m'" ?ḿ) + ("&M." ?Ṁ) + ("&m." ?ṁ) + ("&M-." ?Ṃ) + ("&m-." ?ṃ) + ("&N." ?Ṅ) + ("&n." ?ṅ) + ("&N-." ?Ṇ) + ("&n-." ?ṇ) + ("&N_" ?Ṉ) + ("&n_" ?ṉ) + ("&N->" ?Ṋ) + ("&n->" ?ṋ) + ("&O?'" ?Ṍ) + ("&o?'" ?ṍ) + ("&O?:" ?Ṏ) + ("&o?:" ?ṏ) + ("&O-!" ?Ṑ) + ("&o-!" ?ṑ) + ("&O-'" ?Ṓ) + ("&o-'" ?ṓ) + ("&P'" ?Ṕ) + ("&p'" ?ṕ) + ("&P." ?Ṗ) + ("&p." ?ṗ) + ("&R." ?Ṙ) + ("&r." ?ṙ) + ("&R-." ?Ṛ) + ("&r-." ?ṛ) + ("&R_" ?Ṟ) + ("&r_" ?ṟ) + ("&S." ?Ṡ) + ("&s." ?ṡ) + ("&S-." ?Ṣ) + ("&s-." ?ṣ) + ("&S'." ?Ṥ) + ("&s'." ?ṥ) + ("&S<." ?Ṧ) + ("&s<." ?ṧ) + ("&T." ?Ṫ) + ("&t." ?ṫ) + ("&T-." ?Ṭ) + ("&t-." ?ṭ) + ("&T_" ?Ṯ) + ("&t_" ?ṯ) + ("&T->" ?Ṱ) + ("&t->" ?ṱ) + ("&U-?" ?Ṵ) + ("&u-?" ?ṵ) + ("&U->" ?Ṷ) + ("&u->" ?ṷ) + ("&U?'" ?Ṹ) + ("&u?'" ?ṹ) + ("&U-:" ?Ṻ) + ("&u-:" ?ṻ) + ("&V?" ?Ṽ) + ("&v?" ?ṽ) + ("&V-." ?Ṿ) + ("&v-." ?ṿ) + ("&W!" ?Ẁ) + ("&w!" ?ẁ) + ("&W'" ?Ẃ) + ("&w'" ?ẃ) + ("&W:" ?Ẅ) + ("&w:" ?ẅ) + ("&W." ?Ẇ) + ("&w." ?ẇ) + ("&W-." ?Ẉ) + ("&w-." ?ẉ) + ("&X." ?Ẋ) + ("&x." ?ẋ) + ("&X:" ?Ẍ) + ("&x:" ?ẍ) + ("&Y." ?Ẏ) + ("&y." ?ẏ) + ("&Z>" ?Ẑ) + ("&z>" ?ẑ) + ("&Z-." ?Ẓ) + ("&z-." ?ẓ) + ("&Z_" ?Ẕ) + ("&z_" ?ẕ) + ("&A-." ?Ạ) + ("&a-." ?ạ) + ("&A2" ?Ả) + ("&a2" ?ả) + ("&A>'" ?Ấ) + ("&a>'" ?ấ) + ("&A>!" ?Ầ) + ("&a>!" ?ầ) + ("&A>2" ?Ẩ) + ("&a>2" ?ẩ) + ("&A>?" ?Ẫ) + ("&a>?" ?ẫ) + ("&A('" ?Ắ) + ("&a('" ?ắ) + ("&A(!" ?Ằ) + ("&a(!" ?ằ) + ("&A(2" ?Ẳ) + ("&a(2" ?ẳ) + ("&A(?" ?Ẵ) + ("&a(?" ?ẵ) + ("&E-." ?Ẹ) + ("&e-." ?ẹ) + ("&E2" ?Ẻ) + ("&e2" ?ẻ) + ("&E?" ?Ẽ) + ("&e?" ?ẽ) + ("&E>'" ?Ế) + ("&e>'" ?ế) + ("&E>!" ?Ề) + ("&e>!" ?ề) + ("&E>2" ?Ể) + ("&e>2" ?ể) + ("&E>?" ?Ễ) + ("&e>?" ?ễ) + ("&I2" ?Ỉ) + ("&i2" ?ỉ) + ("&I-." ?Ị) + ("&i-." ?ị) + ("&O-." ?Ọ) + ("&o-." ?ọ) + ("&O2" ?Ỏ) + ("&o2" ?ỏ) + ("&O>'" ?Ố) + ("&o>'" ?ố) + ("&O>!" ?Ồ) + ("&o>!" ?ồ) + ("&O>2" ?Ổ) + ("&o>2" ?ổ) + ("&O>?" ?Ỗ) + ("&o>?" ?ỗ) + ("&O9'" ?Ớ) + ("&o9'" ?ớ) + ("&O9!" ?Ờ) + ("&o9!" ?ờ) + ("&O92" ?Ở) + ("&o92" ?ở) + ("&O9?" ?Ỡ) + ("&o9?" ?ỡ) + ("&U-." ?Ụ) + ("&u-." ?ụ) + ("&U2" ?Ủ) + ("&u2" ?ủ) + ("&U9'" ?Ứ) + ("&u9'" ?ứ) + ("&U9!" ?Ừ) + ("&u9!" ?ừ) + ("&U92" ?Ử) + ("&u92" ?ử) + ("&U9?" ?Ữ) + ("&u9?" ?ữ) + ("&Y!" ?Ỳ) + ("&y!" ?ỳ) + ("&Y-." ?Ỵ) + ("&y-." ?ỵ) + ("&Y2" ?Ỷ) + ("&y2" ?ỷ) + ("&Y?" ?Ỹ) + ("&y?" ?ỹ) + ("&a*," ?ἀ) + ("&a*;" ?ἁ) + ("&A*," ?Ἀ) + ("&A*;" ?Ἁ) + ("&e*," ?ἐ) + ("&e*;" ?ἑ) + ("&E*," ?Ἐ) + ("&E*;" ?Ἑ) + ("&y*," ?ἠ) + ("&y*;" ?ἡ) + ("&Y*," ?Ἠ) + ("&Y*;" ?Ἡ) + ("&i*," ?ἰ) + ("&i*;" ?ἱ) + ("&I*," ?Ἰ) + ("&I*;" ?Ἱ) + ("&o*," ?ὀ) + ("&o*;" ?ὁ) + ("&O*," ?Ὀ) + ("&O*;" ?Ὁ) + ("&u*," ?ὐ) + ("&u*;" ?ὑ) + ("&U*;" ?Ὑ) + ("&w*," ?ὠ) + ("&w*;" ?ὡ) + ("&W*," ?Ὠ) + ("&W*;" ?Ὡ) + ("&a*!" ?ὰ) + ("&a*'" ?ά) + ("&e*!" ?ὲ) + ("&e*'" ?έ) + ("&y*!" ?ὴ) + ("&y*'" ?ή) + ("&i*!" ?ὶ) + ("&i*'" ?ί) + ("&o*!" ?ὸ) + ("&o*'" ?ό) + ("&u*!" ?ὺ) + ("&u*'" ?ύ) + ("&w*!" ?ὼ) + ("&w*'" ?ώ) + ("&a*(" ?ᾰ) + ("&a*-" ?ᾱ) + ("&a*j" ?ᾳ) + ("&a*?" ?ᾶ) + ("&A*(" ?Ᾰ) + ("&A*-" ?Ᾱ) + ("&A*!" ?Ὰ) + ("&A*'" ?Ά) + ("&A*J" ?ᾼ) + ("&)*" ?᾽) + ("&J3" ?ι) + ("&,," ?᾿) + ("&?*" ?῀) + ("&?:" ?῁) + ("&y*j" ?ῃ) + ("&y*?" ?ῆ) + ("&E*'" ?Έ) + ("&Y*!" ?Ὴ) + ("&Y*'" ?Ή) + ("&Y*J" ?ῌ) + ("&,!" ?῍) + ("&,'" ?῎) + ("&?," ?῏) + ("&i*(" ?ῐ) + ("&i*-" ?ῑ) + ("&i*?" ?ῖ) + ("&I*(" ?Ῐ) + ("&I*-" ?Ῑ) + ("&I*!" ?Ὶ) + ("&I*'" ?Ί) + ("&;!" ?῝) + ("&;'" ?῞) + ("&?;" ?῟) + ("&u*(" ?ῠ) + ("&u*-" ?ῡ) + ("&r*," ?ῤ) + ("&r*;" ?ῥ) + ("&u*?" ?ῦ) + ("&U*(" ?Ῠ) + ("&U*-" ?Ῡ) + ("&U*!" ?Ὺ) + ("&U*'" ?Ύ) + ("&R*;" ?Ῥ) + ("&!:" ?῭) + ("&:'" ?΅) + ("&!*" ?`) + ("&w*j" ?ῳ) + ("&w*?" ?ῶ) + ("&O*!" ?Ὸ) + ("&O*'" ?Ό) + ("&W*!" ?Ὼ) + ("&W*'" ?Ώ) + ("&W*J" ?ῼ) + ("&/*" ?´) + ("&;;" ?῾) + ("&1N" ? ) + ("&1M" ? ) + ("&3M" ? ) + ("&4M" ? ) + ("&6M" ? ) + ("&1T" ? ) + ("&1H" ? ) + ("&LR" ?) + ("&RL" ?) + ("&-1" ?‐) + ("&-N" ?–) + ("&-M" ?—) + ("&-3" ?―) + ("&!2" ?‖) + ("&=2" ?‗) + ("&'6" ?‘) + ("&'9" ?’) + ("&.9" ?‚) + ("&9'" ?‛) + ("&\"6" ?“) + ("&\"9" ?”) + ("&:9" ?„) + ("&9\"" ?‟) + ("&/-" ?†) + ("&/=" ?‡) + ("&sb" ?•) + ("&3b" ?‣) + ("&.." ?‥) + ("&.3" ?…) + ("&.-" ?‧) + ("&%0" ?‰) + ("&1'" ?′) + ("&2'" ?″) + ("&3'" ?‴) + ("&1\"" ?‵) + ("&2\"" ?‶) + ("&3\"" ?‷) + ("&Ca" ?‸) + ("&<1" ?‹) + ("&>1" ?›) + ("&:X" ?※) + ("&!*2" ?‼) + ("&'-" ?‾) + ("&-b" ?⁃) + ("&/f" ?⁄) + ("&0S" ?⁰) + ("&4S" ?⁴) + ("&5S" ?⁵) + ("&6S" ?⁶) + ("&7S" ?⁷) + ("&8S" ?⁸) + ("&9S" ?⁹) + ("&+S" ?⁺) + ("&-S" ?⁻) + ("&=S" ?⁼) + ("&(S" ?⁽) + ("&)S" ?⁾) + ("&nS" ?ⁿ) + ("&0s" ?₀) + ("&1s" ?₁) + ("&2s" ?₂) + ("&3s" ?₃) + ("&4s" ?₄) + ("&5s" ?₅) + ("&6s" ?₆) + ("&7s" ?₇) + ("&8s" ?₈) + ("&9s" ?₉) + ("&+s" ?₊) + ("&-s" ?₋) + ("&=s" ?₌) + ("&(s" ?₍) + ("&)s" ?₎) + ("&Ff" ?₣) + ("&Li" ?₤) + ("&Pt" ?₧) + ("&W=" ?₩) + ("&NSh" ?₪) + ("&Eu" ?€) + ("&\"7" ?⃑) + ("&oC" ?℃) + ("&co" ?℅) + ("&oF" ?℉) + ("&N0" ?№) + ("&PO" ?℗) + ("&Rx" ?℞) + ("&SM" ?℠) + ("&TM" ?™) + ("&Om" ?Ω) + ("&AO" ?Å) + ("&Est" ?℮) + ("&13" ?⅓) + ("&23" ?⅔) + ("&15" ?⅕) + ("&25" ?⅖) + ("&35" ?⅗) + ("&45" ?⅘) + ("&16" ?⅙) + ("&56" ?⅚) + ("&18" ?⅛) + ("&38" ?⅜) + ("&58" ?⅝) + ("&78" ?⅞) + ("&1R" ?Ⅰ) + ("&2R" ?Ⅱ) + ("&3R" ?Ⅲ) + ("&4R" ?Ⅳ) + ("&5R" ?Ⅴ) + ("&6R" ?Ⅵ) + ("&7R" ?Ⅶ) + ("&8R" ?Ⅷ) + ("&9R" ?Ⅸ) + ("&aR" ?Ⅹ) + ("&bR" ?Ⅺ) + ("&cR" ?Ⅻ) + ("&50R" ?Ⅼ) + ("&1r" ?ⅰ) + ("&2r" ?ⅱ) + ("&3r" ?ⅲ) + ("&4r" ?ⅳ) + ("&5r" ?ⅴ) + ("&6r" ?ⅵ) + ("&7r" ?ⅶ) + ("&8r" ?ⅷ) + ("&9r" ?ⅸ) + ("&ar" ?ⅹ) + ("&br" ?ⅺ) + ("&cr" ?ⅻ) + ("&50r" ?ⅼ) + ("&<-" ?←) + ("&-!" ?↑) + ("&->" ?→) + ("&-v" ?↓) + ("&<>" ?↔) + ("&UD" ?↕) + ("&<!!" ?↖) + ("&//>" ?↗) + ("&!!>" ?↘) + ("&<//" ?↙) + ("&UD-" ?↨) + ("&>V" ?⇀) + ("&<=" ?⇐) + ("&=>" ?⇒) + ("&==" ?⇔) + ("&FA" ?∀) + ("&dP" ?∂) + ("&TE" ?∃) + ("&/0" ?∅) + ("&DE" ?∆) + ("&NB" ?∇) + ("&(-" ?∈) + ("&-)" ?∋) + ("&FP" ?∎) + ("&*P" ?∏) + ("&+Z" ?∑) + ("&-2" ?−) + ("&-+" ?∓) + ("&.+" ?∔) + ("&*-" ?∗) + ("&Ob" ?∘) + ("&Sb" ?∙) + ("&RT" ?√) + ("&0(" ?∝) + ("&00" ?∞) + ("&-L" ?∟) + ("&-V" ?∠) + ("&PP" ?∥) + ("&AN" ?∧) + ("&OR" ?∨) + ("&(U" ?∩) + ("&)U" ?∪) + ("&In" ?∫) + ("&DI" ?∬) + ("&Io" ?∮) + ("&.:" ?∴) + ("&:." ?∵) + ("&:R" ?∶) + ("&::" ?∷) + ("&?1" ?∼) + ("&CG" ?∾) + ("&?-" ?≃) + ("&?=" ?≅) + ("&?2" ?≈) + ("&=?" ?≌) + ("&HI" ?≓) + ("&!=" ?≠) + ("&=3" ?≡) + ("&=<" ?≤) + ("&>=" ?≥) + ("&<*" ?≪) + ("&*>" ?≫) + ("&!<" ?≮) + ("&!>" ?≯) + ("&(C" ?⊂) + ("&)C" ?⊃) + ("&(_" ?⊆) + ("&)_" ?⊇) + ("&0." ?⊙) + ("&02" ?⊚) + ("&-T" ?⊥) + ("&.P" ?⋅) + ("&:3" ?⋮) + ("&Eh" ?⌂) + ("&<7" ?⌈) + ("&>7" ?⌉) + ("&7<" ?⌊) + ("&7>" ?⌋) + ("&NI" ?⌐) + ("&(A" ?⌒) + ("&TR" ?⌕) + ("&88" ?⌘) + ("&Iu" ?⌠) + ("&Il" ?⌡) + ("&</" ?〈) + ("&/>" ?〉) + ("&Vs" ?␣) + ("&1h" ?⑀) + ("&3h" ?⑁) + ("&2h" ?⑂) + ("&4h" ?⑃) + ("&1j" ?⑆) + ("&2j" ?⑇) + ("&3j" ?⑈) + ("&4j" ?⑉) + ("&1-o" ?①) + ("&2-o" ?②) + ("&3-o" ?③) + ("&4-o" ?④) + ("&5-o" ?⑤) + ("&6-o" ?⑥) + ("&7-o" ?⑦) + ("&8-o" ?⑧) + ("&9-o" ?⑨) + ("&(1)" ?⑴) + ("&(2)" ?⑵) + ("&(3)" ?⑶) + ("&(4)" ?⑷) + ("&(5)" ?⑸) + ("&(6)" ?⑹) + ("&(7)" ?⑺) + ("&(8)" ?⑻) + ("&(9)" ?⑼) + ("&1." ?⒈) + ("&2." ?⒉) + ("&3." ?⒊) + ("&4." ?⒋) + ("&5." ?⒌) + ("&6." ?⒍) + ("&7." ?⒎) + ("&8." ?⒏) + ("&9." ?⒐) + ("&10." ?⒑) + ("&11." ?⒒) + ("&12." ?⒓) + ("&13." ?⒔) + ("&14." ?⒕) + ("&15." ?⒖) + ("&16." ?⒗) + ("&17." ?⒘) + ("&18." ?⒙) + ("&19." ?⒚) + ("&20." ?⒛) + ("&(a)" ?⒜) + ("&(b)" ?⒝) + ("&(c)" ?⒞) + ("&(d)" ?⒟) + ("&(e)" ?⒠) + ("&(f)" ?⒡) + ("&(g)" ?⒢) + ("&(h)" ?⒣) + ("&(i)" ?⒤) + ("&(j)" ?⒥) + ("&(k)" ?⒦) + ("&(l)" ?⒧) + ("&(m)" ?⒨) + ("&(n)" ?⒩) + ("&(o)" ?⒪) + ("&(p)" ?⒫) + ("&(q)" ?⒬) + ("&(r)" ?⒭) + ("&(s)" ?⒮) + ("&(t)" ?⒯) + ("&(u)" ?⒰) + ("&(v)" ?⒱) + ("&(w)" ?⒲) + ("&(x)" ?⒳) + ("&(y)" ?⒴) + ("&(z)" ?⒵) + ("&A-o" ?Ⓐ) + ("&B-o" ?Ⓑ) + ("&C-o" ?Ⓒ) + ("&D-o" ?Ⓓ) + ("&E-o" ?Ⓔ) + ("&F-o" ?Ⓕ) + ("&G-o" ?Ⓖ) + ("&H-o" ?Ⓗ) + ("&I-o" ?Ⓘ) + ("&J-o" ?Ⓙ) + ("&K-o" ?Ⓚ) + ("&L-o" ?Ⓛ) + ("&M-o" ?Ⓜ) + ("&N-o" ?Ⓝ) + ("&O-o" ?Ⓞ) + ("&P-o" ?Ⓟ) + ("&Q-o" ?Ⓠ) + ("&R-o" ?Ⓡ) + ("&S-o" ?Ⓢ) + ("&T-o" ?Ⓣ) + ("&U-o" ?Ⓤ) + ("&V-o" ?Ⓥ) + ("&W-o" ?Ⓦ) + ("&X-o" ?Ⓧ) + ("&Y-o" ?Ⓨ) + ("&Z-o" ?Ⓩ) + ("&a-o" ?ⓐ) + ("&b-o" ?ⓑ) + ("&c-o" ?ⓒ) + ("&d-o" ?ⓓ) + ("&e-o" ?ⓔ) + ("&f-o" ?ⓕ) + ("&g-o" ?ⓖ) + ("&h-o" ?ⓗ) + ("&i-o" ?ⓘ) + ("&j-o" ?ⓙ) + ("&k-o" ?ⓚ) + ("&l-o" ?ⓛ) + ("&m-o" ?ⓜ) + ("&n-o" ?ⓝ) + ("&o-o" ?ⓞ) + ("&p-o" ?ⓟ) + ("&q-o" ?ⓠ) + ("&r-o" ?ⓡ) + ("&s-o" ?ⓢ) + ("&t-o" ?ⓣ) + ("&u-o" ?ⓤ) + ("&v-o" ?ⓥ) + ("&w-o" ?ⓦ) + ("&x-o" ?ⓧ) + ("&y-o" ?ⓨ) + ("&z-o" ?ⓩ) + ("&0-o" ?⓪) + ("&hh" ?─) + ("&HH-" ?━) + ("&vv" ?│) + ("&VV-" ?┃) + ("&3-" ?┄) + ("&3_" ?┅) + ("&3!" ?┆) + ("&3/" ?┇) + ("&4-" ?┈) + ("&4_" ?┉) + ("&4!" ?┊) + ("&4/" ?┋) + ("&dr" ?┌) + ("&dR-" ?┍) + ("&Dr-" ?┎) + ("&DR-" ?┏) + ("&dl" ?┐) + ("&dL-" ?┑) + ("&Dl-" ?┒) + ("&LD-" ?┓) + ("&ur" ?└) + ("&uR-" ?┕) + ("&Ur-" ?┖) + ("&UR-" ?┗) + ("&ul" ?┘) + ("&uL-" ?┙) + ("&Ul-" ?┚) + ("&UL-" ?┛) + ("&vr" ?├) + ("&vR-" ?┝) + ("&Udr" ?┞) + ("&uDr" ?┟) + ("&Vr-" ?┠) + ("&UdR" ?┡) + ("&uDR" ?┢) + ("&VR-" ?┣) + ("&vl" ?┤) + ("&vL-" ?┥) + ("&Udl" ?┦) + ("&uDl" ?┧) + ("&Vl-" ?┨) + ("&UdL" ?┩) + ("&uDL" ?┪) + ("&VL-" ?┫) + ("&dh" ?┬) + ("&dLr" ?┭) + ("&dlR" ?┮) + ("&dH-" ?┯) + ("&Dh-" ?┰) + ("&DLr" ?┱) + ("&DlR" ?┲) + ("&DH-" ?┳) + ("&uh" ?┴) + ("&uLr" ?┵) + ("&ulR" ?┶) + ("&uH-" ?┷) + ("&Uh-" ?┸) + ("&ULr" ?┹) + ("&UlR" ?┺) + ("&UH-" ?┻) + ("&vh" ?┼) + ("&vLr" ?┽) + ("&vlR" ?┾) + ("&vH-" ?┿) + ("&Udh" ?╀) + ("&uDh" ?╁) + ("&Vh-" ?╂) + ("&UdH" ?╇) + ("&uDH" ?╈) + ("&VLr" ?╉) + ("&VlR" ?╊) + ("&VH-" ?╋) + ("&HH" ?═) + ("&VV" ?║) + ("&dR" ?╒) + ("&Dr" ?╓) + ("&DR" ?╔) + ("&dL" ?╕) + ("&Dl" ?╖) + ("&LD" ?╗) + ("&uR" ?╘) + ("&Ur" ?╙) + ("&UR" ?╚) + ("&uL" ?╛) + ("&Ul" ?╜) + ("&UL" ?╝) + ("&vR" ?╞) + ("&Vr" ?╟) + ("&VR" ?╠) + ("&vL" ?╡) + ("&Vl" ?╢) + ("&VL" ?╣) + ("&dH" ?╤) + ("&Dh" ?╥) + ("&DH" ?╦) + ("&uH" ?╧) + ("&Uh" ?╨) + ("&UH" ?╩) + ("&vH" ?╪) + ("&Vh" ?╫) + ("&VH" ?╬) + ("&FD" ?╱) + ("&BD" ?╲) + ("&TB" ?▀) + ("&LB" ?▄) + ("&FB" ?█) + ("&lB" ?▌) + ("&RB" ?▐) + ("&.S" ?░) + ("&:S" ?▒) + ("&?S" ?▓) + ("&fS" ?■) + ("&OS" ?□) + ("&RO" ?▢) + ("&Rr" ?▣) + ("&RF" ?▤) + ("&RY" ?▥) + ("&RH" ?▦) + ("&RZ" ?▧) + ("&RK" ?▨) + ("&RX" ?▩) + ("&sB" ?▪) + ("&SR" ?▬) + ("&Or" ?▭) + ("&UT" ?▲) + ("&uT" ?△) + ("&Tr" ?▷) + ("&PR" ?►) + ("&Dt" ?▼) + ("&dT" ?▽) + ("&Tl" ?◁) + ("&PL" ?◄) + ("&Db" ?◆) + ("&Dw" ?◇) + ("&LZ" ?◊) + ("&0m" ?○) + ("&0o" ?◎) + ("&0M" ?●) + ("&0L" ?◐) + ("&0R" ?◑) + ("&Sn" ?◘) + ("&Ic" ?◙) + ("&Fd" ?◢) + ("&Bd" ?◣) + ("&Ci" ?◯) + ("&*2" ?★) + ("&*1" ?☆) + ("&TEL" ?☎) + ("&tel" ?☏) + ("&<H" ?☜) + ("&>H" ?☞) + ("&0u" ?☺) + ("&0U" ?☻) + ("&SU" ?☼) + ("&Fm" ?♀) + ("&Ml" ?♂) + ("&cS" ?♠) + ("&cH" ?♡) + ("&cD" ?♢) + ("&cC" ?♣) + ("&cS-" ?♤) + ("&cH-" ?♥) + ("&cD-" ?♦) + ("&cC-" ?♧) + ("&Md" ?♩) + ("&M8" ?♪) + ("&M2" ?♫) + ("&M16" ?♬) + ("&Mb" ?♭) + ("&Mx" ?♮) + ("&MX" ?♯) + ("&OK" ?✓) + ("&XX" ?✗) + ("&-X" ?✠) + ("&IS" ? ) + ("&,_" ?、) + ("&._" ?。) + ("&+\"" ?〃) + ("&JIS" ?〄) + ("&*_" ?々) + ("&;_" ?〆) + ("&0_" ?〇) + ("&<+" ?《) + ("&>+" ?》) + ("&<'" ?「) + ("&>'" ?」) + ("&<\"" ?『) + ("&>\"" ?』) + ("&(\"" ?【) + ("&)\"" ?】) + ("&=T" ?〒) + ("&=_" ?〓) + ("&('" ?〔) + ("&)'" ?〕) + ("&(I" ?〖) + ("&)I" ?〗) + ("&-?" ?〜) + ("&A5" ?ぁ) + ("&a5" ?あ) + ("&I5" ?ぃ) + ("&i5" ?い) + ("&U5" ?ぅ) + ("&u5" ?う) + ("&E5" ?ぇ) + ("&e5" ?え) + ("&O5" ?ぉ) + ("&o5" ?お) + ("&ka" ?か) + ("&ga" ?が) + ("&ki" ?き) + ("&gi" ?ぎ) + ("&ku" ?く) + ("&gu" ?ぐ) + ("&ke" ?け) + ("&ge" ?げ) + ("&ko" ?こ) + ("&go" ?ご) + ("&sa" ?さ) + ("&za" ?ざ) + ("&si" ?し) + ("&zi" ?じ) + ("&su" ?す) + ("&zu" ?ず) + ("&se" ?せ) + ("&ze" ?ぜ) + ("&so" ?そ) + ("&zo" ?ぞ) + ("&ta" ?た) + ("&da" ?だ) + ("&ti" ?ち) + ("&di" ?ぢ) + ("&tU" ?っ) + ("&tu" ?つ) + ("&du" ?づ) + ("&te" ?て) + ("&de" ?で) + ("&to" ?と) + ("&do" ?ど) + ("&na" ?な) + ("&ni" ?に) + ("&nu" ?ぬ) + ("&ne" ?ね) + ("&no" ?の) + ("&ha" ?は) + ("&ba" ?ば) + ("&pa" ?ぱ) + ("&hi" ?ひ) + ("&bi" ?び) + ("&pi" ?ぴ) + ("&hu" ?ふ) + ("&bu" ?ぶ) + ("&pu" ?ぷ) + ("&he" ?へ) + ("&be" ?べ) + ("&pe" ?ぺ) + ("&ho" ?ほ) + ("&bo" ?ぼ) + ("&po" ?ぽ) + ("&ma" ?ま) + ("&mi" ?み) + ("&mu" ?む) + ("&me" ?め) + ("&mo" ?も) + ("&yA" ?ゃ) + ("&ya" ?や) + ("&yU" ?ゅ) + ("&yu" ?ゆ) + ("&yO" ?ょ) + ("&yo" ?よ) + ("&ra" ?ら) + ("&ri" ?り) + ("&ru" ?る) + ("&re" ?れ) + ("&ro" ?ろ) + ("&wA" ?ゎ) + ("&wa" ?わ) + ("&wi" ?ゐ) + ("&we" ?ゑ) + ("&wo" ?を) + ("&n5" ?ん) + ("&vu" ?ゔ) + ("&\"5" ?゛) + ("&05" ?゜) + ("&*5" ?ゝ) + ("&+5" ?ゞ) + ("&a6" ?ァ) + ("&A6" ?ア) + ("&i6" ?ィ) + ("&I6" ?イ) + ("&u6" ?ゥ) + ("&U6" ?ウ) + ("&e6" ?ェ) + ("&E6" ?エ) + ("&o6" ?ォ) + ("&O6" ?オ) + ("&Ka" ?カ) + ("&Ga" ?ガ) + ("&Ki" ?キ) + ("&Gi" ?ギ) + ("&Ku" ?ク) + ("&Gu" ?グ) + ("&Ke" ?ケ) + ("&Ge" ?ゲ) + ("&Ko" ?コ) + ("&Go" ?ゴ) + ("&Sa" ?サ) + ("&Za" ?ザ) + ("&Si" ?シ) + ("&Zi" ?ジ) + ("&Su" ?ス) + ("&Zu" ?ズ) + ("&Se" ?セ) + ("&Ze" ?ゼ) + ("&So" ?ソ) + ("&Zo" ?ゾ) + ("&Ta" ?タ) + ("&Da" ?ダ) + ("&Ti" ?チ) + ("&Di" ?ヂ) + ("&TU" ?ッ) + ("&Tu" ?ツ) + ("&Du" ?ヅ) + ("&Te" ?テ) + ("&De" ?デ) + ("&To" ?ト) + ("&Do" ?ド) + ("&Na" ?ナ) + ("&Ni" ?ニ) + ("&Nu" ?ヌ) + ("&Ne" ?ネ) + ("&No" ?ノ) + ("&Ha" ?ハ) + ("&Ba" ?バ) + ("&Pa" ?パ) + ("&Hi" ?ヒ) + ("&Bi" ?ビ) + ("&Pi" ?ピ) + ("&Hu" ?フ) + ("&Bu" ?ブ) + ("&Pu" ?プ) + ("&He" ?ヘ) + ("&Be" ?ベ) + ("&Pe" ?ペ) + ("&Ho" ?ホ) + ("&Bo" ?ボ) + ("&Po" ?ポ) + ("&Ma" ?マ) + ("&Mi" ?ミ) + ("&Mu" ?ム) + ("&Me" ?メ) + ("&Mo" ?モ) + ("&YA" ?ャ) + ("&Ya" ?ヤ) + ("&YU" ?ュ) + ("&Yu" ?ユ) + ("&YO" ?ョ) + ("&Yo" ?ヨ) + ("&Ra" ?ラ) + ("&Ri" ?リ) + ("&Ru" ?ル) + ("&Re" ?レ) + ("&Ro" ?ロ) + ("&WA" ?ヮ) + ("&Wa" ?ワ) + ("&Wi" ?ヰ) + ("&We" ?ヱ) + ("&Wo" ?ヲ) + ("&N6" ?ン) + ("&Vu" ?ヴ) + ("&KA" ?ヵ) + ("&KE" ?ヶ) + ("&Va" ?ヷ) + ("&Vi" ?ヸ) + ("&Ve" ?ヹ) + ("&Vo" ?ヺ) + ("&.6" ?・) + ("&-6" ?ー) + ("&*6" ?ヽ) + ("&+6" ?ヾ) + ("&b4" ?ㄅ) + ("&p4" ?ㄆ) + ("&m4" ?ㄇ) + ("&f4" ?ㄈ) + ("&d4" ?ㄉ) + ("&t4" ?ㄊ) + ("&n4" ?ㄋ) + ("&l4" ?ㄌ) + ("&g4" ?ㄍ) + ("&k4" ?ㄎ) + ("&h4" ?ㄏ) + ("&j4" ?ㄐ) + ("&q4" ?ㄑ) + ("&x4" ?ㄒ) + ("&zh" ?ㄓ) + ("&ch" ?ㄔ) + ("&sh" ?ㄕ) + ("&r4" ?ㄖ) + ("&z4" ?ㄗ) + ("&c4" ?ㄘ) + ("&s4" ?ㄙ) + ("&a4" ?ㄚ) + ("&o4" ?ㄛ) + ("&e4" ?ㄜ) + ("&eh4" ?ㄝ) + ("&ai" ?ㄞ) + ("&ei" ?ㄟ) + ("&au" ?ㄠ) + ("&ou" ?ㄡ) + ("&an" ?ㄢ) + ("&en" ?ㄣ) + ("&aN" ?ㄤ) + ("&eN" ?ㄥ) + ("&er" ?ㄦ) + ("&i4" ?ㄧ) + ("&u4" ?ㄨ) + ("&iu" ?ㄩ) + ("&v4" ?ㄪ) + ("&nG" ?ㄫ) + ("&gn" ?ㄬ) + ("&1c" ?㈠) + ("&2c" ?㈡) + ("&3c" ?㈢) + ("&4c" ?㈣) + ("&5c" ?㈤) + ("&6c" ?㈥) + ("&7c" ?㈦) + ("&8c" ?㈧) + ("&9c" ?㈨) + ("&10c" ?㈩) + ("&KSC" ?㉿) + ("&am" ?㏂) + ("&pm" ?㏘) + ("&\"3" ?) + ("&\"1" ?) + ("&\"!" ?) + ("&\"'" ?) + ("&\">" ?) + ("&\"?" ?) + ("&\"-" ?) + ("&\"(" ?) + ("&\"." ?) + ("&\":" ?) + ("&\"0" ?) + ("&\"," ?) + ("&\"_" ?) + ("&\"\"" ?) + ("&\";" ?) + ("&\"<" ?) + ("&\"=" ?) + ("&\"/" ?) + ("&\"p" ?) + ("&\"d" ?) + ("&\"i" ?) + ("&+_" ?) + ("&a+:" ?) + ("&Tel" ?) + ("&UA" ?) + ("&UB" ?) + ("&t3" ?) + ("&m3" ?) + ("&k3" ?) + ("&p3" ?) + ("&Mc" ?) + ("&Fl" ?) + ("&Ss" ?) + ("&Ch" ?) + ("&CH" ?) + ("&__" ?) + ("&/c" ?) + ("&ff" ?ff) + ("&fi" ?fi) + ("&fl" ?fl) + ("&ffi" ?ffi) + ("&ffl" ?ffl) + ("&St" ?ſt) + ("&st" ?st) + ("&3+;" ?ﹽ) + ("&aM." ?ﺂ) + ("&aH." ?ﺄ) + ("&ah." ?ﺈ) + ("&a+-" ?ﺍ) + ("&a+." ?ﺎ) + ("&b+-" ?ﺏ) + ("&b+." ?ﺐ) + ("&b+," ?ﺑ) + ("&b+;" ?ﺒ) + ("&tm-" ?ﺓ) + ("&tm." ?ﺔ) + ("&t+-" ?ﺕ) + ("&t+." ?ﺖ) + ("&t+," ?ﺗ) + ("&t+;" ?ﺘ) + ("&tk-" ?ﺙ) + ("&tk." ?ﺚ) + ("&tk," ?ﺛ) + ("&tk;" ?ﺜ) + ("&g+-" ?ﺝ) + ("&g+." ?ﺞ) + ("&g+," ?ﺟ) + ("&g+;" ?ﺠ) + ("&hk-" ?ﺡ) + ("&hk." ?ﺢ) + ("&hk," ?ﺣ) + ("&hk;" ?ﺤ) + ("&x+-" ?ﺥ) + ("&x+." ?ﺦ) + ("&x+," ?ﺧ) + ("&x+;" ?ﺨ) + ("&d+-" ?ﺩ) + ("&d+." ?ﺪ) + ("&dk-" ?ﺫ) + ("&dk." ?ﺬ) + ("&r+-" ?ﺭ) + ("&r+." ?ﺮ) + ("&z+-" ?ﺯ) + ("&z+." ?ﺰ) + ("&s+-" ?ﺱ) + ("&s+." ?ﺲ) + ("&s+," ?ﺳ) + ("&s+;" ?ﺴ) + ("&sn-" ?ﺵ) + ("&sn." ?ﺶ) + ("&sn," ?ﺷ) + ("&sn;" ?ﺸ) + ("&c+-" ?ﺹ) + ("&c+." ?ﺺ) + ("&c+," ?ﺻ) + ("&c+;" ?ﺼ) + ("&dd-" ?ﺽ) + ("&dd." ?ﺾ) + ("&dd," ?ﺿ) + ("ⅆ" ?ﻀ) + ("&tj-" ?ﻁ) + ("&tj." ?ﻂ) + ("&tj," ?ﻃ) + ("&tj;" ?ﻄ) + ("&zH-" ?ﻅ) + ("&zH." ?ﻆ) + ("&zH," ?ﻇ) + ("&zH;" ?ﻈ) + ("&e+-" ?ﻉ) + ("&e+." ?ﻊ) + ("&e+," ?ﻋ) + ("&e+;" ?ﻌ) + ("&i+-" ?ﻍ) + ("&i+." ?ﻎ) + ("&i+," ?ﻏ) + ("&i+;" ?ﻐ) + ("&f+-" ?ﻑ) + ("&f+." ?ﻒ) + ("&f+," ?ﻓ) + ("&f+;" ?ﻔ) + ("&q+-" ?ﻕ) + ("&q+." ?ﻖ) + ("&q+," ?ﻗ) + ("&q+;" ?ﻘ) + ("&k+-" ?ﻙ) + ("&k+." ?ﻚ) + ("&k+," ?ﻛ) + ("&k+;" ?ﻜ) + ("&l+-" ?ﻝ) + ("&l+." ?ﻞ) + ("&l+," ?ﻟ) + ("&l+;" ?ﻠ) + ("&m+-" ?ﻡ) + ("&m+." ?ﻢ) + ("&m+," ?ﻣ) + ("&m+;" ?ﻤ) + ("&n+-" ?ﻥ) + ("&n+." ?ﻦ) + ("&n+," ?ﻧ) + ("&n+;" ?ﻨ) + ("&h+-" ?ﻩ) + ("&h+." ?ﻪ) + ("&h+," ?ﻫ) + ("&h+;" ?ﻬ) + ("&w+-" ?ﻭ) + ("&w+." ?ﻮ) + ("&j+-" ?ﻯ) + ("&j+." ?ﻰ) + ("&y+-" ?ﻱ) + ("&y+." ?ﻲ) + ("&y+," ?ﻳ) + ("&y+;" ?ﻴ) + ("&lM-" ?ﻵ) + ("&lM." ?ﻶ) + ("&lH-" ?ﻷ) + ("&lH." ?ﻸ) + ("&lh-" ?ﻹ) + ("&lh." ?ﻺ) + ("&la-" ?ﻻ) + ("&la." ?ﻼ) ) (provide 'rfc1345) diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el index 4294fd7613b..e00f03fa1f6 100644 --- a/lisp/leim/quail/slovak.el +++ b/lisp/leim/quail/slovak.el @@ -151,18 +151,7 @@ ("+7" ?&) ("+8" ?*) ("+9" ?\() - ("+0" ?\)) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("+0" ?\))) (quail-define-package @@ -245,18 +234,7 @@ All other keys are the same as on standard US keyboard." ("[[[U" ?Ü) ("[Y" ?Ý) ("[Z" ?Ž) - ("[[Z" ?Ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("[[Z" ?Ž)) (quail-define-package @@ -347,18 +325,7 @@ All other keys are the same as on standard US keyboard." ("+U" ?Ů) ("+=U" ?Ü) ("=Y" ?Ý) - ("+Z" ?Ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("+Z" ?Ž)) (quail-define-package @@ -463,17 +430,6 @@ All other keys are the same as on standard US keyboard." ("[Y" ?Ý) ("[Z" ?Ž) ("[[Z" ?Ž) - ("]Z" ?Ž) - ([kp-1] ?1) - ([kp-2] ?2) - ([kp-3] ?3) - ([kp-4] ?4) - ([kp-5] ?5) - ([kp-6] ?6) - ([kp-7] ?7) - ([kp-8] ?8) - ([kp-9] ?9) - ([kp-0] ?0) - ([kp-add] ?+)) + ("]Z" ?Ž)) ;;; slovak.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index 5f29c01c77e..5c16464282b 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -47,6 +47,13 @@ ;;; Code: +;; This is used in xdisp.c to determine when bidi reordering is safe. +;; (It starts non-nil in temacs, but we set it non-nil here anyway, in +;; case someone loads loadup one more time.) We reset it after +;; successfully loading charprop.el, which defines the Unicode tables +;; bidi.c needs for its job. +(setq redisplay--inhibit-bidi t) + ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". @@ -71,10 +78,6 @@ (expand-file-name "textmodes" dir) (expand-file-name "vc" dir))))) -;; Prevent build-time PATH getting stored in the binary. -;; Mainly cosmetic, but helpful for Guix. (Bug#20330) -(setq exec-path nil) - (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. (setq purify-flag (make-hash-table :test 'equal :size 80000))) @@ -114,6 +117,10 @@ (load "format") (load "bindings") (load "window") ; Needed here for `replace-buffer-in-windows'. +;; We are now capable of resizing the mini-windows, so give the +;; variable its advertised default value (it starts as nil, see +;; xdisp.c). +(setq resize-mini-windows 'grow-only) (setq load-source-file-function 'load-with-code-conversion) (load "files") @@ -150,6 +157,12 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) +(let ((new (make-hash-table :test 'equal))) + ;; Now that loaddefs has populated definition-prefixes, purify its contents. + (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) + definition-prefixes) + (setq definition-prefixes new)) + (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "minibuffer") ;After loaddefs, for define-minor-mode. @@ -167,7 +180,8 @@ (load "case-table") ;; This file doesn't exist when building a development version of Emacs ;; from the repository. It is generated just after temacs is built. -(load "international/charprop.el" t) +(if (load "international/charprop.el" t) + (setq redisplay--inhibit-bidi nil)) (load "international/characters") (load "composite") @@ -413,6 +427,12 @@ lost after dumping"))) (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others" strings vectors conses bytecodes others))) +;; Prevent build-time PATH getting stored in the binary. +;; Mainly cosmetic, but helpful for Guix. (Bug#20330) +;; Do this here, rather than earlier, so that the above code +;; can invoke Git commands and the like. +(setq exec-path nil) + ;; Avoid error if user loads some more libraries now and make sure the ;; hash-consing hash table is GC'd. (setq purify-flag nil) @@ -420,6 +440,9 @@ lost after dumping"))) (if (null (garbage-collect)) (setq pure-space-overflow t)) +;; Make sure we will attempt bidi reordering henceforth. +(setq redisplay--inhibit-bidi nil) + (if (member (car (last command-line-args)) '("dump" "bootstrap")) (progn (message "Dumping under the name emacs") diff --git a/lisp/lpr.el b/lisp/lpr.el index 2fe32c7d5e7..d09f7791a93 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -42,7 +42,7 @@ (defgroup lpr nil "Print Emacs buffer on line printer." - :group 'wp) + :group 'text) ;;;###autoload diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 11cbea0b373..8395622546d 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -75,7 +75,7 @@ ((memq system-type '(hpux usg-unix-v berkeley-unix)) 'UNIX)) ; very similar to GNU ;; Anything else defaults to nil, meaning GNU. - "Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX. + "Platform to emulate: GNU (default), macOS, MS-Windows, UNIX. Corresponding value is one of: nil, `MacOS', `MS-Windows', `UNIX'. Set this to your preferred value; it need not match the actual platform you are using. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index ce3c50bce2b..650fbfa13d2 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -72,7 +72,7 @@ (defvar message-strip-special-text-properties) (defun report-emacs-bug-can-use-osx-open () - "Return non-nil if the OS X \"open\" command is available for mailing." + "Return non-nil if the macOS \"open\" command is available for mailing." (and (featurep 'ns) (equal (executable-find "open") "/usr/bin/open") (memq system-type '(darwin)))) @@ -107,7 +107,7 @@ This requires you to be running either Gnome, KDE, or Xfce4." (defun report-emacs-bug-insert-to-mailer () "Send the message to your preferred mail client. -This requires either the OS X \"open\" command, or the freedesktop +This requires either the macOS \"open\" command, or the freedesktop \"xdg-email\" command to be available." (interactive) (save-excursion @@ -242,7 +242,7 @@ usually do not have translators for other languages.\n\n"))) (let ((txt (delete-and-extract-region (1+ user-point) (point)))) (insert (propertize "\n" 'display txt))) - (insert "\n\nIn " (emacs-version)) + (insert "\nIn " (emacs-version)) (if emacs-build-system (insert " built on " emacs-build-system)) (insert "\n") @@ -263,6 +263,18 @@ usually do not have translators for other languages.\n\n"))) (buffer-string))))) (if (stringp lsb) (insert "System " lsb "\n"))) + (let ((message-buf (get-buffer "*Messages*"))) + (if message-buf + (let (beg-pos + (end-pos message-end-point)) + (with-current-buffer message-buf + (goto-char end-pos) + (forward-line -10) + (setq beg-pos (point))) + (terpri (current-buffer) t) + (insert "Recent messages:\n") + (insert-buffer-substring message-buf beg-pos end-pos)))) + (insert "\n") (when (and system-configuration-options (not (equal system-configuration-options ""))) (insert "Configured using:\n 'configure " @@ -295,20 +307,6 @@ usually do not have translators for other languages.\n\n"))) (and (boundp mode) (buffer-local-value mode from-buffer) (insert (format " %s: %s\n" mode (buffer-local-value mode from-buffer))))) - (let ((message-buf (get-buffer "*Messages*"))) - (if message-buf - (let (beg-pos - (end-pos message-end-point)) - (with-current-buffer message-buf - (goto-char end-pos) - (forward-line -10) - (setq beg-pos (point))) - (insert "\nRecent messages:\n") - (insert-buffer-substring message-buf beg-pos end-pos)))) - ;; After Recent messages, to avoid the messages produced by - ;; list-load-path-shadows. - (unless (looking-back "\n" (1- (point))) - (insert "\n")) (insert "\n") (insert "Load-path shadows:\n") (let* ((msg "Checking for load-path shadows...") diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index bb93cff96bc..eed664d088e 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -504,7 +504,7 @@ as-is. The filling is done after mail address alias expansion." ) -(defcustom feedmail-fill-to-cc-fill-column default-fill-column +(defcustom feedmail-fill-to-cc-fill-column (default-value 'fill-column) "Fill column used by `feedmail-fill-to-cc'." :group 'feedmail-headers :type 'integer diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 57c3be00560..a90f370d736 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -793,7 +793,7 @@ With a prefix argument ARG, enable Footnote mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Footnode mode is a buffer-local minor mode. If enabled, it +Footnote mode is a buffer-local minor mode. If enabled, it provides footnote support for `message-mode'. To get started, play around with the following keys: \\{footnote-minor-mode-map}" diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 9dc3af6ab65..89476d62292 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -234,7 +234,7 @@ we will act as though we couldn't find a full name in the address." :group 'mail-extr) (defcustom mail-extr-ignore-realname-equals-mailbox-name t -"*Whether to ignore a name that is equal to the mailbox name. +"Whether to ignore a name that is equal to the mailbox name. If true, then when the address is like \"Single <single@address.com>\" we will act as though we couldn't find a full name in the address." :type 'boolean @@ -880,7 +880,7 @@ consing a string.)" (and (not (eobp)) (eq ?w (char-syntax (char-after))) (progn - (forward-word 1) + (forward-word-strictly 1) (and (not (eobp)) (> (char-after) ?\177) (not (eq (char-after) ? ))))))))) @@ -1312,7 +1312,7 @@ consing a string.)" ) (t (setq atom-beg (point)) - (forward-word 1) + (forward-word-strictly 1) (setq atom-end (point)) (goto-char atom-beg) (save-restriction diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index ed6a74349f5..a047f5f000a 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -574,7 +574,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (let ((end (point)) (beg (with-syntax-table mail-abbrev-syntax-table (save-excursion - (backward-word 1) + (backward-word-strictly 1) (point))))) (completion-in-region beg end mail-abbrevs))) diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 4cb10e54393..e636d619c03 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -37,14 +37,19 @@ (require 'rfc2045) ;; rfc2045-encode-string (autoload 'mm-body-7-or-8 "mm-bodies") -(defvar rfc2047-header-encoding-alist +(defgroup rfc2047 nil + "RFC2047 messages." + :group 'mail + :prefix "rfc2047-") + +(defcustom rfc2047-header-encoding-alist '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\ \\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime) (t . mime)) - "*Header/encoding method alist. + "Header/encoding method alist. The list is traversed sequentially. The keys can either be header regexps or t. @@ -56,7 +61,12 @@ The values can be: fields (where quoted strings and comments must be treated separately); 4) a charset, in which case it will be encoded as that charset; 5) `default', in which case the field will be encoded as the rest - of the article.") + of the article." + :type '(alist :key-type (choice regexp (const t)) + :value-type (choice (const nil) (const mime) + (const address-mime) + coding-system + (const default)))) (defvar rfc2047-charset-encoding-alist '((us-ascii . nil) @@ -97,8 +107,9 @@ quoted-printable and base64 respectively.") (defvar rfc2047-encode-encoded-words t "Whether encoded words should be encoded again.") -(defvar rfc2047-allow-irregular-q-encoded-words t - "*Whether to decode irregular Q-encoded words.") +(defcustom rfc2047-allow-irregular-q-encoded-words t + "Whether to decode irregular Q-encoded words." + :type 'boolean) (eval-and-compile ;; Necessary to hard code them in `rfc2047-decode-region'. (defconst rfc2047-encoded-word-regexp @@ -864,14 +875,15 @@ is the standard but many mailers don't support it." (defvar rfc2047-quote-decoded-words-containing-tspecials nil "If non-nil, quote decoded words containing special characters.") -(defvar rfc2047-allow-incomplete-encoded-text t - "*Non-nil means allow incomplete encoded-text in successive encoded-words. +(defcustom rfc2047-allow-incomplete-encoded-text t + "Non-nil means allow incomplete encoded-text in successive encoded-words. Dividing of encoded-text in the place other than character boundaries violates RFC2047 section 5, while we have a capability to decode it. If it is non-nil, the decoder will decode B- or Q-encoding in each encoded-word, concatenate them, and decode it by charset. Otherwise, the decoder will fully decode each encoded-word before concatenating -them.") +them." + :type 'boolean) (defun rfc2047-strip-backslashes-in-quoted-strings () "Strip backslashes in quoted strings. `\\\"' remains." diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 29926108c15..e9882253c70 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1818,9 +1818,21 @@ not be a new one). It returns non-nil if it got any new messages." ;; Read in the contents of the inbox files, renaming them as ;; necessary, and adding to the list of files to delete ;; eventually. - (if file-name - (rmail-insert-inbox-text files nil) - (setq delete-files (rmail-insert-inbox-text files t))) + (unwind-protect + (progn + ;; Set modified now to lock the file, so that we don't + ;; encounter locking problems later in the middle of + ;; reading the mail. + (set-buffer-modified-p t) + (if file-name + (rmail-insert-inbox-text files nil) + (setq delete-files (rmail-insert-inbox-text files t)))) + ;; If there was no new mail, or we aborted before actually + ;; trying to get any, mark buffer unmodified. Otherwise the + ;; buffer is correctly marked modified and the file locked + ;; until we save out the new mail. + (if (= (point-min) (point-max)) + (set-buffer-modified-p nil))) ;; Scan the new text and convert each message to ;; Rmail/mbox format. (goto-char (point-min)) @@ -1969,11 +1981,6 @@ Value is the size of the newly read mail after conversion." size)) (defun rmail-insert-inbox-text (files renamep) - ;; Detect a locked file now, so that we avoid moving mail - ;; out of the real inbox file. (That could scare people.) - (or (memq (file-locked-p buffer-file-name) '(nil t)) - (error "RMAIL file %s is locked" - (file-name-nondirectory buffer-file-name))) (let (file tofile delete-files popmail got-password password) (while files ;; Handle remote mailbox names specially; don't expand as filenames @@ -4089,7 +4096,7 @@ typically for purposes of moderating a list." (set-syntax-table mail-abbrev-syntax-table) (goto-char before) (while (and (< (point) end) - (progn (forward-word 1) + (progn (forward-word-strictly 1) (<= (point) end))) (expand-abbrev)) (set-syntax-table old-syntax-table)) @@ -4585,6 +4592,8 @@ Argument MIME is non-nil if this is a mime message." (list armor-start (- (point-max) after-end) mime armor-end-regexp))) +(declare-function rmail-mime-entity-truncated "rmailmm" (entity)) + ;; Should this have a key-binding, or be in a menu? ;; There doesn't really seem to be an appropriate menu. ;; Eg the edit command is not in a menu either. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 5ab5bd9a2cd..3d222090ca6 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1110,10 +1110,11 @@ to combine them into one, and does so if the user says y." (save-restriction ;; This is just so the screen doesn't change. (narrow-to-region (point-min) old-max) - (goto-char old-point) - (setq query-asked t) - (if (y-or-n-p (format "Message contains multiple %s fields. Combine? " field)) - (setq query-answer t)))) + (save-excursion + (goto-char old-point) + (setq query-asked t) + (if (y-or-n-p (format "Message contains multiple %s fields. Combine? " field)) + (setq query-answer t))))) (when query-answer (let ((this-to-start (line-beginning-position)) this-to-end @@ -1404,7 +1405,7 @@ just append to the file, in Babyl format if necessary." (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") ;; Insert the time zone before the year. (forward-char -1) - (forward-word -1) + (forward-word-strictly -1) (require 'mail-utils) (insert (mail-rfc822-time-zone time) " ") (goto-char (point-max)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 8e0bb3ae6ba..f21b847b49b 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -858,8 +858,6 @@ Returns an error if the server cannot be contacted." ;; Send the contents. (smtpmail-command-or-throw process "DATA") (smtpmail-send-data process smtpmail-text-buffer) - ;; DATA end "." - (smtpmail-command-or-throw process ".") ;; Return success. nil)) (when (and process @@ -957,10 +955,11 @@ Returns an error if the server cannot be contacted." (process-send-string process "\r\n")) (defun smtpmail-send-data (process buffer) - (let ((data-continue t) sending-data + (let ((data-continue t) (pr (with-current-buffer buffer (make-progress-reporter "Sending email " - (point-min) (point-max))))) + (point-min) (point-max)))) + sending-data) (with-current-buffer buffer (goto-char (point-min))) (while data-continue @@ -970,6 +969,8 @@ Returns an error if the server cannot be contacted." (end-of-line 2) (setq data-continue (not (eobp)))) (smtpmail-send-data-1 process sending-data)) + ;; DATA end "." + (smtpmail-command-or-throw process ".") (progress-reporter-done pr))) (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 3d4ccf90e1b..b38b16f699d 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -302,6 +302,9 @@ during the initial citing via `sc-cite-original'." "Hook which gets run once after Supercite loads." :type 'hook :group 'supercite-hooks) +(make-obsolete-variable 'sc-load-hook + "use `with-eval-after-load' instead." "26.1") + (defcustom sc-pre-hook nil "Hook which gets run before each invocation of `sc-cite-original'." :type 'hook diff --git a/lisp/man.el b/lisp/man.el index b483dd12e8a..a140e03d74a 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,4 +1,4 @@ -;;; man.el --- browse UNIX manual pages +;;; man.el --- browse UNIX manual pages -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 1996-1997, 2001-2016 Free Software ;; Foundation, Inc. @@ -308,7 +308,7 @@ This regular expression should start with a `^' character.") (defvar Man-reference-regexp (concat "\\(" Man-name-regexp - "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\(" + "\\(‐?\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\(" Man-section-regexp "\\))") "Regular expression describing a reference to another manpage.") @@ -432,29 +432,23 @@ Otherwise, the value is whatever the function (defvar Man-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) - (set-keymap-parent map button-buffer-map) + (set-keymap-parent map + (make-composed-keymap button-buffer-map special-mode-map)) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map " " 'scroll-up-command) - (define-key map "\177" 'scroll-down-command) (define-key map "n" 'Man-next-section) (define-key map "p" 'Man-previous-section) (define-key map "\en" 'Man-next-manpage) (define-key map "\ep" 'Man-previous-manpage) - (define-key map ">" 'end-of-buffer) - (define-key map "<" 'beginning-of-buffer) (define-key map "." 'beginning-of-buffer) (define-key map "r" 'Man-follow-manual-reference) (define-key map "g" 'Man-goto-section) (define-key map "s" 'Man-goto-see-also-section) (define-key map "k" 'Man-kill) - (define-key map "q" 'Man-quit) (define-key map "u" 'Man-update-manpage) (define-key map "m" 'man) ;; Not all the man references get buttons currently. The text in the ;; manual page can contain references to other man pages (define-key map "\r" 'man-follow) - (define-key map "?" 'describe-mode) (easy-menu-define nil map "`Man-mode' menu." @@ -476,7 +470,7 @@ Otherwise, the value is whatever the function "--" ["Man..." man t] ["Kill Buffer" Man-kill t] - ["Quit" Man-quit t])) + ["Quit" quit-window t])) map) "Keymap for Man mode.") @@ -619,7 +613,7 @@ This is necessary if one wants to dump man.el with Emacs." ;; `call-process' below sends it to /dev/null, ;; so we don't need `2>' even with DOS shells ;; which do support stderr redirection. - ((not (fboundp 'start-process)) " %s") + ((not (fboundp 'make-process)) " %s") ((concat " %s 2>" null-device))))) (flist Man-filter-list)) (while (and flist (car flist)) @@ -779,7 +773,7 @@ POS defaults to `point'." ;; see this- ;; command-here(1) ;; Note: This code gets executed iff our entry is after POS. - (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") + (when (looking-at "‐?[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") (setq word (concat word (match-string-no-properties 1))) ;; Make sure the section number gets included by the code below. (goto-char (match-end 1))) @@ -887,7 +881,7 @@ test/automated/man-tests.el in the emacs repository." (setq default-directory "/") ;; in case inherited doesn't exist ;; Actually for my `man' the arg is a regexp. ;; POSIX says it must be ERE and "man-db" seems to agree, - ;; whereas under MacOSX it seems to be BRE-style and doesn't + ;; whereas under macOS it seems to be BRE-style and doesn't ;; accept backslashes at all. Let's not bother to ;; quote anything. (let ((process-environment (copy-sequence process-environment))) @@ -964,7 +958,7 @@ otherwise look like a page name. An \"apropos\" query with -k gives a buffer of matching page names or descriptions. The pattern argument is usually an -\"egrep\" style regexp. +\"grep -E\" style regexp. -k pattern" @@ -1080,7 +1074,7 @@ Return the buffer in which the manpage will appear." "[cleaning...]") 'face 'mode-line-emphasis))) (Man-start-calling - (if (fboundp 'start-process) + (if (fboundp 'make-process) (let ((proc (start-process manual-program buffer (if (memq system-type '(cygwin windows-nt)) @@ -1430,8 +1424,17 @@ manpage command." (quit-restore-window (get-buffer-window (current-buffer) t) 'kill) (kill-buffer (current-buffer))) - (message "Can't find the %s manpage" - (Man-page-from-arguments args))) + ;; Entries hyphenated due to the window's width + ;; won't be found in the man database, so remove + ;; the hyphenation -- assuming Groff hyphenates + ;; either with hyphen-minus (ASCII 45, #x2d), + ;; hyphen (#x2010) or soft hyphen (#xad) -- and + ;; look again. + (if (string-match "[-‐]" args) + (let ((str (replace-match "" nil nil args))) + (Man-getpage-in-background str)) + (message "Can't find the %s manpage" + (Man-page-from-arguments args)))) (if Man-fontify-manpage-flag (message "%s man page formatted" @@ -1465,9 +1468,7 @@ manpage command." (defvar bookmark-make-record-function) -(put 'Man-mode 'mode-class 'special) - -(define-derived-mode Man-mode fundamental-mode "Man" +(define-derived-mode Man-mode special-mode "Man" "A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try @@ -1481,7 +1482,7 @@ The following man commands are available in the buffer. Try \\[Man-previous-section] Jump to previous manpage section. \\[Man-goto-section] Go to a manpage section. \\[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section. -\\[Man-quit] Deletes the manpage window, bury its buffer. +\\[quit-window] Deletes the manpage window, bury its buffer. \\[Man-kill] Deletes the manpage window, kill its buffer. \\[describe-mode] Prints this help text. @@ -1508,8 +1509,7 @@ The following key bindings are currently in effect in the buffer: mode-line-buffer-identification (list (default-value 'mode-line-buffer-identification) " {" 'Man-page-mode-string "}") - truncate-lines t - buffer-read-only t) + truncate-lines t) (buffer-disable-undo) (auto-fill-mode -1) (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) @@ -1785,11 +1785,6 @@ Specify which REFERENCE to use; default is based on word at point." (interactive) (quit-window t)) -(defun Man-quit () - "Bury the buffer containing the manpage." - (interactive) - (quit-window)) - (defun Man-goto-page (page &optional noerror) "Go to the manual page on page PAGE." (interactive diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index cc7233e193f..d21fa2cd61c 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -541,7 +541,9 @@ (yank))) (defun clipboard-kill-ring-save (beg end &optional region) - "Copy region to kill ring, and save in the GUI's clipboard." + "Copy region to kill ring, and save in the GUI's clipboard. +If the optional argument REGION is non-nil, the function ignores +BEG and END, and saves the current region instead." (interactive "r\np") (let ((gui-select-enable-clipboard t) (interprogram-cut-function (or interprogram-cut-function @@ -549,7 +551,9 @@ (kill-ring-save beg end region))) (defun clipboard-kill-region (beg end &optional region) - "Kill the region, and save it in the GUI's clipboard." + "Kill the region, and save it in the GUI's clipboard. +If the optional argument REGION is non-nil, the function ignores +BEG and END, and kills the current region instead." (interactive "r\np") (let ((gui-select-enable-clipboard t) (interprogram-cut-function (or interprogram-cut-function @@ -985,49 +989,43 @@ The selected font will be the default on both the existing and future frames." (customize-set-variable 'horizontal-scroll-bar-mode nil)) (defvar menu-bar-showhide-scroll-bar-menu - (let ((menu (make-sparse-keymap "Scroll-bar"))) + (let ((menu (make-sparse-keymap "Scroll-bar")) + (vsb (frame-parameter nil 'vertical-scroll-bars)) + (hsb (frame-parameter nil 'horizontal-scroll-bars))) (bindings--define-key menu [horizontal] - '(menu-item "Horizontal" + `(menu-item "Horizontal" menu-bar-horizontal-scroll-bar :help "Horizontal scroll bar" :visible (horizontal-scroll-bars-available-p) - :button (:radio . (cdr (assq 'horizontal-scroll-bars - (frame-parameters)))))) + :button (:radio . ,hsb))) (bindings--define-key menu [none-horizontal] - '(menu-item "None-horizontal" + `(menu-item "None-horizontal" menu-bar-no-horizontal-scroll-bar :help "Turn off horizontal scroll bars" :visible (horizontal-scroll-bars-available-p) - :button (:radio . (not (cdr (assq 'horizontal-scroll-bars - (frame-parameters))))))) + :button (:radio . (not ,hsb)))) (bindings--define-key menu [right] - '(menu-item "On the Right" + `(menu-item "On the Right" menu-bar-right-scroll-bar :help "Scroll-bar on the right side" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - 'right)))) + :button (:radio . (eq ,vsb 'right)))) (bindings--define-key menu [left] - '(menu-item "On the Left" + `(menu-item "On the Left" menu-bar-left-scroll-bar :help "Scroll-bar on the left side" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - 'left)))) + :button (:radio . (eq ,vsb 'left)))) (bindings--define-key menu [none] - '(menu-item "None" + `(menu-item "None" menu-bar-no-scroll-bar :help "Turn off scroll-bar" :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) - nil)))) + :button (:radio . (not ,vsb)))) menu)) (defun menu-bar-frame-for-menubar () @@ -1259,7 +1257,7 @@ mail status in mode line")) (defvar menu-bar-search-options-menu (let ((menu (make-sparse-keymap "Search Options"))) - (dolist (x '((character-fold-to-regexp "Fold Characters" "Character folding") + (dolist (x '((char-fold-to-regexp "Fold Characters" "Character folding") (isearch-symbol-regexp "Whole Symbols" "Whole symbol") (word-search-regexp "Whole Words" "Whole word"))) (bindings--define-key menu (vector (nth 0 x)) @@ -1583,7 +1581,7 @@ mail status in mode line")) (bindings--define-key menu [browse-web] '(menu-item "Browse the Web..." browse-web)) (bindings--define-key menu [directory-search] - '(menu-item "Directory Search" eudc-tools-menu)) + '(menu-item "Directory Servers" eudc-tools-menu)) (bindings--define-key menu [compose-mail] '(menu-item "Compose New Mail" compose-mail :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) @@ -1867,7 +1865,7 @@ key, a click, or a menu-item")) '(menu-item "Emacs Tutorial" help-with-tutorial :help "Learn how to use Emacs")) - ;; In OS X it's in the app menu already. + ;; In macOS it's in the app menu already. ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. (and (featurep 'ns) (not (eq system-type 'darwin)) diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 7f29f598b64..7dde7437914 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -306,7 +306,7 @@ arguments were put in a single string (closes SF #1122655). (mh-edit-pick-expr): Use it. - * mh-unit.el (mh-unit): Since 21.4 snuck out but didn't contain + * mh-unit.el (mh-unit): Since 21.4 sneaked out but didn't contain updated lm-verify, don't run lm-verify on versions before 21.5. (mh-unit-test-pick-args-list): Added. diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 1940234bc3b..968c33cb4de 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -48,16 +48,18 @@ (define-key map " " 'self-insert-command) map)) -(defvar mh-alias-system-aliases +(defcustom mh-alias-system-aliases '("/etc/nmh/MailAliases" "/etc/mh/MailAliases" "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases" "/etc/passwd") - "*A list of system files which are a source of aliases. + "A list of system files which are a source of aliases. If these files are modified, they are automatically reread. This list need include only system aliases and the passwd file, since personal alias files listed in your \"Aliasfile:\" MH profile component are automatically included. You can update the alias list manually using -\\[mh-alias-reload].") +\\[mh-alias-reload]." + :type '(repeat file) + :group 'mh-alias) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 10a8b6e219c..21ff5cb2cb8 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -75,11 +75,24 @@ introduced in Emacs 22." 'cancel-timer 'delete-itimer)) -;; Emacs 24 renamed flet to cl-flet. -(defalias 'mh-cl-flet - (if (fboundp 'cl-flet) - 'cl-flet - 'flet)) +;; Emacs 24 made flet obsolete and suggested either cl-flet or +;; cl-letf. This macro is based upon gmm-flet from Gnus. +(defmacro mh-flet (bindings &rest body) + "Make temporary overriding function definitions. +This is an analogue of a dynamically scoped `let' that operates on +the function cell of FUNCs rather than their value cell. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + (if (fboundp 'cl-letf) + `(cl-letf ,(mapcar (lambda (binding) + `((symbol-function ',(car binding)) + (lambda ,@(cdr binding)))) + bindings) + ,@body) + `(flet ,bindings ,@body))) +(put 'mh-flet 'lisp-indent-function 1) +(put 'mh-flet 'edebug-form-spec + '((&rest (sexp sexp &rest form)) &rest form)) (defun mh-display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 20029f8e0b5..12c674d08f1 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -317,8 +317,8 @@ This list will always include the current folder `mh-current-folder'. This variable can be used by `mh-after-commands-processed-hook'.") -(defvar mh-mail-header-separator "--------" - "*Line used by MH to separate headers from text in messages being composed. +(defcustom mh-mail-header-separator "--------" + "Line used by MH to separate headers from text in messages being composed. This variable should not be used directly in programs. Programs should use `mail-header-separator' instead. @@ -328,7 +328,9 @@ contexts, you may have to perform this initialization yourself. Do not make this a regular expression as it may be the argument to `insert' and it is passed through `regexp-quote' before being -used by functions like `re-search-forward'.") +used by functions like `re-search-forward'." + :group 'mh-e ; FIXME? + :type 'string) (defvar mh-sent-from-folder nil "Folder of msg assoc with this letter.") @@ -385,11 +387,12 @@ This is the original map that is stored when the folder is narrowed.") (make-variable-buffer-local 'mh-thread-scan-line-map-stack) -(defvar mh-x-mailer-string nil - "*String containing the contents of the X-Mailer header field. +(defcustom mh-x-mailer-string nil + "String containing the contents of the X-Mailer header field. If nil, this variable is initialized to show the version of MH-E, -Emacs, and MH the first time a message is composed.") - +Emacs, and MH the first time a message is composed." + :group 'mh-e ; FIXME? + :type '(choice (const :tag "Default" nil) string)) ;;; MH-E Entry Points @@ -719,7 +722,7 @@ keyword, introduced in Emacs 22." ;;; Variant Support (defcustom-mh mh-path nil - "*Additional list of directories to search for MH. + "Additional list of directories to search for MH. See `mh-variant'." :group 'mh-e :type '(repeat (directory)) @@ -945,7 +948,7 @@ finally GNU mailutils MH." (mh-variants) " or ")))))) (defcustom-mh mh-variant 'autodetect - "*Specifies the variant used by MH-E. + "Specifies the variant used by MH-E. The default setting of this option is \"Auto-detect\" which means that MH-E will automatically choose the first of nmh, MH, or GNU @@ -1174,7 +1177,7 @@ and GNU mailutils." ;;; Aliases (:group 'mh-alias) (defcustom-mh mh-alias-completion-ignore-case-flag t - "*Non-nil means don't consider case significant in MH alias completion. + "Non-nil means don't consider case significant in MH alias completion. As MH ignores case in the aliases, so too does MH-E. However, you may turn off this option to make case significant which can be @@ -1185,7 +1188,7 @@ lowercase for mailing lists and uppercase for people." :package-version '(MH-E . "7.1")) (defcustom-mh mh-alias-expand-aliases-flag nil - "*Non-nil means to expand aliases entered in the minibuffer. + "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, @@ -1195,7 +1198,7 @@ this expansion is not performed." :package-version '(MH-E . "7.1")) (defcustom-mh mh-alias-flash-on-comma t - "*Specify whether to flash address or warn on translation. + "Specify whether to flash address or warn on translation. This option controls the behavior when a [comma] is pressed while entering aliases or addresses. The default setting flashes the @@ -1208,7 +1211,7 @@ does not display a warning if the alias is not found." :package-version '(MH-E . "7.1")) (defcustom-mh mh-alias-insert-file nil - "*Filename used to store a new MH-E alias. + "Filename used to store a new MH-E alias. The default setting of this option is \"Use Aliasfile Profile Component\". This option can also hold the name of a file or a @@ -1234,7 +1237,7 @@ or \"Bottom\" of your alias file might be more appropriate." :package-version '(MH-E . "7.1")) (defcustom-mh mh-alias-local-users t - "*Non-nil means local users are added to alias completion. + "Non-nil means local users are added to alias completion. Aliases are created from \"/etc/passwd\" entries with a user ID larger than a magical number, typically 200. This can be a handy @@ -1255,7 +1258,7 @@ NIS password file." :package-version '(MH-E . "7.1")) (defcustom-mh mh-alias-local-users-prefix "local." - "*String prefixed to the real names of users from the password file. + "String prefixed to the real names of users from the password file. This option can also be set to \"Use Login\". For example, consider the following password file entry: @@ -1277,7 +1280,7 @@ turned off." :package-version '(MH-E . "7.4")) (defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t - "*Non-nil means the gecos field in the password file uses a comma separator. + "Non-nil means the gecos field in the password file uses a comma separator. In the example in `mh-alias-local-users-prefix', commas are used to separate different values within the so-called gecos field. @@ -1333,7 +1336,7 @@ folders are treated as if they are small." :package-version '(MH-E . "7.0")) (defcustom-mh mh-recenter-summary-flag nil - "*Non-nil means to recenter the summary window. + "Non-nil means to recenter the summary window. If this option is turned on, recenter the summary window when the show window is toggled off." @@ -1342,13 +1345,13 @@ show window is toggled off." :package-version '(MH-E . "7.0")) (defcustom-mh mh-recursive-folders-flag nil - "*Non-nil means that commands which operate on folders do so recursively." + "Non-nil means that commands which operate on folders do so recursively." :type 'boolean :group 'mh-folder :package-version '(MH-E . "7.0")) (defcustom-mh mh-sortm-args nil - "*Additional arguments for \"sortm\"\\<mh-folder-mode-map>. + "Additional arguments for \"sortm\"\\<mh-folder-mode-map>. This option is consulted when a prefix argument is used with \\[mh-sort-folder]. Normally default arguments to \"sortm\" are @@ -1374,7 +1377,7 @@ the default, or an empty string to suppress the default entirely." :package-version '(MH-E . "8.0")) (defcustom-mh mh-default-folder-list nil - "*List of addresses and folders. + "List of addresses and folders. The folder name associated with the first address found in this list is used as the default for `mh-refile-msg' and similar @@ -1392,7 +1395,7 @@ for more information." :package-version '(MH-E . "7.2")) (defcustom-mh mh-default-folder-must-exist-flag t - "*Non-nil means guessed folder name must exist to be used. + "Non-nil means guessed folder name must exist to be used. If the derived folder does not exist, and this option is on, then the last folder name used is suggested. This is useful if you get @@ -1406,7 +1409,7 @@ for more information." :package-version '(MH-E . "7.2")) (defcustom-mh mh-default-folder-prefix "" - "*Prefix used for folder names generated from aliases. + "Prefix used for folder names generated from aliases. The prefix is used to prevent clutter in your mail directory. See `mh-prompt-for-refile-folder' and `mh-folder-from-address' @@ -1425,7 +1428,7 @@ Real definition will take effect when mh-identity is loaded." nil))) (defcustom-mh mh-identity-list nil - "*List of identities. + "List of identities. To customize this option, click on the \"INS\" button and enter a label such as \"Home\" or \"Work\". Then click on the \"INS\" button with the @@ -1555,7 +1558,7 @@ as the result is undefined." :package-version '(MH-E . "7.3")) (defcustom-mh mh-auto-fields-prompt-flag t - "*Non-nil means to prompt before sending if fields inserted. + "Non-nil means to prompt before sending if fields inserted. See `mh-auto-fields-list'." :type 'boolean :group 'mh-identity @@ -1609,7 +1612,7 @@ containing the VALUE for the field is given." ;;; Incorporating Your Mail (:group 'mh-inc) (defcustom-mh mh-inc-prog "inc" - "*Program to incorporate new mail into a folder. + "Program to incorporate new mail into a folder. This program generates a one-line summary for each of the new messages. Unless it is an absolute pathname, the file is assumed @@ -1628,7 +1631,7 @@ Real definition will take effect when mh-inc is loaded." nil))) (defcustom-mh mh-inc-spool-list nil - "*Alternate spool files. + "Alternate spool files. You can use the `mh-inc-spool-list' variable to direct MH-E to retrieve mail from arbitrary spool files other than your system @@ -1766,13 +1769,13 @@ MH-style directives are preferred." :package-version '(MH-E . "7.4")) (defcustom-mh mh-compose-space-does-completion-flag nil - "*Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header." + "Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header." :type 'boolean :group 'mh-letter :package-version '(MH-E . "7.4")) (defcustom-mh mh-delete-yanked-msg-window-flag nil - "*Non-nil means delete any window displaying the message. + "Non-nil means delete any window displaying the message. This deletes the window containing the original message after yanking it with \\<mh-letter-mode-map>\\[mh-yank-cur-msg] to make @@ -1782,7 +1785,7 @@ more room on your screen for your reply." :package-version '(MH-E . "7.0")) (defcustom-mh mh-extract-from-attribution-verb "wrote:" - "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. + "Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. The attribution consists of the sender's name and email address followed by the content of this option. This option can be set to @@ -1796,7 +1799,7 @@ followed by the content of this option. This option can be set to :package-version '(MH-E . "7.0")) (defcustom-mh mh-ins-buf-prefix "> " - "*String to put before each line of a yanked or inserted message. + "String to put before each line of a yanked or inserted message. The prefix \"> \" is the default setting of this option. I suggest that you not modify this option since it is used by many @@ -1812,7 +1815,7 @@ flavors of `mh-yank-behavior' or you have added a :package-version '(MH-E . "6.0")) (defcustom-mh mh-letter-complete-function 'ispell-complete-word - "*Function to call when completing outside of address or folder fields. + "Function to call when completing outside of address or folder fields. In the body of the message, \\<mh-letter-mode-map>\\[mh-letter-complete] runs this function, @@ -1822,7 +1825,7 @@ which is set to \"ispell-complete-word\" by default." :package-version '(MH-E . "7.1")) (defcustom-mh mh-letter-fill-column 72 - "*Fill column to use in MH Letter mode. + "Fill column to use in MH Letter mode. By default, this option is 72 to allow others to quote your message without line wrapping." @@ -1854,7 +1857,7 @@ you write!" :package-version '(MH-E . "8.0")) (defcustom-mh mh-signature-file-name "~/.signature" - "*Source of user's signature. + "Source of user's signature. By default, the text of your signature is taken from the file \"~/.signature\". You can read from other sources by changing this @@ -1877,7 +1880,7 @@ The signature is inserted into your message with the command :package-version '(MH-E . "6.0")) (defcustom-mh mh-signature-separator-flag t - "*Non-nil means a signature separator should be inserted. + "Non-nil means a signature separator should be inserted. It is not recommended that you change this option since various mail user agents, including MH-E, use the separator to present @@ -1888,7 +1891,7 @@ replying or yanking a letter into a draft." :package-version '(MH-E . "8.0")) (defcustom-mh mh-x-face-file "~/.face" - "*File containing face header field to insert in outgoing mail. + "File containing face header field to insert in outgoing mail. If the file starts with either of the strings \"X-Face:\", \"Face:\" or \"X-Image-URL:\" then the contents are added to the message header @@ -1917,7 +1920,7 @@ this option doesn't exist." :package-version '(MH-E . "7.0")) (defcustom-mh mh-yank-behavior 'attribution - "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. + "Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. To include the entire message, including the entire header, use \"Body and Header\". Use \"Body\" to yank just the body without @@ -1964,7 +1967,7 @@ inserted." ;;; Ranges (:group 'mh-ranges) (defcustom-mh mh-interpret-number-as-range-flag t - "*Non-nil means interpret a number as a range. + "Non-nil means interpret a number as a range. Since one of the most frequent ranges used is \"last:N\", MH-E will interpret input such as \"200\" as \"last:200\" if this @@ -1984,7 +1987,7 @@ Real definition, below, uses variables that aren't defined yet." (set-default symbol value)))) (defcustom-mh mh-adaptive-cmd-note-flag t - "*Non-nil means that the message number width is determined dynamically. + "Non-nil means that the message number width is determined dynamically. If you've created your own format to handle long message numbers, you'll be pleased to know you no longer need it since MH-E adapts its @@ -2052,7 +2055,7 @@ Otherwise, set SYMBOL to VALUE." (set-default symbol value))) (defcustom-mh mh-scan-prog "scan" - "*Program used to scan messages. + "Program used to scan messages. The name of the program that generates a listing of one line per message is held in this option. Unless this variable contains an @@ -2090,7 +2093,7 @@ MH-E can be found in the documentation of `mh-search'." ;;; Sending Mail (:group 'mh-sending-mail) (defcustom-mh mh-compose-forward-as-mime-flag t - "*Non-nil means that messages are forwarded as attachments. + "Non-nil means that messages are forwarded as attachments. By default, this option is on which means that the forwarded messages are included as attachments. If you would prefer to @@ -2118,13 +2121,13 @@ fields." :package-version '(MH-E . "6.0")) (defcustom-mh mh-compose-prompt-flag nil - "*Non-nil means prompt for header fields when composing a new draft." + "Non-nil means prompt for header fields when composing a new draft." :type 'boolean :group 'mh-sending-mail :package-version '(MH-E . "7.4")) (defcustom-mh mh-forward-subject-format "%s: %s" - "*Format string for forwarded message subject. + "Format string for forwarded message subject. This option is a string which includes two escapes (\"%s\"). The first \"%s\" is replaced with the sender of the original message, @@ -2134,7 +2137,7 @@ and the second one is replaced with the original \"Subject:\"." :package-version '(MH-E . "6.0")) (defcustom-mh mh-insert-x-mailer-flag t - "*Non-nil means append an \"X-Mailer:\" header field to the header. + "Non-nil means append an \"X-Mailer:\" header field to the header. This header field includes the version of MH-E and Emacs that you are using. If you don't want to participate in our marketing, you @@ -2144,7 +2147,7 @@ can turn this option off." :package-version '(MH-E . "7.0")) (defcustom-mh mh-redist-full-contents-flag nil - "*Non-nil means the \"dist\" command needs entire letter for redistribution. + "Non-nil means the \"dist\" command needs entire letter for redistribution. This option must be turned on if \"dist\" requires the whole letter for redistribution, which is the case if \"send\" is @@ -2156,7 +2159,7 @@ has been redistributed before, turn off this option." :package-version '(MH-E . "8.0")) (defcustom-mh mh-reply-default-reply-to nil - "*Sets the person or persons to whom a reply will be sent. + "Sets the person or persons to whom a reply will be sent. This option is set to \"Prompt\" by default so that you are prompted for the recipient of a reply. If you find that most of @@ -2172,7 +2175,7 @@ this option to \"cc\". Other choices include \"from\", \"to\", or :package-version '(MH-E . "6.0")) (defcustom-mh mh-reply-show-message-flag t - "*Non-nil means the MH-Show buffer is displayed when replying. + "Non-nil means the MH-Show buffer is displayed when replying. If you include the message automatically, you can hide the MH-Show buffer by turning off this option. @@ -2189,7 +2192,7 @@ See also `mh-reply'." ;; specified by setting `mh-unpropagated-sequences' appropriately." XXX (defcustom-mh mh-refile-preserves-sequences-flag t - "*Non-nil means that sequences are preserved when messages are refiled. + "Non-nil means that sequences are preserved when messages are refiled. If a message is in any sequence (except \"Previous-Sequence:\" and \"cur\") when it is refiled, then it will still be in those @@ -2212,7 +2215,7 @@ there isn't much advantage to that." :package-version '(MH-E . "7.3")) (defcustom-mh mh-update-sequences-after-mh-show-flag t - "*Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>. + "Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>. Three sequences are maintained internally by MH-E and pushed out to MH when a message is shown. They include the sequence @@ -2227,7 +2230,7 @@ commands." :package-version '(MH-E . "7.0")) (defcustom-mh mh-whitelist-preserves-sequences-flag t - "*Non-nil means that sequences are preserved when messages are whitelisted. + "Non-nil means that sequences are preserved when messages are whitelisted. If a message is in any sequence (except \"Previous-Sequence:\" and \"cur\") when it is whitelisted, then it will still be in @@ -2240,7 +2243,7 @@ not desired, then turn off this option." ;;; Reading Your Mail (:group 'mh-show) (defcustom-mh mh-bury-show-buffer-flag t - "*Non-nil means show buffer is buried. + "Non-nil means show buffer is buried. One advantage of not burying the show buffer is that one can delete the show buffer more easily in an electric buffer list @@ -2251,7 +2254,7 @@ running \\[electric-buffer-list] to see what I mean." :package-version '(MH-E . "7.0")) (defcustom-mh mh-clean-message-header-flag t - "*Non-nil means remove extraneous header fields. + "Non-nil means remove extraneous header fields. See also `mh-invisible-header-fields-default' and `mh-invisible-header-fields'." @@ -2260,7 +2263,7 @@ See also `mh-invisible-header-fields-default' and :package-version '(MH-E . "7.0")) (defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode"))) - "*Non-nil means attachments are handled\\<mh-folder-mode-map>. + "Non-nil means attachments are handled\\<mh-folder-mode-map>. MH-E can handle attachments as well if the Gnus `mm-decode' library is present. If so, this option will be on. Otherwise, @@ -2278,7 +2281,7 @@ messages and other graphical widgets. See the options :package-version '(MH-E . "7.0")) (defcustom-mh mh-display-buttons-for-alternatives-flag nil - "*Non-nil means display buttons for all alternative attachments. + "Non-nil means display buttons for all alternative attachments. Sometimes, a mail program will produce multiple alternatives of the attachment in increasing degree of faithfulness to the @@ -2290,7 +2293,7 @@ inline and buttons are shown for each of the other alternatives." :package-version '(MH-E . "7.4")) (defcustom-mh mh-display-buttons-for-inline-parts-flag nil - "*Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>. + "Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>. The sender can request that attachments should be viewed inline so that they do not really appear like an attachment at all to the @@ -2313,7 +2316,7 @@ text (including HTML) and images." :package-version '(MH-E . "7.0")) (defcustom-mh mh-do-not-confirm-flag nil - "*Non-nil means non-reversible commands do not prompt for confirmation. + "Non-nil means non-reversible commands do not prompt for confirmation. Commands such as `mh-pack-folder' prompt to confirm whether to process outstanding moves and deletes or not before continuing. @@ -2325,7 +2328,7 @@ retracted--without question." :package-version '(MH-E . "7.0")) (defcustom-mh mh-fetch-x-image-url nil - "*Control fetching of \"X-Image-URL:\" header field image. + "Control fetching of \"X-Image-URL:\" header field image. Ths option controls the fetching of the \"X-Image-URL:\" header field image with the following values: @@ -2361,7 +2364,7 @@ turned on." :package-version '(MH-E . "7.3")) (defcustom-mh mh-graphical-smileys-flag t - "*Non-nil means graphical smileys are displayed. + "Non-nil means graphical smileys are displayed. It is a long standing custom to inject body language using a cornucopia of punctuation, also known as the \"smileys\". MH-E @@ -2376,7 +2379,7 @@ turned off." :package-version '(MH-E . "7.0")) (defcustom-mh mh-graphical-emphasis-flag t - "*Non-nil means graphical emphasis is displayed. + "Non-nil means graphical emphasis is displayed. A few typesetting features are indicated in ASCII text with certain characters. If your terminal supports it, MH-E can render @@ -2815,7 +2818,7 @@ Because the function `mh-invisible-headers' uses both cannot be run until both variables have been initialized.") (defcustom-mh mh-invisible-header-fields nil - "*Additional header fields to hide. + "Additional header fields to hide. Header fields that you would like to hide that aren't listed in `mh-invisible-header-fields-default' can be added to this option @@ -2838,7 +2841,7 @@ See also `mh-clean-message-header-flag'." :package-version '(MH-E . "7.1")) (defcustom-mh mh-invisible-header-fields-default nil - "*List of hidden header fields. + "List of hidden header fields. The header fields listed in this option are hidden, although you can check off any field that you would like to see. @@ -2860,7 +2863,7 @@ update SF #1916032 (see URL :package-version '(MH-E . "8.0")) (defvar mh-invisible-header-fields-compiled nil - "*Regexp matching lines in a message header that are not to be shown. + "Regexp matching lines in a message header that are not to be shown. Do not alter this variable directly. Instead, customize `mh-invisible-header-fields-default' checking for fields normally hidden that you wish to display, and add extra entries to hide in @@ -2895,7 +2898,7 @@ removed and entries from `mh-invisible-header-fields' are added." (mh-invisible-headers) (defcustom-mh mh-lpr-command-format "lpr -J '%s'" - "*Command used to print\\<mh-folder-mode-map>. + "Command used to print\\<mh-folder-mode-map>. This option contains the Unix command line which performs the actual printing for the \\[mh-print-msg] command. The string can @@ -2912,7 +2915,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :package-version '(MH-E . "6.0")) (defcustom-mh mh-max-inline-image-height nil - "*Maximum inline image height if \"Content-Disposition:\" is not present. + "Maximum inline image height if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to tell MH-E whether to display the attachments inline or not. If @@ -2928,7 +2931,7 @@ these numbers." :package-version '(MH-E . "7.0")) (defcustom-mh mh-max-inline-image-width nil - "*Maximum inline image width if \"Content-Disposition:\" is not present. + "Maximum inline image width if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to tell MH-E whether to display the attachments inline or not. If @@ -2944,7 +2947,7 @@ these numbers." :package-version '(MH-E . "7.0")) (defcustom-mh mh-mhl-format-file nil - "*Specifies the format file to pass to the \"mhl\" program. + "Specifies the format file to pass to the \"mhl\" program. Normally MH-E takes care of displaying messages itself (rather than calling an MH program to do the work). If you'd rather have \"mhl\" @@ -2984,7 +2987,7 @@ directory's name." :package-version '(MH-E . "7.0")) (defcustom-mh mh-print-background-flag nil - "*Non-nil means messages should be printed in the background\\<mh-folder-mode-map>. + "Non-nil means messages should be printed in the background\\<mh-folder-mode-map>. Normally messages are printed in the foreground. If this is slow on your system, you may elect to turn off this option to print in the @@ -3000,7 +3003,7 @@ This option is not used by the commands \\[mh-ps-print-msg] or :package-version '(MH-E . "7.0")) (defcustom-mh mh-show-maximum-size 0 - "*Maximum size of message (in bytes) to display automatically. + "Maximum size of message (in bytes) to display automatically. This option provides an opportunity to skip over large messages which may be slow to load. The default value of 0 means that all @@ -3010,7 +3013,7 @@ message are shown regardless of size." :package-version '(MH-E . "8.0")) (defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21) - "*Non-nil means display face images in MH-show buffers. + "Non-nil means display face images in MH-show buffers. MH-E can display the content of \"Face:\", \"X-Face:\", and \"X-Image-URL:\" header fields. If any of these fields occur in the @@ -3050,7 +3053,7 @@ The option `mh-fetch-x-image-url' controls the fetching of the :package-version '(MH-E . "7.0")) (defcustom-mh mh-store-default-directory nil - "*Default directory for \\<mh-folder-mode-map>\\[mh-store-msg]. + "Default directory for \\<mh-folder-mode-map>\\[mh-store-msg]. If you would like to change the initial default directory, customize this option, change the value from \"Current\" to @@ -3062,7 +3065,7 @@ the content of these messages." :package-version '(MH-E . "6.0")) (defcustom-mh mh-summary-height nil - "*Number of lines in MH-Folder buffer (including the mode line). + "Number of lines in MH-Folder buffer (including the mode line). The default value of this option is \"Automatic\" which means that the MH-Folder buffer will maintain the same proportional @@ -3086,7 +3089,7 @@ Set to 0 to disable automatic update." ;;; Threading (:group 'mh-thread) (defcustom-mh mh-show-threads-flag nil - "*Non-nil means new folders start in threaded mode. + "Non-nil means new folders start in threaded mode. Threading large number of messages can be time consuming so this option is turned off by default. If you turn this option on, then @@ -3102,7 +3105,7 @@ threaded is less than `mh-large-folder'." ;; dynamically in mh-tool-bar.el. (defcustom-mh mh-tool-bar-search-function 'mh-search - "*Function called by the tool bar search button. + "Function called by the tool bar search button. By default, this is set to `mh-search'. You can also choose \"Other Function\" from the \"Value Menu\" and enter a function @@ -3115,7 +3118,7 @@ of your own choosing." ;; XEmacs has a couple of extra customizations... (mh-do-in-xemacs (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag - "*If non-nil, use tool bar. + "If non-nil, use tool bar. This option controls whether to show the MH-E icons at all. By default, this option is turned on if the window system supports @@ -3131,7 +3134,7 @@ won't be able to turn on this option." :package-version '(MH-E . "7.3")) (defcustom-mh mh-xemacs-tool-bar-position nil - "*Tool bar location. + "Tool bar location. This option controls the placement of the tool bar along the four edges of the frame. You can choose from one of \"Same As Default diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index df3a42ec0f7..b8d700ddf5f 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -268,7 +268,7 @@ usually reads the file \"/etc/mailcap\"." (buffer-read-only nil)) (when (string-match "^[^% \t]+$" method) (setq method (concat method " %s"))) - (mh-cl-flet + (mh-flet ((mm-handle-set-external-undisplayer (handle function) (mh-handle-set-external-undisplayer folder handle function))) @@ -525,7 +525,7 @@ parsed and then displayed." (let ((handles ()) (folder mh-show-folder-buffer) (raw-message-data (buffer-string))) - (mh-cl-flet + (mh-flet ((mm-handle-set-external-undisplayer (handle function) (mh-handle-set-external-undisplayer folder handle function))) @@ -1049,7 +1049,7 @@ attachment, the attachment is hidden." (function (get-text-property (point) 'mh-callback)) (buffer-read-only nil) (folder mh-show-folder-buffer)) - (mh-cl-flet + (mh-flet ((mm-handle-set-external-undisplayer (handle function) (mh-handle-set-external-undisplayer folder handle function))) @@ -1070,7 +1070,7 @@ to click the MIME button." (mm-inline-media-tests mh-mm-inline-media-tests) (data (get-text-property (point) 'mh-data)) (function (get-text-property (point) 'mh-callback))) - (mh-cl-flet + (mh-flet ((mm-handle-set-external-undisplayer (handle func) (mh-handle-set-external-undisplayer folder handle func))) @@ -1166,7 +1166,7 @@ this ;-)" (defun mh-display-emphasis () "Display graphical emphasis." (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) - (mh-cl-flet + (mh-flet ((article-goto-body ())) ; shadow this function to do nothing (save-excursion (goto-char (point-min)) diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 8241e6e7895..a04ca88f3c5 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -44,7 +44,7 @@ ;; want to change the column of the notations, use the `mh-set-cmd-note' ;; function. -(defvar mh-scan-format-mh +(defcustom mh-scan-format-mh (concat "%4(msg)" "%<(cur)+%| %>" @@ -58,7 +58,7 @@ "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>" "%<(zero)%17(friendly{from})%> " "%{subject}%<{body}<<%{body}%>") - "*Scan format string for MH. + "Scan format string for MH. This string is passed to the scan program via the -format argument. This format is identical to the default except that additional hints for fontification have been added to the fifth @@ -68,9 +68,11 @@ The values of the fifth column, in priority order, are: \"-\" if the message has been replied to, t if an address on the To: line matches one of the mailboxes of the current user, \"c\" if the Cc: line matches, \"b\" if the Bcc: line matches, and \"n\" if a -non-empty Newsgroups: header is present.") +non-empty Newsgroups: header is present." + :group 'mh-scan-line-formats + :type 'string) -(defvar mh-scan-format-nmh +(defcustom mh-scan-format-nmh (concat "%4(msg)" "%<(cur)+%| %>" @@ -84,7 +86,7 @@ non-empty Newsgroups: header is present.") "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>" "%<(zero)%17(decode(friendly{from}))%> " "%(decode{subject})%<{body}<<%{body}%>") - "*Scan format string for nmh. + "Scan format string for nmh. This string is passed to the scan program via the -format arg. This format is identical to the default except that additional hints for fontification have been added to the fifth @@ -94,7 +96,9 @@ The values of the fifth column, in priority order, are: \"-\" if the message has been replied to, t if an address on the To: field matches one of the mailboxes of the current user, \"c\" if the Cc: field matches, \"b\" if the Bcc: field matches, and \"n\" if a -non-empty Newsgroups: field is present.") +non-empty Newsgroups: field is present." + :group 'mh-scan-line-formats + :type 'string) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 6e607444ad8..d5a2d779b21 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1859,7 +1859,7 @@ PROC is used to convert the value to actual data." (defun mh-index-update-maps (folder &optional origin-map) "Annotate all as yet unannotated messages in FOLDER with their MD5 hash. As a side effect msg -> checksum map is updated. Optional -argument ORIGIN-MAP is a hashtable which maps each message in the +argument ORIGIN-MAP is a hash table which maps each message in the index folder to the original folder and message from whence it was copied. If present the checksum -> (origin-folder, origin-index) map is updated too." @@ -1913,7 +1913,7 @@ origin-index) map is updated too." (defun mh-index-update-single-msg (msg checksum origin-map) "Update various maps for one message. MSG is a index folder message, CHECKSUM its MD5 hash and -ORIGIN-MAP, if non-nil, a hashtable containing which maps each +ORIGIN-MAP, if non-nil, a hash table containing which maps each message in the index folder to the folder and message that it was copied from. The function updates the hash tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'. diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index afe9812eea8..26e821696a8 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -900,7 +900,7 @@ See also `mh-folder-mode'. (interactive) ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad ;; style? - (mh-cl-flet + (mh-flet ((gnus-article-add-button (&rest args) nil)) (let* ((modified (buffer-modified-p)) (gnus-article-buffer (buffer-name)) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 5135e7e88fa..2a37cfc9e42 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -89,11 +89,11 @@ (real-child-p t)) (defvar mh-thread-id-hash nil - "Hashtable used to canonicalize message identifiers.") + "Hash table used to canonicalize message identifiers.") (make-variable-buffer-local 'mh-thread-id-hash) (defvar mh-thread-subject-hash nil - "Hashtable used to canonicalize subject strings.") + "Hash table used to canonicalize subject strings.") (make-variable-buffer-local 'mh-thread-subject-hash) (defvar mh-thread-id-table nil @@ -109,11 +109,11 @@ (make-variable-buffer-local 'mh-thread-id-index-map) (defvar mh-thread-subject-container-hash nil - "Hashtable used to group messages by subject.") + "Hash table used to group messages by subject.") (make-variable-buffer-local 'mh-thread-subject-container-hash) (defvar mh-thread-duplicates nil - "Hashtable used to associate messages with the same message identifier.") + "Hash table used to associate messages with the same message identifier.") (make-variable-buffer-local 'mh-thread-duplicates) (defvar mh-thread-history () @@ -647,7 +647,7 @@ Only information about messages in MSG-LIST are added to the tree." (defun mh-thread-set-tables (folder) "Use the tables of FOLDER in current buffer." - (mh-cl-flet + (mh-flet ((mh-get-table (symbol) (with-current-buffer folder (symbol-value symbol)))) diff --git a/lisp/midnight.el b/lisp/midnight.el index 0e68eb923cd..814621fc4e3 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -53,15 +53,12 @@ the time when it is run.") "Non-nil means run `midnight-hook' at midnight." :global t :initialize #'custom-initialize-default - (if midnight-mode (timer-activate midnight-timer) - (cancel-timer midnight-timer))) - -;;; time conversion - -(defun midnight-buffer-display-time (buffer) - "Return the time-stamp of BUFFER, or current buffer, as float." - (with-current-buffer buffer - (when buffer-display-time (float-time buffer-display-time)))) + ;; Disable first, since the ':initialize' function above already + ;; starts the timer when the mode is turned on for the first time, + ;; via setting 'midnight-delay', which calls 'midnight-delay-set', + ;; which starts the timer. + (when (timerp midnight-timer) (cancel-timer midnight-timer)) + (if midnight-mode (timer-activate midnight-timer))) ;;; clean-buffer-list stuff @@ -163,25 +160,28 @@ the current date/time, buffer name, how many seconds ago it was displayed (can be nil if the buffer was never displayed) and its lifetime, i.e., its \"age\" when it will be purged." (interactive) - (let ((tm (float-time)) bts (ts (format-time-string "%Y-%m-%d %T")) + (let ((tm (current-time)) bts (ts (format-time-string "%Y-%m-%d %T")) delay cbld bn) (dolist (buf (buffer-list)) (when (buffer-live-p buf) - (setq bts (midnight-buffer-display-time buf) bn (buffer-name buf) - delay (if bts (- tm bts) 0) cbld (clean-buffer-list-delay bn)) - (message "[%s] `%s' [%s %d]" ts bn (if bts (round delay)) cbld) - (unless (or (cl-find bn clean-buffer-list-kill-never-regexps + (setq bts (with-current-buffer buf buffer-display-time) + bn (buffer-name buf) + delay (if bts (round (float-time (time-subtract tm bts))) 0) + cbld (clean-buffer-list-delay bn)) + (message "[%s] `%s' [%s %d]" ts bn delay cbld) + (unless (or (cl-find bn clean-buffer-list-kill-never-regexps :test (lambda (bn re) (if (functionp re) (funcall re bn) (string-match re bn)))) - (cl-find bn clean-buffer-list-kill-never-buffer-names + (cl-find bn clean-buffer-list-kill-never-buffer-names :test #'string-equal) - (get-buffer-process buf) - (and (buffer-file-name buf) (buffer-modified-p buf)) - (get-buffer-window buf 'visible) (< delay cbld)) - (message "[%s] killing `%s'" ts bn) - (kill-buffer buf)))))) + (get-buffer-process buf) + (and (buffer-file-name buf) (buffer-modified-p buf)) + (get-buffer-window buf 'visible) + (< delay cbld)) + (message "[%s] killing `%s'" ts bn) + (kill-buffer buf)))))) ;;; midnight hook diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ecac0aeb135..175189c1b48 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -369,13 +369,15 @@ instead of a string, a function that takes the completion and returns the (defun completion-table-with-predicate (table pred1 strict string pred2 action) "Make a completion table equivalent to TABLE but filtered through PRED1. -PRED1 is a function of one argument which returns non-nil if and only if the -argument is an element of TABLE which should be considered for completion. -STRING, PRED2, and ACTION are the usual arguments to completion tables, -as described in `try-completion', `all-completions', and `test-completion'. -If STRICT is t, the predicate always applies; if nil it only applies if -it does not reduce the set of possible completions to nothing. -Note: TABLE needs to be a proper completion table which obeys predicates." +PRED1 is a function of one argument which returns non-nil if and +only if the argument is an element of TABLE which should be +considered for completion. STRING, PRED2, and ACTION are the +usual arguments to completion tables, as described in +`try-completion', `all-completions', and `test-completion'. If +STRICT is non-nil, the predicate always applies; if nil it only +applies if it does not reduce the set of possible completions to +nothing. Note: TABLE needs to be a proper completion table which +obeys predicates." (cond ((and (not strict) (eq action 'lambda)) ;; Ignore pred1 since it doesn't really have to apply anyway. @@ -1835,7 +1837,7 @@ variables.") 'display-buffer-below-selected)) ,(if temp-buffer-resize-mode '(window-height . resize-temp-buffer-window) - '(window-height . shrink-window-if-larger-than-buffer)) + '(window-height . fit-window-to-buffer)) ,(when temp-buffer-resize-mode '(preserve-size . (nil . t)))) nil @@ -1923,7 +1925,8 @@ variables.") (exit-minibuffer)) (defvar completion-in-region-functions nil - "Wrapper hook around `completion--in-region'.") + "Wrapper hook around `completion--in-region'. +\(See `with-wrapper-hook' for details about wrapper hooks.)") (make-obsolete-variable 'completion-in-region-functions 'completion-in-region-function "24.4") @@ -1967,8 +1970,9 @@ if there was no valid completion, else t." (defun completion--in-region (start end collection &optional predicate) "Default function to use for `completion-in-region-function'. Its arguments and return value are as specified for `completion-in-region'. -This respects the wrapper hook `completion-in-region-functions'." - (with-wrapper-hook +Also respects the obsolete wrapper hook `completion-in-region-functions'. +\(See `with-wrapper-hook' for details about wrapper hooks.)" + (subr--with-wrapper-hook-no-warnings ;; FIXME: Maybe we should use this hook to provide a "display ;; completions" operation as well. completion-in-region-functions (start end collection predicate) @@ -2048,22 +2052,22 @@ This respects the wrapper hook `completion-in-region-functions'." minor-mode-map-alist)) (defvar completion-at-point-functions '(tags-completion-at-point-function) - "Special hook to find the completion table for the thing at point. -Each function on this hook is called in turn without any argument and should -return either nil to mean that it is not applicable at point, -or a function of no argument to perform completion (discouraged), -or a list of the form (START END COLLECTION . PROPS) where + "Special hook to find the completion table for the entity at point. +Each function on this hook is called in turn without any argument and +should return either nil, meaning it is not applicable at point, +or a function of no arguments to perform completion (discouraged), +or a list of the form (START END COLLECTION . PROPS), where: START and END delimit the entity to complete and should include point, - COLLECTION is the completion table to use to complete it, and + COLLECTION is the completion table to use to complete the entity, and PROPS is a property list for additional information. Currently supported properties are all the properties that can appear in `completion-extra-properties' plus: `:predicate' a predicate that completion candidates need to satisfy. - `:exclusive' If `no', means that if the completion table fails to + `:exclusive' value of `no' means that if the completion table fails to match the text at point, then instead of reporting a completion failure, the completion should try the next completion function. -As is the case with most hooks, the functions are responsible to preserve -things like point and current buffer.") +As is the case with most hooks, the functions are responsible for +preserving things like point and current buffer.") (defvar completion--capf-misbehave-funs nil "List of functions found on `completion-at-point-functions' that misbehave. diff --git a/lisp/misc.el b/lisp/misc.el index 5fc3e7d0fa1..3a739775973 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -28,6 +28,7 @@ (eval-when-compile (require 'tabulated-list)) +;;;###autoload (defun copy-from-above-command (&optional arg) "Copy characters from previous nonblank line, starting just above point. Copy ARG characters, but not past the end of that line. @@ -62,6 +63,7 @@ The characters copied are inserted in the buffer before point." ;; Variation of `zap-to-char'. +;;;###autoload (defun zap-up-to-char (arg char) "Kill up to, but not including ARGth occurrence of CHAR. Case is ignored if `case-fold-search' is non-nil in the current buffer. @@ -80,22 +82,26 @@ Ignores CHAR at point." ;; These were added with an eye to making possible a more CCA-compatible ;; command set; but that turned out not to be interesting. +;;;###autoload (defun mark-beginning-of-buffer () "Set mark at the beginning of the buffer." (interactive) (push-mark (point-min))) +;;;###autoload (defun mark-end-of-buffer () "Set mark at the end of the buffer." (interactive) (push-mark (point-max))) +;;;###autoload (defun upcase-char (arg) "Uppercasify ARG chars starting from point. Point doesn't move." (interactive "p") (save-excursion (upcase-region (point) (progn (forward-char arg) (point))))) +;;;###autoload (defun forward-to-word (arg) "Move forward until encountering the beginning of a word. With argument, do this that many times." @@ -103,6 +109,7 @@ With argument, do this that many times." (or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg) (goto-char (if (> arg 0) (point-max) (point-min))))) +;;;###autoload (defun backward-to-word (arg) "Move backward until encountering the end of a word. With argument, do this that many times." diff --git a/lisp/mouse.el b/lisp/mouse.el index fa355ffeb71..db9f13b2e6c 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -34,6 +34,11 @@ ;; Indent track-mouse like progn. (put 'track-mouse 'lisp-indent-function 0) +(defgroup mouse nil + "Input from the mouse." ;; "Mouse support." + :group 'environment + :group 'editing) + (defcustom mouse-yank-at-point nil "If non-nil, mouse yank commands yank at point instead of at click." :type 'boolean @@ -97,35 +102,44 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (when (and mouse-1-click-follows-link (eq (if (eq mouse-1-click-follows-link 'double) 'double-down-mouse-1 'down-mouse-1) - (car-safe last-input-event)) - (mouse-on-link-p (event-start last-input-event)) - (or mouse-1-click-in-non-selected-windows - (eq (selected-window) - (posn-window (event-start last-input-event))))) - (let ((timedout - (sit-for (if (numberp mouse-1-click-follows-link) - (/ (abs mouse-1-click-follows-link) 1000.0) - 0)))) - (if (if (and (numberp mouse-1-click-follows-link) - (>= mouse-1-click-follows-link 0)) - timedout (not timedout)) - nil - - (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode! - (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-1 'mouse-1)) - ;; Turn the mouse-1 into a mouse-2 to follow links. - (let ((newup (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-2 'mouse-2))) - ;; If mouse-2 has never been done by the user, it doesn't have - ;; the necessary property to be interpreted correctly. - (unless (get newup 'event-kind) - (put newup 'event-kind (get (car event) 'event-kind))) - (push (cons newup (cdr event)) unread-command-events) - ;; Don't change the down event, only the up-event (bug#18212). - nil) - (push event unread-command-events) - nil)))))) + (car-safe last-input-event))) + (let ((action (mouse-on-link-p (event-start last-input-event)))) + (when (and action + (or mouse-1-click-in-non-selected-windows + (eq (selected-window) + (posn-window (event-start last-input-event))))) + (let ((timedout + (sit-for (if (numberp mouse-1-click-follows-link) + (/ (abs mouse-1-click-follows-link) 1000.0) + 0)))) + (if (if (and (numberp mouse-1-click-follows-link) + (>= mouse-1-click-follows-link 0)) + timedout (not timedout)) + nil + ;; Use read-key so it works for xterm-mouse-mode! + (let ((event (read-key))) + (if (eq (car-safe event) + (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-1 'mouse-1)) + (progn + ;; Turn the mouse-1 into a mouse-2 to follow links, + ;; but only if ‘mouse-on-link-p’ hasn’t returned a + ;; string or vector (see its docstring). + (if (or (stringp action) (vectorp action)) + (push (aref action 0) unread-command-events) + (let ((newup (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-2 'mouse-2))) + ;; If mouse-2 has never been done by the user, it + ;; doesn't have the necessary property to be + ;; interpreted correctly. + (unless (get newup 'event-kind) + (put newup 'event-kind (get (car event) 'event-kind))) + (push (cons newup (cdr event)) unread-command-events))) + ;; Don't change the down event, only the up-event + ;; (bug#18212). + nil) + (push event unread-command-events) + nil)))))))) (define-key key-translation-map [down-mouse-1] #'mouse--down-1-maybe-follows-link) @@ -155,7 +169,7 @@ items `Turn Off' and `Help'." (if (fboundp mm-fun) ; bug#20201 `(keymap ,indicator - (turn-off menu-item "Turn Off minor mode" ,mm-fun) + (turn-off menu-item "Turn off minor mode" ,mm-fun) (help menu-item "Help for minor mode" (lambda () (interactive) (describe-function ',mm-fun))))))) @@ -406,7 +420,13 @@ must be one of the symbols `header', `mode', or `vertical'." (or (not resize-mini-windows) (eq minibuffer-window (active-minibuffer-window))))))) - (setq draggable nil)))) + (setq draggable nil))) + ((eq line 'vertical) + (let ((divider-width (frame-right-divider-width frame))) + (when (and (or (not (numberp divider-width)) + (zerop divider-width)) + (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) + (setq window (window-in-direction 'left window t)))))) (let* ((exitfun nil) (move @@ -473,7 +493,8 @@ must be one of the symbols `header', `mode', or `vertical'." (window-pixel-height window))))) (setq dragged t) (adjust-window-trailing-edge window growth nil t)) - (setq last-position position)))))) + (setq last-position position))))) + (old-track-mouse track-mouse)) ;; Start tracking. The special value 'dragging' signals the ;; display engine to freeze the mouse pointer shape for as long ;; as we drag. @@ -506,7 +527,7 @@ must be one of the symbols `header', `mode', or `vertical'." (define-key map [right-divider] map) (define-key map [bottom-divider] map) map) - t (lambda () (setq track-mouse nil))))))) + t (lambda () (setq track-mouse old-track-mouse))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -523,15 +544,29 @@ must be one of the symbols `header', `mode', or `vertical'." (interactive "e") (mouse-drag-line start-event 'vertical)) +(defcustom mouse-select-region-move-to-beginning nil + "Effect of selecting a region extending backward from double click. +Nil means keep point at the position clicked (region end); +non-nil means move point to beginning of region." + :type '(choice (const :tag "Don't move point" nil) + (const :tag "Move point to beginning of region" t)) + :group 'mouse + :version "26.1") + (defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. This should be bound to a mouse click event type. -If PROMOTE-TO-REGION is non-nil and event is a multiple-click, -select the corresponding element around point." +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, select +the corresponding element around point, with the resulting position of +point determined by `mouse-select-region-move-to-beginning'." (interactive "e\np") (mouse-minibuffer-check event) (if (and promote-to-region (> (event-click-count event) 1)) - (mouse-set-region event) + (progn + (mouse-set-region event) + (when mouse-select-region-move-to-beginning + (when (> (posn-point (event-start event)) (region-beginning)) + (exchange-point-and-mark)))) ;; Use event-end in case called from mouse-drag-region. ;; If EVENT is a click, event-end and event-start give same value. (posn-set-point (event-end event)))) @@ -558,7 +593,12 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click))) + (end + (if (eq (posn-window (event-end click)) (selected-window)) + (posn-point (event-end click)) + ;; If the mouse ends up in any other window or on the menu + ;; bar, use `window-point' of selected window (Bug#23707). + (window-point))) (click-count (event-click-count click))) (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) (when drag-start @@ -705,8 +745,9 @@ its value is returned." (defun mouse-on-link-p (pos) "Return non-nil if POS is on a link in the current buffer. -POS must be a buffer position in the current buffer or a mouse -event location in the selected window (see `event-start'). +POS must specify a buffer position in the current buffer, as a list +of the form returned by the `event-start' and `event-end' functions, +or a mouse event location in the selected window (see `event-start'). However, if `mouse-1-click-in-non-selected-windows' is non-nil, POS may be a mouse event location in any window. @@ -793,14 +834,16 @@ The region will be defined with mark and point." (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541). + (start-posn (event-start start-event)) + (start-point (posn-point start-posn)) + (start-window (posn-window start-posn)) + (_ (with-current-buffer (window-buffer start-window) + (setq deactivate-mark nil))) ;; We've recorded what we needed from the current buffer and ;; window, now let's jump to the place of the event, where things ;; are happening. (_ (mouse-set-point start-event)) (echo-keystrokes 0) - (start-posn (event-start start-event)) - (start-point (posn-point start-posn)) - (start-window (posn-window start-posn)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -811,7 +854,8 @@ The region will be defined with mark and point." (click-count (1- (event-click-count start-event))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). - (auto-hscroll-mode-saved auto-hscroll-mode)) + (auto-hscroll-mode-saved auto-hscroll-mode) + (old-track-mouse track-mouse)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -863,7 +907,7 @@ The region will be defined with mark and point." nil start-point)))))))) map) t (lambda () - (setq track-mouse nil) + (setq track-mouse old-track-mouse) (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) (pop-mark))))) @@ -1605,8 +1649,8 @@ and selects that window." (let ((others-list (mouse-buffer-menu-alist ;; we don't need split-by-major-mode any more, - ;; so we can ditch it with nconc. - (apply 'nconc (mapcar 'cddr split-by-major-mode))))) + ;; so we can ditch it with nconc (mapcan). + (mapcan 'cddr split-by-major-mode)))) (and others-list (setq subdivided-menus (cons (cons "Others" others-list) @@ -1683,7 +1727,7 @@ and selects that window." ;; Font selection. (defun font-menu-add-default () - (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) + (let* ((default (frame-parameter nil 'font)) (font-alist x-fixed-font-alist) (elt (or (assoc "Misc" font-alist) (nth 1 font-alist)))) (if (assoc "Default" elt) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index f1450d470fc..9e03854fd11 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -187,7 +187,8 @@ This can be slightly disconcerting, but some people prefer it." (defun mwheel-scroll (event) "Scroll up or down according to the EVENT. -This should only be bound to mouse buttons 4 and 5." +This should be bound only to mouse buttons 4 and 5 on non-Windows +systems." (interactive (list last-input-event)) (let* ((curwin (if mouse-wheel-follow-mouse (prog1 diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index d5c03e3f4ae..07c3daf7d7e 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -740,7 +740,7 @@ These mean that the FTP process should be (or already has been) killed." :type 'regexp) (defcustom ange-ftp-potential-error-msgs - ;; On Mac OS X we sometimes get things like: + ;; On macOS we sometimes get things like: ;; ;; ftp> open ftp.nluug.nl ;; Trying 2001:610:1:80aa:192:87:102:36... @@ -1533,12 +1533,11 @@ then kill the related FTP process." (defun ange-ftp-barf-if-not-directory (directory) (or (file-directory-p directory) - (signal 'file-error - (list "Opening directory" - (if (file-exists-p directory) - "Not a directory" - "No such file or directory") - directory)))) + (let ((exists (file-exists-p directory))) + (signal (if exists 'file-error 'file-missing) + (list "Opening directory" + (if exists "Not a directory" "No such file or directory") + directory))))) ;;;; ------------------------------------------------------------ ;;;; FTP process filter support. @@ -3352,9 +3351,10 @@ system TYPE.") (setq buffer-file-name filename))) (setq last-coding-system-used coding-system-used) (list filename size)) - (signal 'file-error + (signal 'file-missing (list "Opening input file" + "No such file or directory" filename)))) (ange-ftp-real-insert-file-contents filename visit beg end replace)))) @@ -3663,7 +3663,7 @@ so return the size on the remote host exactly. See RFC 3659." newname (expand-file-name newname)) (or (file-exists-p filename) - (signal 'file-error + (signal 'file-missing (list "Copy file" "No such file or directory" filename))) ;; canonicalize newname if a directory. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index c0b359176ec..b2077d784c0 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -44,7 +44,7 @@ ;; browse-url-text-* Any text browser 0 ;; browse-url-generic arbitrary ;; browse-url-default-windows-browser MS-Windows browser -;; browse-url-default-macosx-browser Mac OS X browser +;; browse-url-default-macosx-browser macOS browser ;; browse-url-xdg-open Free Desktop xdg-open on Gnome, KDE, Xfce4, LXDE ;; browse-url-kde KDE konqueror (kfm) ;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT) @@ -162,7 +162,7 @@ regexp should probably be \".\" to specify a default browser." :value browse-url-generic) (function-item :tag "Default Windows browser" :value browse-url-default-windows-browser) - (function-item :tag "Default Mac OS X browser" + (function-item :tag "Default macOS browser" :value browse-url-default-macosx-browser) (function-item :tag "Default browser" :value browse-url-default-browser) @@ -184,6 +184,15 @@ be used instead." :version "24.1" :group 'browse-url) +(defcustom browse-url-man-function 'browse-url-man + "Function to display man: links." + :type '(radio + (function-item :tag "Emacs Man" :value browse-url-man) + (const :tag "None" nil) + (function :tag "Other function")) + :version "26.1" + :group 'browse-url) + (defcustom browse-url-netscape-program "netscape" ;; Info about netscape-remote from Karl Berry. "The name by which to invoke Netscape. @@ -356,10 +365,7 @@ If non-nil, then open the URL in a new tab rather than a new window if (defcustom browse-url-firefox-new-window-is-tab nil "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if -`browse-url-firefox' is asked to open it in a new window. - -This option is currently ignored on MS-Windows, since the necessary -functionality is not available there." +`browse-url-firefox' is asked to open it in a new window." :type 'boolean :group 'browse-url) @@ -801,6 +807,8 @@ as ARGS." (let ((process-environment (copy-sequence process-environment)) (function (or (and (string-match "\\`mailto:" url) browse-url-mailto-function) + (and (string-match "\\`man:" url) + browse-url-man-function) browse-url-browser-function)) ;; Ensure that `default-directory' exists and is readable (b#6077). (default-directory (or (unhandled-file-name-directory default-directory) @@ -873,7 +881,7 @@ The optional NEW-WINDOW argument is not used." (t (w32-shell-execute "open" url)))) (defun browse-url-default-macosx-browser (url &optional _new-window) - "Invoke the MacOS X system's default Web browser. + "Invoke the macOS system's default Web browser. The optional NEW-WINDOW argument is not used" (interactive (browse-url-interactive-arg "URL: ")) (start-process (concat "open " url) nil "open" url)) @@ -1588,6 +1596,19 @@ used instead of `browse-url-new-window-flag'." (unless (bolp) (insert "\n")))))))) +;; --- man --- + +(defvar manual-program) + +(defun browse-url-man (url &optional _new-window) + "Open a man page." + (interactive (browse-url-interactive-arg "Man page URL: ")) + (require 'man) + (setq url (replace-regexp-in-string "\\`man:" "" url)) + (cond + ((executable-find manual-program) (man url)) + (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url))))) + ;; --- Random browser --- ;;;###autoload diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 7a4ef1f7bcf..2d7cd2fc612 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1,4 +1,4 @@ -;;; dbus.el --- Elisp bindings for D-Bus. +;;; dbus.el --- Elisp bindings for D-Bus. -*- lexical-binding: t -*- ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. @@ -492,7 +492,7 @@ See `dbus-registered-objects-table' for a description of the hash table." (let (result) (maphash - (lambda (key value) (add-to-list 'result (cons key value) 'append)) + (lambda (key value) (push (cons key value) result)) dbus-registered-objects-table) result)) @@ -1113,9 +1113,9 @@ unique names for services." "Retrieve all services which correspond to a known name in BUS. A service has a known name if it doesn't start with \":\"." (let (result) - (dolist (name (dbus-list-names bus) result) + (dolist (name (dbus-list-names bus) (nreverse result)) (unless (string-equal ":" (substring name 0 1)) - (add-to-list 'result name 'append))))) + (push name result))))) (defun dbus-list-queued-owners (bus service) "Return the unique names registered at D-Bus BUS and queued for SERVICE. @@ -1214,9 +1214,8 @@ It returns a list of strings. The node names stand for further object paths of the D-Bus service." (let ((object (dbus-introspect-xml bus service path)) result) - (dolist (elt (xml-get-children object 'node) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'node) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-all-nodes (bus service path) "Return all node names of SERVICE in D-Bus BUS at object path PATH. @@ -1240,9 +1239,8 @@ interface is \"org.freedesktop.DBus.Properties\". If present, children, beside \"method\" and \"signal\" objects." (let ((object (dbus-introspect-xml bus service path)) result) - (dolist (elt (xml-get-children object 'interface) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'interface) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-interface (bus service path interface) "Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH. @@ -1264,9 +1262,8 @@ The resulting \"interface\" object can contain \"method\", \"signal\", SERVICE is a service of D-Bus BUS at object path PATH." (let ((object (dbus-introspect-get-interface bus service path interface)) result) - (dolist (elt (xml-get-children object 'method) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'method) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-method (bus service path interface method) "Return method METHOD of interface INTERFACE as XML object. @@ -1288,9 +1285,8 @@ object can contain \"arg\" and \"annotation\" children." SERVICE is a service of D-Bus BUS at object path PATH." (let ((object (dbus-introspect-get-interface bus service path interface)) result) - (dolist (elt (xml-get-children object 'signal) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'signal) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-signal (bus service path interface signal) "Return signal SIGNAL of interface INTERFACE as XML object. @@ -1312,9 +1308,8 @@ object can contain \"arg\" and \"annotation\" children." SERVICE is a service of D-Bus BUS at object path PATH." (let ((object (dbus-introspect-get-interface bus service path interface)) result) - (dolist (elt (xml-get-children object 'property) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'property) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-property (bus service path interface property) "This function returns PROPERTY of INTERFACE as XML object. @@ -1345,9 +1340,8 @@ object, where the annotations belong to." (dbus-introspect-get-property bus service path interface name)) (dbus-introspect-get-interface bus service path interface))) result) - (dolist (elt (xml-get-children object 'annotation) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'annotation) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-annotation (bus service path interface name annotation) @@ -1382,9 +1376,8 @@ therefore, even if the method or signal has arguments." (or (dbus-introspect-get-method bus service path interface name) (dbus-introspect-get-signal bus service path interface name))) result) - (dolist (elt (xml-get-children object 'arg) result) - (add-to-list - 'result (dbus-introspect-get-attribute elt "name") 'append)))) + (dolist (elt (xml-get-children object 'arg) (nreverse result)) + (push (dbus-introspect-get-attribute elt "name") result)))) (defun dbus-introspect-get-argument (bus service path interface name arg) "Return argument ARG as XML object. @@ -1473,8 +1466,8 @@ nil is returned." (dbus-call-method bus service path dbus-interface-properties "GetAll" :timeout 500 interface) - result) - (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append))))) + (nreverse result)) + (push (cons (car dict) (cl-caadr dict)) result))))) (defun dbus-register-property (bus service path interface property access value @@ -1609,11 +1602,11 @@ It will be registered for all objects created by `dbus-register-property'." (when (and (equal (butlast key) (list :property bus interface)) (string-equal path (nth 2 (car val))) (not (functionp (car (last (car val)))))) - (add-to-list - 'result + (push (list :dict-entry (car (last key)) - (list :variant (cdar (last (car val)))))))) + (list :variant (cdar (last (car val))))) + result))) dbus-registered-objects-table) ;; Return the result, or an empty array. (list :array (or result '(:signature "{sv}")))))))) @@ -1684,12 +1677,12 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow." (interface (dbus-introspect-get-interface-names bus service object) result1) - (add-to-list - 'result1 + (push (cons interface - (dbus-get-all-properties bus service object interface)))) + (dbus-get-all-properties bus service object interface)) + result1)) (when result1 - (add-to-list 'result (cons object result1)))))))) + (push (cons object result1) result))))))) (defun dbus-managed-objects-handler () "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface. @@ -1705,7 +1698,7 @@ It will be registered for all objects created by `dbus-register-service'." (lambda (key val) (when (and (equal (butlast key 2) (list :method bus)) (null (nth 2 (car-safe val)))) - (add-to-list 'interfaces (nth 2 key)))) + (push (nth 2 key) interfaces))) dbus-registered-objects-table) ;; Check all registered object paths. @@ -1716,7 +1709,7 @@ It will be registered for all objects created by `dbus-register-service'." (string-prefix-p path object)) (dolist (interface (cons (nth 2 key) interfaces)) (unless (assoc object result) - (add-to-list 'result (list object))) + (push (list object) result)) (unless (assoc interface (cdr (assoc object result))) (setcdr (assoc object result) diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 02cb627cfd3..338afca15f1 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -36,8 +36,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup dig nil "Dig configuration." :group 'comm) @@ -126,15 +124,13 @@ Buffer should contain output generated by `dig-invoke'." ;; `font-lock-defaults' buffer-local variable. (put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t)) -(put 'dig-mode 'mode-class 'special) - (defvar dig-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) + (define-key map "g" nil) (define-key map "q" 'dig-exit) map)) -(define-derived-mode dig-mode nil "Dig" +(define-derived-mode dig-mode special-mode "Dig" "Major mode for displaying dig output." (buffer-disable-undo) (unless (featurep 'xemacs) @@ -148,7 +144,7 @@ Buffer should contain output generated by `dig-invoke'." (defun dig-exit () "Quit dig output buffer." (interactive) - (kill-buffer (current-buffer))) + (quit-window t)) ;;;###autoload (defun dig (domain &optional @@ -156,14 +152,12 @@ Buffer should contain output generated by `dig-invoke'." "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. Optional arguments are passed to `dig-invoke'." (interactive "sHost: ") - (switch-to-buffer + (pop-to-buffer-same-window (dig-invoke domain query-type query-class query-option dig-option server)) (goto-char (point-min)) (and (search-forward ";; ANSWER SECTION:" nil t) (forward-line)) - (dig-mode) - (setq buffer-read-only t) - (set-buffer-modified-p nil)) + (dig-mode)) ;; named for consistency with query-dns in dns.el (defun query-dig (domain &optional @@ -175,7 +169,7 @@ Returns nil for domain/class/type queries that result in no data." (let ((buffer (dig-invoke domain query-type query-class query-option dig-option server))) (when buffer - (switch-to-buffer buffer) + (pop-to-buffer-same-window buffer) (let ((digger (dig-extract-rr domain query-type query-class))) (kill-buffer buffer) digger)))) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 867bea98e77..22e48dbd3d3 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1146,7 +1146,7 @@ queries the server for the existing fields and displays a corresponding form." (defun eudc-menu () (let (command) - (append '("Directory Search") + (append '("Directory Servers") (list (append '("Server") @@ -1186,8 +1186,8 @@ queries the server for the existing fields and displays a corresponding form." (define-key global-map [menu-bar tools directory-search] - (cons "Directory Search" - (easy-menu-create-menu "Directory Search" (cdr (eudc-menu)))))) + (cons "Directory Servers" + (easy-menu-create-menu "Directory Servers" (cdr (eudc-menu)))))) ((fboundp 'easy-menu-add-item) (let ((menu (eudc-menu))) (easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu) @@ -1197,8 +1197,9 @@ queries the server for the existing fields and displays a corresponding form." (define-key global-map [menu-bar tools eudc] - (cons "Directory Search" - (easy-menu-create-keymaps "Directory Search" (cdr (eudc-menu)))))) + (cons "Directory Servers" + (easy-menu-create-keymaps "Directory Servers" + (cdr (eudc-menu)))))) (t (error "Unknown version of easymenu")))) )) @@ -1231,7 +1232,7 @@ This does nothing except loading eudc by autoload side-effect." (cond ((not (featurep 'xemacs)) (defvar eudc-tools-menu - (let ((map (make-sparse-keymap "Directory Search"))) + (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] `(menu-item ,(purecopy "Get Phone") eudc-get-phone :help ,(purecopy "Get the phone field of name from the directory server"))) @@ -1255,7 +1256,7 @@ This does nothing except loading eudc by autoload side-effect." map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) (t - (let ((menu '("Directory Search" + (let ((menu '("Directory Servers" ["Load Hotlist of Servers" eudc-load-eudc t] ["New Server" eudc-set-server t] ["---" nil nil] @@ -1279,8 +1280,8 @@ This does nothing except loading eudc by autoload side-effect." (define-key global-map [menu-bar tools eudc] - (cons "Directory Search" - (easy-menu-create-keymaps "Directory Search" + (cons "Directory Servers" + (easy-menu-create-keymaps "Directory Servers" (cdr menu))))))))))) ;;}}} diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 34cb02c24ac..7672bf0e1ef 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'shr) (require 'url) @@ -74,8 +74,8 @@ duplicate entries (if any) removed." :group 'eww :type 'hook :options '(eww-links-at-point - url-get-url-at-point - eww-current-url)) + url-get-url-at-point + eww-current-url)) (defcustom eww-bookmarks-directory user-emacs-directory "Directory where bookmark files will be stored." @@ -314,6 +314,20 @@ See the `eww-search-prefix' variable for the search engine used." (interactive "r") (eww (buffer-substring beg end))) +(defun eww-open-in-new-buffer () + "Fetch link at point in a new EWW buffer." + (interactive) + (let ((url (eww-suggested-uris))) + (if (null url) (user-error "No link at point") + ;; clone useful to keep history, but + ;; should not clone from non-eww buffer + (with-current-buffer + (if (eq major-mode 'eww-mode) (clone-buffer) + (generate-new-buffer "*eww*")) + (unless (equal url (eww-current-url)) + (eww-mode) + (eww (if (consp url) (car url) url))))))) + (defun eww-html-p (content-type) "Return non-nil if CONTENT-TYPE designates an HTML content type. Currently this means either text/html or application/xhtml+xml." @@ -669,11 +683,13 @@ the like." (setq score (- (length (split-string (dom-text node)))))) (t (dolist (elem (dom-children node)) - (if (stringp elem) - (setq score (+ score (length (split-string elem)))) + (cond + ((stringp elem) + (setq score (+ score (length (split-string elem))))) + ((consp elem) (setq score (+ score (or (cdr (assoc :eww-readability-score (cdr elem))) - (eww-score-readability elem)))))))) + (eww-score-readability elem))))))))) ;; Cache the score of the node to avoid recomputing all the time. (dom-set-attribute node :eww-readability-score score) score)) @@ -695,6 +711,7 @@ the like." (let ((map (make-sparse-keymap))) (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! (define-key map "G" 'eww) + (define-key map [?\M-\r] 'eww-open-in-new-buffer) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) (define-key map [backtab] 'shr-previous-link) @@ -729,6 +746,7 @@ the like." ["Exit" quit-window t] ["Close browser" quit-window t] ["Reload" eww-reload t] + ["Follow URL in new buffer" eww-open-in-new-buffer] ["Back to previous page" eww-back-url :active (not (zerop (length eww-history)))] ["Forward to next page" eww-forward-url @@ -2006,7 +2024,7 @@ Otherwise, the restored buffer will contain a prompt to do so by using (list :url (plist-get misc-data :uri)))) (unless file-name (when (plist-get eww-data :url) - (case eww-restore-desktop + (cl-case eww-restore-desktop ((t auto) (eww (plist-get eww-data :url))) ((zerop (buffer-size)) (let ((inhibit-read-only t)) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 609a8f4d64b..f71d7ba6675 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -29,7 +29,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (autoload 'mail-header-parse-content-type "mail-parse") (defgroup mailcap nil @@ -58,6 +58,59 @@ " ") "Shell command (including switches) used to print PostScript files.") +(defun mailcap--get-user-mime-data (sym) + (let ((val (default-value sym)) + res) + (dolist (entry val) + (push (list (cdr (assq 'viewer entry)) + (cdr (assq 'type entry)) + (cdr (assq 'test entry))) + res)) + (nreverse res))) + +(defun mailcap--set-user-mime-data (sym val) + (let (res) + (dolist (entry val) + (push `((viewer . ,(car entry)) + (type . ,(cadr entry)) + ,@(when (cl-caddr entry) + `((test . ,(cl-caddr entry))))) + res)) + (set-default sym (nreverse res)))) + +(defcustom mailcap-user-mime-data nil + "A list of viewers preferred for different MIME types. +The elements of the list are alists of the following structure + + ((viewer . VIEWER) + (type . MIME-TYPE) + (test . TEST)) + +where VIEWER is either a lisp command, e.g., a major-mode, or a +string containing a shell command for viewing files of the +defined MIME-TYPE. In case of a shell command, %s will be +replaced with the file. + +MIME-TYPE is a regular expression being matched against the +actual MIME type. It is implicitly surrounded with ^ and $. + +TEST is an lisp form which is evaluated in order to test if the +entry should be chosen. The `test' entry is optional. + +When selecting a viewer for a given MIME type, the first viewer +in this list with a matching MIME-TYPE and successful TEST is +selected. Only if none matches, the standard `mailcap-mime-data' +is consulted." + :type '(repeat + (list + (choice (function :tag "Function or mode") + (string :tag "Shell command")) + (regexp :tag "MIME Type") + (sexp :tag "Test (optional)"))) + :get #'mailcap--get-user-mime-data + :set #'mailcap--set-user-mime-data + :group 'mailcap) + ;; Postpone using defcustom for this as it's so big and we essentially ;; have to have two copies of the data around then. Perhaps just ;; customize the Lisp viewers and rely on the normal configuration @@ -284,7 +337,7 @@ to return a true or false shell value for the validity.") (put 'mailcap-mime-data 'risky-local-variable t) (defcustom mailcap-download-directory nil - "*Directory to which `mailcap-save-binary-file' downloads files by default. + "Directory to which `mailcap-save-binary-file' downloads files by default. nil means your home directory." :type '(choice (const :tag "Home directory" nil) directory) @@ -377,18 +430,14 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus ;; with /usr before /usr/local. '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" "/usr/local/etc/mailcap")))) - (let ((fnames (reverse - (if (stringp path) - (split-string path path-separator t) - path))) - fname) - (while fnames - (setq fname (car fnames)) - (if (and (file-readable-p fname) - (file-regular-p fname)) - (mailcap-parse-mailcap fname)) - (setq fnames (cdr fnames)))) - (setq mailcap-parsed-p t))) + (dolist (fname (reverse + (if (stringp path) + (split-string path path-separator t) + path))) + (if (and (file-readable-p fname) + (file-regular-p fname)) + (mailcap-parse-mailcap fname))) + (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) "Parse out the mailcap file specified by FNAME." @@ -507,10 +556,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (setq value (buffer-substring val-pos (point)))) ;; `test' as symbol, others like "copiousoutput" and "needsx11" as ;; strings - (setq results (cons (cons (if (string-equal name "test") - 'test - name) - value) results)) + (push (cons (if (string-equal name "test") 'test name) value) results) (skip-chars-forward " \";\n\t")) results))) @@ -554,9 +600,9 @@ the test clause will be unchanged." (while major (cond ((equal (car (car major)) minor) - (setq exact (cons (cdr (car major)) exact))) + (push (cdr (car major)) exact)) ((and minor (string-match (concat "^" (car (car major)) "$") minor)) - (setq wildcard (cons (cdr (car major)) wildcard)))) + (push (cdr (car major)) wildcard))) (setq major (cdr major))) (nconc exact wildcard))) @@ -619,7 +665,7 @@ to supply to the test." (otest test) (viewer (cdr (assq 'viewer viewer-info))) (default-directory (expand-file-name "~/")) - status parsed-test cache result) + status cache result) (cond ((not (or (stringp viewer) (fboundp viewer))) nil) ; Non-existent Lisp function ((setq cache (assoc test mailcap-viewer-test-cache)) @@ -651,9 +697,7 @@ to supply to the test." (defun mailcap-add-mailcap-entry (major minor info) (let ((old-major (assoc major mailcap-mime-data))) (if (null old-major) ; New major area - (setq mailcap-mime-data - (cons (cons major (list (cons minor info))) - mailcap-mime-data)) + (push (cons major (list (cons minor info))) mailcap-mime-data) (let ((cur-minor (assoc minor old-major))) (cond ((or (null cur-minor) ; New minor area, or @@ -700,6 +744,20 @@ If TEST is not given, it defaults to t." t) (t nil)))) +(defun mailcap-select-preferred-viewer (type-info) + "Return an applicable viewer entry from `mailcap-user-mime-data'." + (let ((info (mapcar (lambda (a) (cons (symbol-name (car a)) + (cdr a))) + (cdr type-info))) + viewer) + (dolist (entry mailcap-user-mime-data) + (when (and (null viewer) + (string-match (concat "^" (cdr (assq 'type entry)) "$") + (car type-info)) + (mailcap-viewer-passes-test entry info)) + (setq viewer entry))) + viewer)) + (defun mailcap-mime-info (string &optional request no-decode) "Get the MIME viewer command for STRING, return nil if none found. Expects a complete content-type header line as its argument. @@ -719,10 +777,7 @@ If NO-DECODE is non-nil, don't decode STRING." major ; Major encoding (text, etc) minor ; Minor encoding (html, etc) info ; Other info - save-pos ; Misc. position during parse major-info ; (assoc major mailcap-mime-data) - minor-info ; (assoc minor major-info) - test ; current test proc. viewers ; Possible viewers passed ; Viewers that passed the test viewer ; The one and only viewer @@ -732,41 +787,47 @@ If NO-DECODE is non-nil, don't decode STRING." (if no-decode (list (or string "text/plain")) (mail-header-parse-content-type (or string "text/plain")))) - (setq major (split-string (car ctl) "/")) - (setq minor (cadr major) - major (car major)) - (when (setq major-info (cdr (assoc major mailcap-mime-data))) - (when (setq viewers (mailcap-possible-viewers major-info minor)) - (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) - (cdr a))) - (cdr ctl))) - (while viewers - (if (mailcap-viewer-passes-test (car viewers) info) - (setq passed (cons (car viewers) passed))) - (setq viewers (cdr viewers))) - (setq passed (sort passed 'mailcap-viewer-lessp)) - (setq viewer (car passed)))) - (when (and (stringp (cdr (assq 'viewer viewer))) - passed) - (setq viewer (car passed))) + ;; Check if there's a user-defined viewer from `mailcap-user-mime-data'. + (setq viewer (mailcap-select-preferred-viewer ctl)) + (if viewer + (setq passed (list viewer)) + ;; None found, so heuristically select some applicable viewer + ;; from `mailcap-mime-data'. + (setq major (split-string (car ctl) "/")) + (setq minor (cadr major) + major (car major)) + (when (setq major-info (cdr (assoc major mailcap-mime-data))) + (when (setq viewers (mailcap-possible-viewers major-info minor)) + (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) + (cdr a))) + (cdr ctl))) + (while viewers + (if (mailcap-viewer-passes-test (car viewers) info) + (push (car viewers) passed)) + (setq viewers (cdr viewers))) + (setq passed (sort passed 'mailcap-viewer-lessp)) + (setq viewer (car passed)))) + (when (and (stringp (cdr (assq 'viewer viewer))) + passed) + (setq viewer (car passed)))) (cond ((and (null viewer) (not (equal major "default")) request) - (mailcap-mime-info "default" request no-decode)) + (mailcap-mime-info "default" request no-decode)) ((or (null request) (equal request "")) - (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) + (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) - (mailcap-unescape-mime-test - (cdr-safe (assoc request viewer)) info)) + (mailcap-unescape-mime-test + (cdr-safe (assoc request viewer)) info)) ((eq request 'all) - passed) + passed) (t - ;; MUST make a copy *sigh*, else we modify mailcap-mime-data - (setq viewer (copy-sequence viewer)) - (let ((view (assq 'viewer viewer)) - (test (assq 'test viewer))) - (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) - (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) - viewer))))) + ;; MUST make a copy *sigh*, else we modify mailcap-mime-data + (setq viewer (copy-sequence viewer)) + (let ((view (assq 'viewer viewer)) + (test (assq 'test viewer))) + (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) + (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) + viewer))))) ;;; ;;; Experimental MIME-types parsing @@ -907,15 +968,11 @@ If FORCE, re-parse even if already parsed." "/usr/etc/mime-types" "/usr/local/etc/mime-types" "/usr/local/www/conf/mime-types")))) - (let ((fnames (reverse (if (stringp path) - (split-string path path-separator t) - path))) - fname) - (while fnames - (setq fname (car fnames)) - (if (and (file-readable-p fname)) - (mailcap-parse-mimetype-file fname)) - (setq fnames (cdr fnames)))) + (dolist (fname (reverse (if (stringp path) + (split-string path path-separator t) + path))) + (if (and (file-readable-p fname)) + (mailcap-parse-mimetype-file fname))) (setq mailcap-mimetypes-parsed-p t))) (defun mailcap-parse-mimetype-file (fname) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index b13bece3912..73d6ff4d61c 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -112,22 +112,31 @@ These options can be used to limit how many ICMP packets are emitted." :group 'net-utils :type '(repeat string)) -(defcustom iwconfig-program "iwconfig" +(defcustom iwconfig-program + (cond ((executable-find "iwconfig") "iwconfig") + ((net-utils--executable-find-sbin "iw") "iw") + (t "iw")) "Program to print wireless network configuration information." :group 'net-utils :type 'string - :version "23.1") + :version "26.1") -(defcustom iwconfig-program-options nil +(defcustom iwconfig-program-options + (cond ((string-match-p "iw\\'" iwconfig-program) (list "dev")) + (t nil)) "Options for the iwconfig program." :group 'net-utils :type '(repeat string) - :version "23.1") + :version "26.1") -(defcustom netstat-program "netstat" +(defcustom netstat-program + (cond ((executable-find "netstat") "netstat") + ((net-utils--executable-find-sbin "ss")) + (t "ss")) "Program to print network statistics." :group 'net-utils - :type 'string) + :type 'string + :version "26.1") (defcustom netstat-program-options (list "-a") @@ -147,20 +156,25 @@ These options can be used to limit how many ICMP packets are emitted." :type '(repeat string)) (defcustom route-program - (if (eq system-type 'windows-nt) - "route" - "netstat") + (cond ((eq system-type 'windows-nt) "route") + ((executable-find "netstat") "netstat") + ((net-utils--executable-find-sbin "netstat")) + ((executable-find "ip") "ip") + ((net-utils--executable-find-sbin "ip")) + (t "ip")) "Program to print routing tables." :group 'net-utils - :type 'string) + :type 'string + :version "26.1") (defcustom route-program-options - (if (eq system-type 'windows-nt) - (list "print") - (list "-r")) + (cond ((eq system-type 'windows-nt) (list "print")) + ((string-match-p "netstat\\'" route-program) (list "-r")) + (t (list "route"))) "Options for the route program." :group 'net-utils - :type '(repeat string)) + :type '(repeat string) + :version "26.1") (defcustom nslookup-program "nslookup" "Program to interactively query DNS information." diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 5ddaef58a89..657672d5e76 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -1,4 +1,4 @@ -;;; network-stream.el --- open network processes, possibly with encryption +;;; network-stream.el --- open network processes, possibly with encryption -*- lexical-binding: t -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -204,7 +204,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;;;###autoload (defalias 'open-protocol-stream 'open-network-stream) (define-obsolete-function-alias 'open-protocol-stream 'open-network-stream - "25.2") + "26.1") (defun network-stream-open-plain (name buffer host service parameters) (let ((start (with-current-buffer buffer (point))) @@ -312,6 +312,9 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." :host (puny-encode-domain host) :service service)) (network-stream-get-response stream start eoc))) + (unless (process-live-p stream) + (error "Unable to negotiate a TLS connection with %s/%s" + host service)) ;; Re-get the capabilities, which may have now changed. (setq capabilities (network-stream-command stream capability-command eo-capa)))) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 2596e56aa47..41b21722723 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -442,13 +442,6 @@ buffers *newsticker-wget-<feed>* will not be closed." ;; FIXME It is bad practice to define compat functions with such generic names. -;; This is not needed in Emacs >= 22.1. -(unless (fboundp 'time-add) - (require 'time-date);;FIXME - (defun time-add (t1 t2) - (with-no-warnings ; don't warn about obsolete time-to-seconds in 23.2 - (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))) - (unless (fboundp 'match-string-no-properties) (defalias 'match-string-no-properties 'match-string)) diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 66b7a69aae8..7eff422e4ea 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -1,4 +1,4 @@ -;;; newsticker.el --- A Newsticker for Emacs. +;;; newsticker.el --- A Newsticker for Emacs. -*- lexical-binding: t -*- ;; Copyright (C) 2003-2016 Free Software Foundation, Inc. diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 72bff66c381..5928ab303be 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -25,6 +25,7 @@ ;;; Code: (require 'cl-lib) +(require 'subr-x) (defvar nsm-permanent-host-settings nil) (defvar nsm-temporary-host-settings nil) diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index d96f3b1ebea..e272002cfe7 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -5,7 +5,7 @@ ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Keywords: NTLM, SASL, comm -;; Version: 2.0.0 +;; Version: 2.1.0 ;; Created: February 2001 ;; This file is part of GNU Emacs. @@ -49,10 +49,12 @@ ;; ;; 1. Open a network connection to the Exchange server at the IMAP port (143) ;; 2. Receive an opening message such as: -;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready" +;; "* OK Microsoft Exchange IMAP4rev1 server +;; version 5.5.2653.7 (XXXX) ready" ;; 3. Ask for IMAP server capability by sending "NNN capability" ;; 4. Receive a capability message such as: -;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM" +;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ +;; LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM" ;; 5. Ask for NTLM authentication by sending a string ;; "NNN authenticate ntlm" ;; 6. Receive continuation acknowledgment "+" @@ -101,31 +103,34 @@ is not given." (let ((request-ident (concat "NTLMSSP" (make-string 1 0))) (request-msgType (concat (make-string 1 1) (make-string 3 0))) ;0x01 0x00 0x00 0x00 - (request-flags (concat (make-string 1 7) (make-string 1 178) + (request-flags (concat (make-string 1 7) (make-string 1 130) (make-string 1 8) (make-string 1 0))) - ;0x07 0xb2 0x08 0x00 + ;0x07 0x82 0x08 0x00 lu ld off-d off-u) - (when (string-match "@" user) + (when (and user (string-match "@" user)) (unless domain (setq domain (substring user (1+ (match-beginning 0))))) (setq user (substring user 0 (match-beginning 0)))) + (when (and (stringp domain) (> (length domain) 0)) + ;; set "negotiate domain supplied" bit + (aset request-flags 1 (logior (aref request-flags 1) ?\x10))) ;; set fields offsets within the request struct (setq lu (length user)) (setq ld (length domain)) (setq off-u 32) ;offset to the string 'user (setq off-d (+ 32 lu)) ;offset to the string 'domain ;; pack the request struct in a string - (concat request-ident ;8 bytes - request-msgType ;4 bytes - request-flags ;4 bytes - (md4-pack-int16 lu) ;user field, count field - (md4-pack-int16 lu) ;user field, max count field - (md4-pack-int32 (cons 0 off-u)) ;user field, offset field - (md4-pack-int16 ld) ;domain field, count field - (md4-pack-int16 ld) ;domain field, max count field - (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field - user ;buffer field - domain ;buffer field + (concat request-ident ;8 bytes + request-msgType ;4 bytes + request-flags ;4 bytes + (md4-pack-int16 lu) ;user field, count field + (md4-pack-int16 lu) ;user field, max count field + (md4-pack-int32 (cons 0 off-u)) ;user field, offset field + (md4-pack-int16 ld) ;domain field, count field + (md4-pack-int16 ld) ;domain field, max count field + (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field + user ;buffer field + domain ;buffer field ))) (eval-when-compile @@ -178,6 +183,10 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes + ;; match default setting in `ntlm-build-auth-request' + (request-flags (concat (make-string 1 7) (make-string 1 130) + (make-string 1 8) (make-string 1 0))) + ;0x07 0x82 0x08 0x00 (flags (substring rchallenge 20 24)) ;flags, 4 bytes (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes uDomain-len uDomain-offs @@ -185,19 +194,28 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of lmRespData ;lmRespData, 24 bytes ntRespData ;ntRespData, variable length domain ;ascii domain string - lu ld ln off-lm off-nt off-d off-u off-w off-s) + workstation ;ascii workstation string + ll ln lu ld lw off-lm off-nt off-u off-d off-w) ;; extract domain string from challenge string (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) - (setq domain - (ntlm-unicode2ascii (substring challenge - (cdr uDomain-offs) - (+ (cdr uDomain-offs) uDomain-len)) - (/ uDomain-len 2))) + ;; match Mozilla behavior, which is to send an empty domain string + (setq domain "") + ;; match Mozilla behavior, which is to send "WORKSTATION" + (setq workstation "WORKSTATION") ;; overwrite domain in case user is given in <user>@<domain> format (when (string-match "@" user) (setq domain (substring user (1+ (match-beginning 0)))) (setq user (substring user 0 (match-beginning 0)))) + (when (and (stringp domain) (> (length domain) 0)) + ;; set "negotiate domain supplied" bit, since presumably domain + ;; was also set in `ntlm-build-auth-request' + (aset request-flags 1 (logior (aref request-flags 1) ?\x10))) + ;; match Mozilla behavior, which is to send the logical and of the + ;; type 1 and type 2 flags + (dotimes (index 4) + (aset flags index (logand (aref flags index) + (aref request-flags index)))) (unless (and (integerp ntlm-compatibility-level) (>= ntlm-compatibility-level 0) @@ -223,22 +241,20 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (cadr password-hashes))) (nonce (ntlm-generate-nonce)) (blob (concat (make-string 2 1) - (make-string 2 0) ; blob signature - (make-string 4 0) ; reserved value - (ntlm-compute-timestamp) ; timestamp - nonce ; client nonce - (make-string 4 0) ; unknown - targetInfo ; target info - (make-string 4 0))) ; unknown + (make-string 2 0) ;blob signature + (make-string 4 0) ;reserved value + (ntlm-compute-timestamp) ;timestamp + nonce ;client nonce + (make-string 4 0) ;unknown + targetInfo)) ;target info ;; for reference: LMv2 interim calculation - ;; (lm-interim (hmac-md5 (concat challengeData nonce) - ;; ntlmv2-hash)) + (lm-interim (hmac-md5 (concat challengeData nonce) + ntlmv2-hash)) (nt-interim (hmac-md5 (concat challengeData blob) ntlmv2-hash))) ;; for reference: LMv2 field, but match other clients that ;; send all zeros - ;; (setq lmRespData (concat lm-interim nonce)) - (setq lmRespData (make-string 24 0)) + (setq lmRespData (concat lm-interim nonce)) (setq ntRespData (concat nt-interim blob)))) ;; compatibility level is 2, 1 or 0 ;; level 2 should be treated specially but it's not clear how, @@ -263,69 +279,69 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)))) ;; get offsets to fields to pack the response struct in a string + (setq ll (length lmRespData)) + (setq ln (length ntRespData)) (setq lu (length user)) (setq ld (length domain)) - (setq ln (length ntRespData)) - (setq off-lm 64) ;offset to string 'lmResponse - (setq off-nt (+ 64 24)) ;offset to string 'ntResponse - (setq off-d (+ 64 24 ln)) ;offset to string 'uDomain - (setq off-u (+ 64 24 ln (* 2 ld))) ;offset to string 'uUser - (setq off-w (+ 64 24 ln (* 2 (+ ld lu)))) ;offset to string 'uWks - (setq off-s (+ 64 24 ln (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey + (setq lw (length workstation)) + (setq off-u 64) ;offset to string 'uUser + (setq off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain + (setq off-w (+ off-d (* 2 ld))) ;offset to string 'uWks + (setq off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse + (setq off-nt (+ off-lm ll)) ;offset to string 'ntResponse ;; pack the response struct in a string - (concat "NTLMSSP\0" ;response ident field, 8 bytes - (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes + (concat "NTLMSSP\0" ;response ident field, 8 bytes + (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes ;; lmResponse field, 8 bytes ;;AddBytes(response,lmResponse,lmRespData,24); - (md4-pack-int16 24) ;len field - (md4-pack-int16 24) ;maxlen field - (md4-pack-int32 (cons 0 off-lm)) ;field offset + (md4-pack-int16 ll) ;len field + (md4-pack-int16 ll) ;maxlen field + (md4-pack-int32 (cons 0 off-lm)) ;field offset ;; ntResponse field, 8 bytes ;;AddBytes(response,ntResponse,ntRespData,ln); - (md4-pack-int16 ln) ;len field - (md4-pack-int16 ln) ;maxlen field - (md4-pack-int32 (cons 0 off-nt)) ;field offset + (md4-pack-int16 ln) ;len field + (md4-pack-int16 ln) ;maxlen field + (md4-pack-int32 (cons 0 off-nt)) ;field offset ;; uDomain field, 8 bytes ;;AddUnicodeString(response,uDomain,domain); ;;AddBytes(response, uDomain, udomain, 2*ld); - (md4-pack-int16 (* 2 ld)) ;len field - (md4-pack-int16 (* 2 ld)) ;maxlen field - (md4-pack-int32 (cons 0 off-d)) ;field offset + (md4-pack-int16 (* 2 ld)) ;len field + (md4-pack-int16 (* 2 ld)) ;maxlen field + ;; match Mozilla behavior, which is to hard-code the + ;; domain offset to 64 + (md4-pack-int32 (cons 0 64)) ;field offset ;; uUser field, 8 bytes ;;AddUnicodeString(response,uUser,u); ;;AddBytes(response, uUser, uuser, 2*lu); - (md4-pack-int16 (* 2 lu)) ;len field - (md4-pack-int16 (* 2 lu)) ;maxlen field - (md4-pack-int32 (cons 0 off-u)) ;field offset + (md4-pack-int16 (* 2 lu)) ;len field + (md4-pack-int16 (* 2 lu)) ;maxlen field + (md4-pack-int32 (cons 0 off-u)) ;field offset ;; uWks field, 8 bytes ;;AddUnicodeString(response,uWks,u); - (md4-pack-int16 (* 2 lu)) ;len field - (md4-pack-int16 (* 2 lu)) ;maxlen field - (md4-pack-int32 (cons 0 off-w)) ;field offset + (md4-pack-int16 (* 2 lw)) ;len field + (md4-pack-int16 (* 2 lw)) ;maxlen field + (md4-pack-int32 (cons 0 off-w)) ;field offset - ;; sessionKey field, 8 bytes + ;; sessionKey field, blank, 8 bytes ;;AddString(response,sessionKey,NULL); - (md4-pack-int16 0) ;len field - (md4-pack-int16 0) ;maxlen field - (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset + (md4-pack-int16 0) ;len field + (md4-pack-int16 0) ;maxlen field + (md4-pack-int32 (cons 0 0)) ;field offset ;; flags field, 4 bytes - flags ; + flags ;; buffer field - lmRespData ;lmResponse, 24 bytes - ntRespData ;ntResponse, 24 bytes - (ntlm-ascii2unicode domain ;Unicode domain string, 2*ld bytes - (length domain)) ; - (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes - (length user)) ; - (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes - (length user)) ; + (ntlm-ascii2unicode user lu) ;Unicode user, 2*lu bytes + (ntlm-ascii2unicode domain ld) ;Unicode domain, 2*ld bytes + (ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes + lmRespData ;lmResponse, 24 bytes + ntRespData ;ntResponse, ln bytes ))) (defun ntlm-get-password-hashes (password) @@ -544,7 +560,7 @@ length of STR is LEN." (concat (substring str c len) (substring str 0 c)))) (defsubst ntlm-string-xor (in1 in2 n) - "Return exclusive-or of sequences in1 and in2" + "Return exclusive-or of sequences in1 and in2." (let ((w (make-string n 0)) (i 0)) (while (< i n) (aset w i (logxor (aref in1 i) (aref in2 i))) diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 1695bbd3a40..3964288fd23 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -45,36 +45,38 @@ (defcustom pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER")) - "*POP3 maildrop." + "POP3 maildrop." :version "22.1" ;; Oort Gnus :type 'string :group 'pop3) (defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch "pop3") - "*POP3 mailhost." + "POP3 mailhost." :version "22.1" ;; Oort Gnus :type 'string :group 'pop3) (defcustom pop3-port 110 - "*POP3 port." + "POP3 port." :version "22.1" ;; Oort Gnus :type 'number :group 'pop3) (defcustom pop3-password-required t - "*Non-nil if a password is required when connecting to POP server." + "Non-nil if a password is required when connecting to POP server." :version "22.1" ;; Oort Gnus :type 'boolean :group 'pop3) ;; Should this be customizable? -(defvar pop3-password nil - "*Password to use when connecting to POP server.") +(defcustom pop3-password nil + "Password to use when connecting to POP server." + :type '(choice (const nil) string) + :group 'pop3) (defcustom pop3-authentication-scheme 'pass - "*POP3 authentication scheme. + "POP3 authentication scheme. Defaults to `pass', for the standard USER/PASS authentication. The other valid value is `apop'." :type '(choice (const :tag "Normal user/password" pass) @@ -400,8 +402,7 @@ Return non-nil if it is necessary to update the local UIDL file." (push uidl new)) (decf i))) (pop3-uidl - (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime)) - pop3-uidl))))) + (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl)))) (when new (setq mod t)) ;; List expirable messages and delete them from the data to be saved. (setq ctime (when (numberp pop3-leave-mail-on-server) @@ -515,7 +516,7 @@ Return non-nil if it is necessary to update the local UIDL file." (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n")))) (defcustom pop3-stream-type nil - "*Transport security type for POP3 connections. + "Transport security type for POP3 connections. This may be either nil (plain connection), `ssl' (use an SSL/TSL-secured stream) or `starttls' (use the starttls mechanism to turn on TLS security after opening the stream). However, if diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 7a46485531a..773589af47e 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -101,17 +101,12 @@ :type 'file :group 'quickurl) -(defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url))) +(defcustom quickurl-format-function #'quickurl-format-url "Function to format the URL before insertion into the current buffer." :type 'function :group 'quickurl) -(defcustom quickurl-sort-function (lambda (list) - (sort list - (lambda (x y) - (string< - (downcase (quickurl-url-description x)) - (downcase (quickurl-url-description y)))))) +(defcustom quickurl-sort-function #'quickurl-sort-urls "Function to sort the URL list." :type 'function :group 'quickurl) @@ -175,7 +170,6 @@ in your init file (after loading/requiring quickurl).") (defvar quickurl-list-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map t) (define-key map "a" #'quickurl-list-add-url) (define-key map [(control m)] #'quickurl-list-insert-url) (define-key map "u" #'quickurl-list-insert-naked-url) @@ -185,7 +179,6 @@ in your init file (after loading/requiring quickurl).") (define-key map [(control g)] #'quickurl-list-quit) (define-key map "q" #'quickurl-list-quit) (define-key map [mouse-2] #'quickurl-list-mouse-select) - (define-key map "?" #'describe-mode) map) "Local keymap for a `quickurl-list-mode' buffer.") @@ -253,7 +246,18 @@ returned." ;; Main code: -(cl-defun quickurl-read (&optional buffer) +(defun quickurl-format-url (url) + (format "<URL:%s>" (quickurl-url-url url))) + +(defun quickurl-sort-urls (list) + "Sort URLs in LIST according to their `quickurl-url-description'." + (sort list + (lambda (x y) + (string< + (downcase (quickurl-url-description x)) + (downcase (quickurl-url-description y)))))) + +(defun quickurl-read (&optional buffer) "`read' the URL list from BUFFER into `quickurl-urls'. BUFFER, if nil, defaults to current buffer. @@ -298,7 +302,7 @@ Also display a `message' saying what the URL was unless SILENT is non-nil." (message "Found %s" (quickurl-url-url url)))) ;;;###autoload -(cl-defun quickurl (&optional lookup) +(defun quickurl (&optional lookup) "Insert a URL based on LOOKUP. If not supplied LOOKUP is taken to be the word at point in the current @@ -347,7 +351,7 @@ It is assumed that the URL is either \"unguarded\" or is wrapped inside an ;; need to do a little more work to get to where we want to be. (when (thing-at-point-looking-at thing-at-point-markedup-url-regexp) (search-backward "<URL:")) - (backward-word 1) + (backward-word-strictly 1) (let ((word (funcall quickurl-grab-lookup-function))) (when word (quickurl-make-url @@ -427,17 +431,14 @@ current buffer, this default action can be modified via ;; quickurl-list mode. -(put 'quickurl-list-mode 'mode-class 'special) - ;;;###autoload -(define-derived-mode quickurl-list-mode fundamental-mode "quickurl list" +(define-derived-mode quickurl-list-mode special-mode "Quickurl" "A mode for browsing the quickurl URL list. The key bindings for `quickurl-list-mode' are: \\{quickurl-list-mode-map}" - (setq buffer-read-only t - truncate-lines t)) + (setq truncate-lines t)) ;;;###autoload (defun quickurl-list () @@ -459,14 +460,13 @@ The key bindings for `quickurl-list-mode' are: (fmt (format "%%-%ds %%s\n" (apply #'max sizes))) (inhibit-read-only t)) (erase-buffer) - (cl-loop for url in quickurl-urls - do (let ((start (point))) - (insert (format fmt (quickurl-url-description url) - (quickurl-url-url url))) - (add-text-properties - start (1- (point)) - '(mouse-face highlight - help-echo "mouse-2: insert this URL")))) + (dolist (url quickurl-urls) + (let ((start (point))) + (insert (format fmt (quickurl-url-description url) + (quickurl-url-url url))) + (add-text-properties + start (1- (point)) + '(mouse-face highlight help-echo "mouse-2: insert this URL")))) (goto-char (point-min))))) (defun quickurl-list-add-url (word url comment) @@ -477,9 +477,7 @@ The key bindings for `quickurl-list-mode' are: (defun quickurl-list-quit () "Kill the buffer named `quickurl-list-buffer-name'." (interactive) - (kill-buffer quickurl-list-buffer-name) - (switch-to-buffer quickurl-list-last-buffer) - (delete-other-windows)) + (quit-window t)) (defun quickurl-list-mouse-select (event) "Select the URL under the mouse click." diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f2c8c5d50c5..66e6326085c 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -611,10 +611,7 @@ If ARG is non-nil, instead prompt for connection parameters." `(with-current-buffer rcirc-server-buffer ,@body)) -(defalias 'rcirc-float-time - (if (featurep 'xemacs) - 'time-to-seconds - 'float-time)) +(define-obsolete-function-alias 'rcirc-float-time 'float-time "26.1") (defun rcirc-prompt-for-encryption (server-plist) "Prompt the user for the encryption method to use. @@ -638,7 +635,7 @@ last ping." (rcirc-send-ctcp process rcirc-nick (format "KEEPALIVE %f" - (rcirc-float-time)))))) + (float-time)))))) (rcirc-process-list)) ;; no processes, clean up timer (when (timerp rcirc-keepalive-timer) @@ -647,7 +644,7 @@ last ping." (defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) (with-rcirc-process-buffer process - (setq header-line-format (format "%f" (- (rcirc-float-time) + (setq header-line-format (format "%f" (- (float-time) (string-to-number message)))))) (defvar rcirc-debug-buffer "*rcirc debug*") @@ -2342,7 +2339,7 @@ With a prefix arg, prompt for new topic." (defun rcirc-ctcp-sender-PING (process target _request) "Send a CTCP PING message to TARGET." - (let ((timestamp (format "%.0f" (rcirc-float-time)))) + (let ((timestamp (format "%.0f" (float-time)))) (rcirc-send-ctcp process target "PING" timestamp))) (defun rcirc-cmd-me (args &optional process target) diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 55d5f007ac5..ea26a521afd 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -1,4 +1,4 @@ -;;; secrets.el --- Client interface to gnome-keyring and kwallet. +;;; secrets.el --- Client interface to gnome-keyring and kwallet. -*- lexical-binding: t -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -433,7 +433,7 @@ returned, and it will be stored in `secrets-session-path'." "Handler for signals emitted by `secrets-interface-service'." (cond ((string-equal (dbus-event-member-name last-input-event) "CollectionCreated") - (add-to-list 'secrets-collection-paths (car args))) + (cl-pushnew (car args) secrets-collection-paths)) ((string-equal (dbus-event-member-name last-input-event) "CollectionDeleted") (setq secrets-collection-paths (delete (car args) secrets-collection-paths))))) @@ -610,12 +610,11 @@ The object labels of the found items are returned as list." (error 'wrong-type-argument (car attributes))) (unless (stringp (cadr attributes)) (error 'wrong-type-argument (cadr attributes))) - (setq props (add-to-list - 'props + (setq props (append + props (list :dict-entry (substring (symbol-name (car attributes)) 1) - (cadr attributes)) - 'append) + (cadr attributes))) attributes (cddr attributes))) ;; Search. The result is a list of object paths. (setq result @@ -649,12 +648,11 @@ The object path of the created item is returned." (error 'wrong-type-argument (car attributes))) (unless (stringp (cadr attributes)) (error 'wrong-type-argument (cadr attributes))) - (setq props (add-to-list - 'props + (setq props (append + props (list :dict-entry (substring (symbol-name (car attributes)) 1) - (cadr attributes)) - 'append) + (cadr attributes))) attributes (cddr attributes))) ;; Create the item. (setq result @@ -734,33 +732,30 @@ If there is no such item, or the item doesn't own this attribute, return nil." ;;; Visualization. -(define-derived-mode secrets-mode nil "Secrets" +(defvar secrets-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap)) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "z" 'kill-this-buffer) + map) + "Keymap used in `secrets-mode' buffers.") + +(define-derived-mode secrets-mode special-mode "Secrets" "Major mode for presenting password entries retrieved by Security Service. In this mode, widgets represent the search results. \\{secrets-mode-map}" - ;; Keymap. - (setq secrets-mode-map (copy-keymap special-mode-map)) - (set-keymap-parent secrets-mode-map widget-keymap) - (define-key secrets-mode-map "z" 'kill-this-buffer) - + (setq buffer-undo-list t) + (set (make-local-variable 'revert-buffer-function) + #'secrets-show-collections) ;; When we toggle, we must set temporary widgets. (set (make-local-variable 'tree-widget-after-toggle-functions) - '(secrets-tree-widget-after-toggle-function)) - - (when (not (called-interactively-p 'interactive)) - ;; Initialize buffer. - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (erase-buffer)))) + '(secrets-tree-widget-after-toggle-function))) ;; It doesn't make sense to call it interactively. (put 'secrets-mode 'disabled t) -;; The very first buffer created with `secrets-mode' does not have the -;; keymap etc. So we create a dummy buffer. Stupid. -(with-temp-buffer (secrets-mode)) - ;; We autoload `secrets-show-secrets' only on systems with D-Bus support. ;;;###autoload(when (featurep 'dbusbind) ;;;###autoload (autoload 'secrets-show-secrets "secrets" nil t)) @@ -783,10 +778,9 @@ to their attributes." (secrets-mode) (secrets-show-collections)))) -(defun secrets-show-collections () +(defun secrets-show-collections (&optional _ignore _noconfirm) "Show all available collections." - (let ((inhibit-read-only t) - (alias (secrets-get-alias "default"))) + (let ((inhibit-read-only t)) (erase-buffer) (tree-widget-set-theme "folder") (dolist (coll (secrets-list-collections)) @@ -855,7 +849,7 @@ to their attributes." "%v\n")))) attributes)))) -(defun secrets-tree-widget-after-toggle-function (widget &rest ignore) +(defun secrets-tree-widget-after-toggle-function (widget &rest _ignore) "Add a temporary widget to show the password." (dolist (child (widget-get widget :children)) (when (widget-member child :secret) @@ -867,7 +861,7 @@ to their attributes." "Show password"))) (widget-setup)) -(defun secrets-tree-widget-show-password (widget &rest ignore) +(defun secrets-tree-widget-show-password (widget &rest _ignore) "Show password, and remove temporary widget." (let ((parent (widget-get widget :parent))) (widget-put parent :secret nil) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e463c7edaf2..9ea143da335 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1,4 +1,4 @@ -;;; shr.el --- Simple HTML Renderer +;;; shr.el --- Simple HTML Renderer -*- lexical-binding: t -*- ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. @@ -37,6 +37,7 @@ (require 'dom) (require 'seq) (require 'svg) +(require 'image) (defgroup shr nil "Simple HTML Renderer" @@ -67,7 +68,7 @@ fit these criteria." (defcustom shr-use-colors t "If non-nil, respect color specifications in the HTML." - :version "25.2" + :version "26.1" :group 'shr :type 'boolean) @@ -274,22 +275,19 @@ DOM should be a parse tree as generated by (set-window-hscroll nil 0) (shr-descend dom) (shr-fill-lines start (point)) - (shr-remove-trailing-whitespace start (point)) + (shr--remove-blank-lines-at-the-end start (point)) (when shr-warning (message "%s" shr-warning)))) -(defun shr-remove-trailing-whitespace (start end) - (let ((width (window-width))) - (save-restriction +(defun shr--remove-blank-lines-at-the-end (start end) + (save-restriction + (save-excursion (narrow-to-region start end) - (goto-char start) - (while (not (eobp)) - (end-of-line) - (when (> (shr-previous-newline-padding-width (current-column)) width) - (dolist (overlay (overlays-at (point))) - (when (overlay-get overlay 'before-string) - (overlay-put overlay 'before-string nil)))) - (forward-line 1))))) + (goto-char end) + (when (and (re-search-backward "[^ \n]" nil t) + (not (eobp))) + (forward-line 1) + (delete-region (point) (point-max)))))) (defun shr-copy-url (&optional image-url) "Copy the URL under point to the kill ring. @@ -299,8 +297,10 @@ image under point instead. If called twice, then try to fetch the URL and see whether it redirects somewhere else." (interactive "P") - (let ((url (or (get-text-property (point) 'shr-url) - (get-text-property (point) 'image-url)))) + (let ((url (if image-url + (get-text-property (point) 'image-url) + (or (get-text-property (point) 'shr-url) + (get-text-property (point) 'image-url))))) (cond ((not url) (message "No URL under point")) @@ -540,6 +540,9 @@ size, and full-buffer size." (current-column) (if (not (get-buffer-window (current-buffer))) (save-window-excursion + ;; Avoid errors if the selected window is a dedicated one, + ;; and they just want to insert a document into it. + (set-window-dedicated-p nil nil) (set-window-buffer nil (current-buffer)) (car (window-text-pixel-size nil (line-beginning-position) (point)))) (car (window-text-pixel-size nil (line-beginning-position) (point)))))) @@ -557,6 +560,16 @@ size, and full-buffer size." (insert string) (shr-pixel-column)))) +(defsubst shr--translate-insertion-chars () + ;; Remove soft hyphens. + (goto-char (point-min)) + (while (search-forward "" nil t) + (replace-match "" t t)) + ;; Translate non-breaking spaces into real spaces. + (goto-char (point-min)) + (while (search-forward " " nil t) + (replace-match " " t t))) + (defun shr-insert (text) (when (and (not (bolp)) (get-text-property (1- (point)) 'image-url)) @@ -567,14 +580,11 @@ size, and full-buffer size." (insert text) (save-restriction (narrow-to-region start (point)) - ;; Remove soft hyphens. - (goto-char (point-min)) - (while (search-forward "" nil t) - (replace-match "" t t)) + (shr--translate-insertion-chars) (goto-char (point-max))))) (t (let ((font-start (point))) - (when (and (string-match "\\`[ \t\n\r ]" text) + (when (and (string-match "\\`[ \t\n\r]" text) (not (bolp)) (not (eq (char-after (1- (point))) ? ))) (insert " ")) @@ -584,14 +594,11 @@ size, and full-buffer size." (save-restriction (narrow-to-region start (point)) (goto-char start) - (when (looking-at "[ \t\n\r ]+") + (when (looking-at "[ \t\n\r]+") (replace-match "" t t)) - (while (re-search-forward "[ \t\n\r ]+" nil t) + (while (re-search-forward "[ \t\n\r]+" nil t) (replace-match " " t t)) - ;; Remove soft hyphens. - (goto-char (point-min)) - (while (search-forward "" nil t) - (replace-match "" t t)) + (shr--translate-insertion-chars) (goto-char (point-max))) ;; We may have removed everything we inserted if if was just ;; spaces. @@ -658,13 +665,12 @@ size, and full-buffer size." ;; Success; continue. (when (= (preceding-char) ?\s) (delete-char -1)) - (let ((face (get-text-property (point) 'face)) - (background-start (point))) + (let ((props (text-properties-at (point))) + (gap-start (point))) (insert "\n") (shr-indent) - (when face - (put-text-property background-start (point) 'face - `,(shr-face-background face)))) + (when props + (add-text-properties gap-start (point) props))) (setq start (point)) (shr-vertical-motion shr-internal-width) (when (looking-at " $") @@ -785,11 +791,12 @@ size, and full-buffer size." ;; Strip leading whitespace (and url (string-match "\\`\\s-+" url) (setq url (substring url (match-end 0)))) - (cond ((or (not url) - (not base) + (cond ((zerop (length url)) + (nth 3 base)) + ((or (not base) (string-match "\\`[a-z]*:" url)) ;; Absolute or empty URI - (or url (nth 3 base))) + url) ((eq (aref url 0) ?/) (if (and (> (length url) 1) (eq (aref url 1) ?/)) @@ -805,8 +812,13 @@ size, and full-buffer size." (url-expand-file-name url (concat (car base) (cadr base)))))) (defun shr-ensure-newline () - (unless (zerop (current-column)) - (insert "\n"))) + (unless (bobp) + (let ((prefix (get-text-property (line-beginning-position) + 'shr-prefix-length))) + (unless (or (zerop (current-column)) + (and prefix + (= prefix (- (point) (line-beginning-position))))) + (insert "\n"))))) (defun shr-ensure-paragraph () (unless (bobp) @@ -834,6 +846,10 @@ size, and full-buffer size." (line-end-position)) (line-end-position))))) (delete-region (match-beginning 0) (match-end 0))) + ;; We have a single blank line. + ((and (eolp) (bolp)) + (insert "\n")) + ;; Insert new paragraph. (t (insert "\n\n")))))) @@ -937,7 +953,8 @@ If EXTERNAL, browse the URL using `shr-external-browser'." (let ((param (match-string 4 data)) (payload (url-unhex-string (match-string 5 data)))) (when (string-match "^.*\\(;[ \t]*base64\\)$" param) - (setq payload (base64-decode-string payload))) + (setq payload (ignore-errors + (base64-decode-string payload)))) payload))) ;; Behind display-graphic-p test. @@ -997,22 +1014,25 @@ element is the data blob and the second element is the content-type." (defun shr-rescale-image (data content-type width height) "Rescale DATA, if too big, to fit the current buffer. WIDTH and HEIGHT are the sizes given in the HTML data, if any." - (if (not (and (fboundp 'imagemagick-types) - (get-buffer-window (current-buffer)))) + (if (or (not (fboundp 'imagemagick-types)) + (not (get-buffer-window (current-buffer)))) (create-image data nil t :ascent 100) (let* ((edges (window-inside-pixel-edges (get-buffer-window (current-buffer)))) (max-width (truncate (* shr-max-image-proportion (- (nth 2 edges) (nth 0 edges))))) (max-height (truncate (* shr-max-image-proportion - (- (nth 3 edges) (nth 1 edges)))))) + (- (nth 3 edges) (nth 1 edges))))) + (scaling (image-compute-scaling-factor image-scaling-factor))) (when (or (and width (> width max-width)) (and height (> height max-height))) (setq width nil height nil)) - (if (and width height) + (if (and width height + (< (* width scaling) max-width) + (< (* height scaling) max-height)) (create-image data 'imagemagick t :ascent 100 @@ -1158,18 +1178,6 @@ ones, in case fg and bg are nil." t))) new-colors))) -(defun shr-previous-newline-padding-width (width) - (let ((overlays (overlays-at (point))) - (previous-width 0)) - (if (null overlays) - width - (dolist (overlay overlays) - (setq previous-width - (+ previous-width - (length (plist-get (overlay-properties overlay) - 'before-string))))) - (+ width previous-width)))) - ;;; Tag-specific rendering rules. (defun shr-tag-html (dom) @@ -1259,7 +1267,7 @@ ones, in case fg and bg are nil." (shr-ensure-paragraph)) (defun shr-tag-div (dom) - (shr-ensure-paragraph) + (shr-ensure-newline) (shr-generic dom) (shr-ensure-newline)) @@ -1446,13 +1454,14 @@ The preference is a float determined from `shr-prefer-media-type'." (defun shr-tag-img (dom &optional url) (when (or url (and dom - (> (length (dom-attr dom 'src)) 0))) + (or (> (length (dom-attr dom 'src)) 0) + (> (length (dom-attr dom 'srcset)) 0)))) (when (> (current-column) 0) (insert "\n")) (let ((alt (dom-attr dom 'alt)) (width (shr-string-number (dom-attr dom 'width))) (height (shr-string-number (dom-attr dom 'height))) - (url (shr-expand-url (or url (dom-attr dom 'src))))) + (url (shr-expand-url (or url (shr--preferred-image dom))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "*")) @@ -1512,6 +1521,45 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-fill-text (or (dom-attr dom 'title) alt)))))))) +(defun shr--preferred-image (dom) + (let ((srcset (dom-attr dom 'srcset)) + (frame-width (frame-pixel-width)) + (width (string-to-number (or (dom-attr dom 'width) "100"))) + candidate) + (when (> (length srcset) 0) + ;; srcset consist of a series of URL/size specifications + ;; separated by the ", " string. + (setq srcset + (sort (mapcar + (lambda (elem) + (let ((spec (split-string elem "[\t\n\r ]+"))) + (cond + ((= (length spec) 1) + ;; Make sure it's well formed. + (list (car spec) 0)) + ((string-match "\\([0-9]+\\)x\\'" (cadr spec)) + ;; If we have an "x" form, then use the width + ;; spec to compute the real width. + (list (car spec) + (* width (string-to-number + (match-string 1 (cadr spec)))))) + (t + (list (car spec) + (string-to-number (cadr spec))))))) + (split-string (replace-regexp-in-string + "\\`[\t\n\r ]+\\|[\t\n\r ]+\\'" "" srcset) + "[\t\n\r ]*,[\t\n\r ]*")) + (lambda (e1 e2) + (> (cadr e1) (cadr e2))))) + ;; Choose the smallest picture that's bigger than the current + ;; frame. + (setq candidate (caar srcset)) + (while (and srcset + (> (cadr (car srcset)) frame-width)) + (setq candidate (caar srcset)) + (pop srcset))) + (or candidate (dom-attr dom 'src)))) + (defun shr-string-number (string) (if (null string) nil @@ -1539,7 +1587,7 @@ The preference is a float determined from `shr-prefer-media-type'." (max-height (and edges (truncate (* shr-max-image-proportion (- (nth 3 edges) (nth 1 edges)))))) - svg image) + svg) (when (and max-width (> width max-width)) (setq height (truncate (* (/ (float max-width) width) height)) @@ -1592,6 +1640,10 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-ensure-paragraph) (let ((shr-list-mode 'ul)) (shr-generic dom)) + ;; If we end on an empty <li>, then make sure we really end on a new + ;; paragraph. + (unless (bolp) + (insert "\n")) (shr-ensure-paragraph)) (defun shr-tag-ol (dom) @@ -1618,7 +1670,9 @@ The preference is a float determined from `shr-prefer-media-type'." (put-text-property start (1+ start) 'shr-continuation-indentation shr-indentation) (put-text-property start (1+ start) 'shr-prefix-length (length bullet)) - (shr-generic dom))))) + (shr-generic dom)))) + (unless (bolp) + (insert "\n"))) (defun shr-mark-fill (start) ;; We may not have inserted any text to fill. @@ -1685,19 +1739,19 @@ The preference is a float determined from `shr-prefer-media-type'." (let* ((direction (dom-attr dom 'dir)) (char (cond ((equal direction "ltr") - #x202d) ; LRO + ?\N{LEFT-TO-RIGHT OVERRIDE}) ((equal direction "rtl") - #x202e)))) ; RLO + ?\N{RIGHT-TO-LEFT OVERRIDE})))) (when char - (insert char)) + (insert ?\N{FIRST STRONG ISOLATE} char)) (shr-generic dom) (when char - (insert #x202c)))) ; PDF + (insert ?\N{POP DIRECTIONAL FORMATTING} ?\N{POP DIRECTIONAL ISOLATE})))) (defun shr-tag-bdi (dom) - (insert #x2068) ; FSI + (insert ?\N{FIRST STRONG ISOLATE}) (shr-generic dom) - (insert #x2069)) ; PDI + (insert ?\N{POP DIRECTIONAL ISOLATE})) ;;; Table rendering algorithm. @@ -1844,14 +1898,62 @@ The preference is a float determined from `shr-prefer-media-type'." bgcolor)) ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually - ;; into the tables. + ;; into the tables. It inserts also non-td/th objects. (when (zerop shr-table-depth) (save-excursion (shr-expand-alignments start (point))) - (dolist (elem (dom-by-tag dom 'object)) - (shr-tag-object elem)) - (dolist (elem (dom-by-tag dom 'img)) - (shr-tag-img elem))))) + (let ((strings (shr-collect-extra-strings-in-table dom))) + (when strings + (save-restriction + (narrow-to-region (point) (point)) + (insert (mapconcat #'identity strings "\n")) + (shr-fill-lines (point-min) (point-max)))))))) + +(defun shr-collect-extra-strings-in-table (dom &optional flags) + "Return extra strings in DOM of which the root is a table clause. +Render <img>s and <object>s, and strings and child <table>s of which +the parent <td> or <th> is lacking. FLAGS is a cons of two boolean +flags that control whether to collect or render objects." + ;; This function runs recursively and collects strings if the cdr of + ;; FLAGS is nil and the car is not nil, and it renders also child + ;; <table>s if the cdr is nil. Note: FLAGS may be nil, not a cons. + ;; FLAGS becomes (t . nil) if a <tr> clause is found in the children + ;; of DOM, and becomes (t . t) if a <td> or a <th> clause is found + ;; and the car is t then. When a <table> clause is found, FLAGS + ;; becomes nil if the cdr is t then. But if FLAGS is (t . nil) then, + ;; it renders the <table>. + (cl-loop for child in (dom-children dom) with recurse with tag + do (setq recurse nil) + if (stringp child) + unless (or (not (car flags)) (cdr flags)) + when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+" + child) + collect (match-string 0 child) + end end + else if (consp child) + do (setq tag (dom-tag child)) and + unless (memq tag '(comment style)) + if (eq tag 'img) + do (shr-tag-img child) + else if (eq tag 'object) + do (shr-tag-object child) + else + do (setq recurse t) and + if (eq tag 'tr) + do (setq flags '(t . nil)) + else if (memq tag '(td th)) + when (car flags) + do (setq flags '(t . t)) + end + else if (eq tag 'table) + if (cdr flags) + do (setq flags nil) + else if (car flags) + do (setq recurse nil) + (shr-tag-table child) + end end end end end end end end end end + when recurse + append (shr-collect-extra-strings-in-table child flags))) (defun shr-insert-table (table widths) (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet)) @@ -1870,7 +1972,7 @@ The preference is a float determined from `shr-prefer-media-type'." (dolist (column row) (setq max (max max (nth 2 column)))) max))) - (dotimes (i (max height 1)) + (dotimes (_ (max height 1)) (shr-indent) (insert shr-table-vertical-line "\n")) (dolist (column row) @@ -1878,7 +1980,7 @@ The preference is a float determined from `shr-prefer-media-type'." (goto-char start) ;; Sum up all the widths from the column. (There may be ;; more than one if this is a "colspan" column.) - (dotimes (i (nth 4 column)) + (dotimes (_ (nth 4 column)) ;; The colspan directive may be wrong and there may not be ;; that number of columns. (when (<= column-number (1- (length widths))) @@ -1909,7 +2011,7 @@ The preference is a float determined from `shr-prefer-media-type'." (forward-line 1)) ;; Add blank lines at padding at the bottom of the TD, ;; possibly. - (dotimes (i (- height (length lines))) + (dotimes (_ (- height (length lines))) (end-of-line) (let ((start (point))) (insert (propertize " " @@ -2091,7 +2193,7 @@ The preference is a float determined from `shr-prefer-media-type'." (push data tds))))) (when (and colspan (> colspan 1)) - (dotimes (c (1- colspan)) + (dotimes (_ (1- colspan)) (setq i (1+ i)) (push (if fill diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 695bbd860de..8f7bd449284 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -146,6 +146,12 @@ for doing the actual authentication." :type 'symbol :group 'sieve-manage) +(defcustom sieve-manage-ignore-starttls nil + "Ignore STARTTLS even if STARTTLS capability is provided." + :version "26.1" + :type 'boolean + :group 'sieve-manage) + ;; Internal variables: (defconst sieve-manage-local-variables '(sieve-manage-server @@ -210,14 +216,16 @@ Return the buffer associated with the connection." :return-list t :starttls-function (lambda (capabilities) - (when (string-match "\\bSTARTTLS\\b" capabilities) - "STARTTLS\r\n"))) + (when (and (not sieve-manage-ignore-starttls) + (string-match "\\bSTARTTLS\\b" capabilities)) + "STARTTLS\r\n"))) (setq sieve-manage-process proc) (setq sieve-manage-capability (sieve-manage-parse-capability (plist-get props :capabilities))) ;; Ignore new capabilities issues after successful STARTTLS - (when (and (memq stream '(nil network starttls)) - (eq (plist-get props :type) 'tls)) + (when (or sieve-manage-ignore-starttls + (and (memq stream '(nil network starttls)) + (eq (plist-get props :type) 'tls))) (sieve-manage-drop-next-answer)) (current-buffer)))) diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index 7575ba67c5e..6aa1b207ee2 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -57,14 +57,10 @@ (defcustom sieve-mode-hook nil "Hook run in sieve mode buffers." - :group 'sieve :type 'hook) ;; Font-lock -(defvar sieve-control-commands-face 'sieve-control-commands - "Face name used for Sieve Control Commands.") - (defface sieve-control-commands '((((type tty) (class color)) (:foreground "blue" :weight light)) (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) @@ -72,28 +68,14 @@ (((class color) (background light)) (:foreground "Orchid")) (((class color) (background dark)) (:foreground "LightSteelBlue")) (t (:bold t))) - "Face used for Sieve Control Commands." - :group 'sieve) -;; backward-compatibility alias -(put 'sieve-control-commands-face 'face-alias 'sieve-control-commands) -(put 'sieve-control-commands-face 'obsolete-face "22.1") - -(defvar sieve-action-commands-face 'sieve-action-commands - "Face name used for Sieve Action Commands.") + "Face used for Sieve Control Commands.") (defface sieve-action-commands '((((type tty) (class color)) (:foreground "blue" :weight bold)) (((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) (t (:inverse-video t :bold t))) - "Face used for Sieve Action Commands." - :group 'sieve) -;; backward-compatibility alias -(put 'sieve-action-commands-face 'face-alias 'sieve-action-commands) -(put 'sieve-action-commands-face 'obsolete-face "22.1") - -(defvar sieve-test-commands-face 'sieve-test-commands - "Face name used for Sieve Test Commands.") + "Face used for Sieve Action Commands.") (defface sieve-test-commands '((((type tty) (class color)) (:foreground "magenta")) @@ -104,14 +86,7 @@ (((class color) (background light)) (:foreground "CadetBlue")) (((class color) (background dark)) (:foreground "Aquamarine")) (t (:bold t :underline t))) - "Face used for Sieve Test Commands." - :group 'sieve) -;; backward-compatibility alias -(put 'sieve-test-commands-face 'face-alias 'sieve-test-commands) -(put 'sieve-test-commands-face 'obsolete-face "22.1") - -(defvar sieve-tagged-arguments-face 'sieve-tagged-arguments - "Face name used for Sieve Tagged Arguments.") + "Face used for Sieve Test Commands.") (defface sieve-tagged-arguments '((((type tty) (class color)) (:foreground "cyan" :weight bold)) @@ -120,11 +95,7 @@ (((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) (t (:bold t))) - "Face used for Sieve Tagged Arguments." - :group 'sieve) -;; backward-compatibility alias -(put 'sieve-tagged-arguments-face 'face-alias 'sieve-tagged-arguments) -(put 'sieve-tagged-arguments-face 'obsolete-face "22.1") + "Face used for Sieve Tagged Arguments.") (defconst sieve-font-lock-keywords @@ -133,44 +104,43 @@ ;; control commands (cons (regexp-opt '("require" "if" "else" "elsif" "stop") 'words) - 'sieve-control-commands-face) + 'sieve-control-commands) ;; action commands (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard") 'words) - 'sieve-action-commands-face) + 'sieve-action-commands) ;; test commands (cons (regexp-opt '("address" "allof" "anyof" "exists" "false" "true" "header" "not" "size" "envelope" "body") 'words) - 'sieve-test-commands-face) + 'sieve-test-commands) (cons "\\Sw+:\\sw+" - 'sieve-tagged-arguments-face)))) + 'sieve-tagged-arguments)))) ;; Syntax table -(defvar sieve-mode-syntax-table nil +(defvar sieve-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?\n "> " st) + (modify-syntax-entry ?\f "> " st) + (modify-syntax-entry ?\# "< " st) + (modify-syntax-entry ?/ ". 14" st) + (modify-syntax-entry ?* ". 23b" st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?- "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?% "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?| "." st) + (modify-syntax-entry ?_ "_" st) + (modify-syntax-entry ?\' "\"" st) + st) "Syntax table in use in sieve-mode buffers.") -(if sieve-mode-syntax-table - () - (setq sieve-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table) - (modify-syntax-entry ?\n "> " sieve-mode-syntax-table) - (modify-syntax-entry ?\f "> " sieve-mode-syntax-table) - (modify-syntax-entry ?\# "< " sieve-mode-syntax-table) - (modify-syntax-entry ?/ "." sieve-mode-syntax-table) - (modify-syntax-entry ?* "." sieve-mode-syntax-table) - (modify-syntax-entry ?+ "." sieve-mode-syntax-table) - (modify-syntax-entry ?- "." sieve-mode-syntax-table) - (modify-syntax-entry ?= "." sieve-mode-syntax-table) - (modify-syntax-entry ?% "." sieve-mode-syntax-table) - (modify-syntax-entry ?< "." sieve-mode-syntax-table) - (modify-syntax-entry ?> "." sieve-mode-syntax-table) - (modify-syntax-entry ?& "." sieve-mode-syntax-table) - (modify-syntax-entry ?| "." sieve-mode-syntax-table) - (modify-syntax-entry ?_ "_" sieve-mode-syntax-table) - (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table)) ;; Key map definition @@ -182,13 +152,40 @@ map) "Key map used in sieve mode.") -;; Menu definition +;; Menu -(defvar sieve-mode-menu nil - "Menubar used in sieve mode.") +(easy-menu-define sieve-mode-menu sieve-mode-map + "Sieve Menu." + '("Sieve" + ["Upload script" sieve-upload t] + ["Manage scripts on server" sieve-manage t])) ;; Code for Sieve editing mode. -(autoload 'easy-menu-add-item "easymenu") + + +(defun sieve-syntax-propertize (beg end) + (goto-char beg) + (sieve-syntax-propertize-text end) + (funcall + (syntax-propertize-rules + ;; FIXME: When there's a "text:" with a # comment, the \n plays dual role: + ;; it closes the comment and starts the string. This is problematic for us + ;; since syntax-table entries can either close a comment or + ;; delimit a string, but not both. + ("\\_<text:[ \t]*\\(?:#.*\\(.\\)\\)?\\(\n\\)" + (1 ">") + (2 (prog1 (unless (save-excursion + (nth 8 (syntax-ppss (match-beginning 0)))) + (string-to-syntax "|")) + (sieve-syntax-propertize-text end))))) + beg end)) + +(defun sieve-syntax-propertize-text (end) + (let ((ppss (syntax-ppss))) + (when (and (eq t (nth 3 ppss)) + (re-search-forward "^\\.\\(\n\\)" end 'move)) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|"))))) ;;;###autoload (define-derived-mode sieve-mode c-mode "Sieve" @@ -204,18 +201,12 @@ Turning on Sieve mode runs `sieve-mode-hook'." (set (make-local-variable 'comment-end) "") ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") (set (make-local-variable 'comment-start-skip) "#+ *") + (set (make-local-variable 'syntax-propertize-function) + #'sieve-syntax-propertize) (set (make-local-variable 'font-lock-defaults) '(sieve-font-lock-keywords nil nil ((?_ . "w")))) (easy-menu-add-item nil nil sieve-mode-menu)) -;; Menu - -(easy-menu-define sieve-mode-menu sieve-mode-map - "Sieve Menu." - '("Sieve" - ["Upload script" sieve-upload t] - ["Manage scripts on server" sieve-manage t])) - (provide 'sieve-mode) ;; sieve-mode.el ends here diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 2046e53697d..d126d84c5de 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -207,7 +207,8 @@ require \"fileinto\"; err) (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer)) (switch-to-buffer newbuf) - (unless (sieve-manage-ok-p err) + (if (sieve-manage-ok-p err) + (set-buffer-modified-p nil) (error "Sieve download failed: %s" err))) (switch-to-buffer (get-buffer-create "template.siv")) (insert sieve-template)) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 74024644966..f8973a3a537 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Created: December, 2009 -;; Version: 3.0.2 +;; Version: 3.1.1 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client @@ -538,7 +538,7 @@ This is a specialization of `soap-encode-value' for (base64Binary (unless (stringp value) (error "Not a string value for base64Binary")) - (base64-encode-string (encode-coding-string value 'utf-8))) + (base64-encode-string value)) (otherwise (error "Don't know how to encode %s for type %s" @@ -682,7 +682,7 @@ This is a specialization of `soap-decode-type' for decimal byte float double duration) (string-to-number (car contents))) (boolean (string= (downcase (car contents)) "true")) - (base64Binary (decode-coding-string (base64-decode-string (car contents)) 'utf-8)) + (base64Binary (base64-decode-string (car contents))) (anyType (soap-decode-any-type node)) (Array (soap-decode-array node)))))) @@ -1249,8 +1249,8 @@ See also `soap-wsdl-resolve-references'." (when messages (error (mapconcat 'identity (nreverse messages) "; and: ")))) (cl-labels ((fail-with-message (format value) - (push (format format value) messages) - (throw 'invalid nil))) + (push (format format value) messages) + (throw 'invalid nil))) (catch 'invalid (let ((enumeration (soap-xs-simple-type-enumeration type))) (when (and (> (length enumeration) 1) @@ -1630,7 +1630,7 @@ This is a specialization of `soap-encode-value' for `soap-xs-complex-type' objects." (case (soap-xs-complex-type-indicator type) (array - (error "soap-encode-xs-complex-type arrays are handled elsewhere")) + (error "Arrays of type soap-encode-xs-complex-type are handled elsewhere")) ((sequence choice all nil) (let ((type-list (list type))) @@ -2999,6 +2999,33 @@ http://schemas.xmlsoap.org/soap/encoding/\"\n")) :type 'boolean :group 'soap-client) +(defun soap-find-port (wsdl service) + "Return the WSDL port having SERVICE name. +Signal an error if not found." + (or (catch 'found + (dolist (p (soap-wsdl-ports wsdl)) + (when (equal service (soap-element-name p)) + (throw 'found p)))) + (error "Unknown SOAP service: %s" service))) + +(defun soap-find-operation (port operation-name) + "Inside PORT, find OPERATION-NAME, a `soap-port-type'. +Signal an error if not found." + (let* ((binding (soap-port-binding port)) + (op (gethash operation-name (soap-binding-operations binding)))) + (or op + (error "No operation %s for SOAP service %s" + operation-name (soap-element-name port))))) + +(defun soap-operation-arity (wsdl service operation-name) + "Return the number of arguments required by a soap operation. +WSDL, SERVICE, OPERATION-NAME and PARAMETERS are as described in +`soap-invoke'." + (let* ((port (soap-find-port wsdl service)) + (op (soap-find-operation port operation-name)) + (bop (soap-bound-operation-operation op))) + (length (soap-operation-parameter-order bop)))) + (defun soap-invoke-internal (callback cbargs wsdl service operation-name &rest parameters) "Implement `soap-invoke' and `soap-invoke-async'. @@ -3006,54 +3033,43 @@ If CALLBACK is non-nil, operate asynchronously, then call CALLBACK as (apply CALLBACK RESPONSE CBARGS), where RESPONSE is the SOAP invocation result. If CALLBACK is nil, operate synchronously. WSDL, SERVICE, OPERATION-NAME and PARAMETERS are as described in `soap-invoke'." - (let ((port (catch 'found - (dolist (p (soap-wsdl-ports wsdl)) - (when (equal service (soap-element-name p)) - (throw 'found p)))))) - (unless port - (error "Unknown SOAP service: %s" service)) - - (let* ((binding (soap-port-binding port)) - (operation (gethash operation-name - (soap-binding-operations binding)))) - (unless operation - (error "No operation %s for SOAP service %s" operation-name service)) - - (let ((url-request-method "POST") - (url-package-name "soap-client.el") - (url-package-version "1.0") - (url-request-data - ;; url-request-data expects a unibyte string already encoded... - (encode-coding-string - (soap-create-envelope operation parameters wsdl - (soap-port-service-url port)) - 'utf-8)) - (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") - (url-http-attempt-keepalives t) - (url-request-extra-headers - (list - (cons "SOAPAction" - (concat "\"" (soap-bound-operation-soap-action - operation) "\"")) - (cons "Content-Type" - "text/xml; charset=utf-8")))) - (if callback - (url-retrieve - (soap-port-service-url port) - (lambda (status) - (let ((data-buffer (current-buffer))) - (unwind-protect - (let ((error-status (plist-get status :error))) - (if error-status - (signal (car error-status) (cdr error-status)) - (apply callback - (soap-parse-envelope - (soap-parse-server-response) - operation wsdl) - cbargs))) - ;; Ensure the url-retrieve buffer is not leaked. - (and (buffer-live-p data-buffer) - (kill-buffer data-buffer)))))) + (let* ((port (soap-find-port wsdl service)) + (operation (soap-find-operation port operation-name))) + (let ((url-request-method "POST") + (url-package-name "soap-client.el") + (url-package-version "1.0") + (url-request-data + ;; url-request-data expects a unibyte string already encoded... + (encode-coding-string + (soap-create-envelope operation parameters wsdl + (soap-port-service-url port)) + 'utf-8)) + (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") + (url-http-attempt-keepalives t) + (url-request-extra-headers + (list + (cons "SOAPAction" + (concat "\"" (soap-bound-operation-soap-action + operation) "\"")) + (cons "Content-Type" + "text/xml; charset=utf-8")))) + (if callback + (url-retrieve + (soap-port-service-url port) + (lambda (status) + (let ((data-buffer (current-buffer))) + (unwind-protect + (let ((error-status (plist-get status :error))) + (if error-status + (signal (car error-status) (cdr error-status)) + (apply callback + (soap-parse-envelope + (soap-parse-server-response) + operation wsdl) + cbargs))) + ;; Ensure the url-retrieve buffer is not leaked. + (and (buffer-live-p data-buffer) + (kill-buffer data-buffer)))))) (let ((buffer (url-retrieve-synchronously (soap-port-service-url port)))) (condition-case err @@ -3077,7 +3093,7 @@ OPERATION-NAME and PARAMETERS are as described in `soap-invoke'." (error (when soap-debug (pop-to-buffer buffer)) - (error (error-message-string err)))))))))) + (error (error-message-string err))))))))) (defun soap-invoke (wsdl service operation-name &rest parameters) "Invoke a SOAP operation and return the result. @@ -3096,7 +3112,11 @@ the SOAP request. NOTE: The SOAP service provider should document the available operations and their parameters for the service. You can also use the `soap-inspect' function to browse the available -operations in a WSDL document." +operations in a WSDL document. + +NOTE: `soap-invoke' base64-decodes xsd:base64Binary return values +into unibyte strings; these byte-strings require further +interpretation by the caller." (apply #'soap-invoke-internal nil nil wsdl service operation-name parameters)) (defun soap-invoke-async (callback cbargs wsdl service operation-name diff --git a/lisp/net/starttls.el b/lisp/net/starttls.el index 096ed2adc0d..b9255901f97 100644 --- a/lisp/net/starttls.el +++ b/lisp/net/starttls.el @@ -136,7 +136,7 @@ i.e. when `starttls-use-gnutls' is nil." :group 'starttls) (defcustom starttls-use-gnutls (not (executable-find starttls-program)) - "*Whether to use GnuTLS instead of the `starttls' command." + "Whether to use GnuTLS instead of the `starttls' command." :version "22.1" :type 'boolean :group 'starttls) @@ -153,20 +153,20 @@ These apply when the `starttls' command is used, i.e. when These apply when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil. For example, non-TLS compliant servers may require -'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to +\(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to find out which parameters are available." :version "22.1" :type '(repeat string) :group 'starttls) (defcustom starttls-process-connection-type nil - "*Value for `process-connection-type' to use when starting STARTTLS process." + "Value for `process-connection-type' to use when starting STARTTLS process." :version "22.1" :type 'boolean :group 'starttls) (defcustom starttls-connect "- Simple Client Mode:\n\n" - "*Regular expression indicating successful connection. + "Regular expression indicating successful connection. The default is what GnuTLS's \"gnutls-cli\" outputs." ;; GnuTLS cli.c:main() prints this string when it is starting to run ;; in the application read/write phase. If the logic, or the string @@ -176,7 +176,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs." :group 'starttls) (defcustom starttls-failure "\\*\\*\\* Handshake has failed" - "*Regular expression indicating failed TLS handshake. + "Regular expression indicating failed TLS handshake. The default is what GnuTLS's \"gnutls-cli\" outputs." ;; GnuTLS cli.c:do_handshake() prints this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. @@ -185,7 +185,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs." :group 'starttls) (defcustom starttls-success "- Compression: " - "*Regular expression indicating completed TLS handshakes. + "Regular expression indicating completed TLS handshakes. The default is what GnuTLS's \"gnutls-cli\" outputs." ;; GnuTLS cli.c:do_handshake() calls, on success, ;; common.c:print_info(), that unconditionally print this string diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 5940b713958..f03f50bb009 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -40,7 +40,8 @@ "Name of the Android Debug Bridge program." :group 'tramp :version "24.4" - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-adb-connect-if-not-connected nil @@ -48,11 +49,12 @@ It is used for TCP/IP devices." :group 'tramp :version "25.1" - :type 'boolean) + :type 'boolean + :require 'tramp) ;;;###tramp-autoload (defconst tramp-adb-method "adb" - "*When this method name is used, forward all calls to Android Debug Bridge.") + "When this method name is used, forward all calls to Android Debug Bridge.") ;;;###tramp-autoload (defcustom tramp-adb-prompt @@ -60,10 +62,12 @@ It is used for TCP/IP devices." "Regexp used as prompt in almquist shell." :type 'string :version "24.4" - :group 'tramp) + :group 'tramp + :require 'tramp) (defconst tramp-adb-ls-date-regexp - "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]") + "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]" + "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp (concat @@ -72,7 +76,8 @@ It is used for TCP/IP devices." "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date - "[[:space:]]\\(.*\\)$")) ; \6 filename + "[[:space:]]\\(.*\\)$") ; \6 filename + "Regexp for ls output.") ;;;###tramp-autoload (add-to-list 'tramp-methods @@ -121,6 +126,7 @@ It is used for TCP/IP devices." (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-adb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -146,6 +152,7 @@ It is used for TCP/IP devices." (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-symbolic-link . tramp-handle-make-symbolic-link) (process-file . tramp-adb-handle-process-file) (rename-file . tramp-adb-handle-rename-file) @@ -157,6 +164,7 @@ It is used for TCP/IP devices." (shell-command . tramp-adb-handle-shell-command) (start-file-process . tramp-adb-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) @@ -195,7 +203,7 @@ pass to the OPERATION." result) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (set-process-query-on-exit-flag p nil) - (while (eq 'run (process-status p)) + (while (tramp-compat-process-live-p p) (accept-process-output p 0.1)) (accept-process-output p 0.1) (tramp-message v 6 "\n%s" (buffer-string)) @@ -239,7 +247,9 @@ pass to the OPERATION." (defun tramp-adb-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (car (file-attributes (file-truename filename)))) + (eq (tramp-compat-file-attribute-type + (file-attributes (file-truename filename))) + t)) ;; This is derived from `tramp-sh-handle-file-truename'. Maybe the ;; code could be shared? @@ -274,14 +284,15 @@ pass to the OPERATION." (append '("") (reverse result) (list thisstep)) "/")) (setq symlink-target - (nth 0 (file-attributes - (tramp-make-tramp-file-name - method user host - (mapconcat 'identity - (append '("") - (reverse result) - (list thisstep)) - "/"))))) + (tramp-compat-file-attribute-type + (file-attributes + (tramp-make-tramp-file-name + method user host + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) (cond ((string= "." thisstep) (tramp-message v 5 "Ignoring step `.'")) ((string= ".." thisstep) @@ -424,6 +435,7 @@ pass to the OPERATION." result))))))))) (defun tramp-adb-get-ls-command (vec) + "Determine `ls' command at its arguments." (with-tramp-connection-property vec "ls" (tramp-message vec 5 "Finding a suitable `ls' command") (if (tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") @@ -433,8 +445,7 @@ pass to the OPERATION." "ls --color=never" "ls"))) -(defun tramp-adb--gnu-switches-to-ash - (switches) +(defun tramp-adb--gnu-switches-to-ash (switches) "Almquist shell can't handle multiple arguments. Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." (split-string @@ -535,7 +546,7 @@ Emacs dired can't find files." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (tramp-adb-send-command @@ -561,7 +572,7 @@ Emacs dired can't find files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) (tramp-error - v 'file-error + v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter @@ -662,7 +673,7 @@ But handle the case, if the \"test\" command is not available." (defun tramp-adb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - _preserve-uid-gid _preserve-extended-attributes) + _preserve-uid-gid _preserve-extended-attributes) "Like `copy-file' for Tramp files. PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq filename (expand-file-name filename) @@ -705,7 +716,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; KEEP-DATE handling. (when keep-date - (set-file-times newname (nth 5 (file-attributes filename)))))) + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))))) (defun tramp-adb-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -884,7 +898,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-user-error p "Shell command in progress"))) + (tramp-compat-user-error p "Shell command in progress"))) (if current-buffer-p (progn @@ -934,20 +948,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (unless (stringp program) (tramp-error v 'file-error "PROGRAM must be a string")) - (let ((command - (format "cd %s; %s" - (tramp-shell-quote-argument localname) - (mapconcat 'tramp-shell-quote-argument - (cons program args) " "))) - (tramp-process-connection-type - (or (null program) tramp-process-connection-type)) - (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) - (name1 name) - (i 0)) - - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + (command + (format "cd %s; %s" + (tramp-shell-quote-argument localname) + (mapconcat 'tramp-shell-quote-argument + (cons program args) " "))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) + (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) + (name1 name) + (i 0)) + (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -1043,7 +1059,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" "Returns nil on success error-output on failure." (when (and (> (length (tramp-file-name-host vec)) 0) ;; The -s switch is only available for ADB device commands. - (not (member (car args) (list "connect" "disconnect")))) + (not (member (car args) '("connect" "disconnect")))) (setq args (append (list "-s" (tramp-adb-get-device vec)) args))) (with-temp-buffer (prog1 @@ -1080,8 +1096,7 @@ This happens for Android >= 4.0." (while (re-search-forward "\r+$" nil t) (replace-match "" nil nil))))) -(defun tramp-adb-send-command-and-check - (vec command) +(defun tramp-adb-send-command-and-check (vec command) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if @@ -1160,8 +1175,7 @@ connection if a previous connection has died for some reason." (when (and user (not (tramp-get-file-property vec "" "su-command-p" t))) (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) - (unless - (and p (processp p) (memq (process-status p) '(run open))) + (unless (tramp-compat-process-live-p p) (save-match-data (when (and p (processp p)) (delete-process p)) (if (zerop (length device)) @@ -1180,7 +1194,7 @@ connection if a previous connection has died for some reason." vec 6 "%s" (mapconcat 'identity (process-command p) " ")) ;; Wait for initial prompt. (tramp-adb-wait-for-output p 30) - (unless (eq 'run (process-status p)) + (unless (tramp-compat-process-live-p p) (tramp-error vec 'file-error "Terminated!")) (tramp-set-connection-property p "vector" vec) (set-process-query-on-exit-flag p nil) @@ -1230,6 +1244,9 @@ connection if a previous connection has died for some reason." (read (current-buffer))) ":" 'omit)) + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + ;; Mark it as connected. (tramp-set-connection-property p "connected" t))))))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 92f66f414ae..0d90017651b 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -72,13 +72,16 @@ details see the info pages." :version "24.4" :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil)) (choice :tag " Property" string) - (choice :tag " Value" sexp)))) + (choice :tag " Value" sexp))) + :require 'tramp) +;;;###tramp-autoload (defcustom tramp-persistency-file-name (expand-file-name (locate-user-emacs-file "tramp")) "File which keeps connection history for Tramp connections." :group 'tramp - :type 'file) + :type 'file + :require 'tramp) (defvar tramp-cache-data-changed nil "Whether persistent cache data have been changed.") @@ -104,6 +107,7 @@ matching entries of `tramp-connection-properties'." "Get the PROPERTY of FILE from the cache context of KEY. Returns DEFAULT if not set." ;; Unify localname. Remove hop from vector. + (setq file (tramp-compat-file-name-unquote file)) (setq key (copy-sequence key)) (aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) (aset key 4 nil) @@ -137,6 +141,7 @@ Returns DEFAULT if not set." "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. Returns VALUE." ;; Unify localname. Remove hop from vector. + (setq file (tramp-compat-file-name-unquote file)) (setq key (copy-sequence key)) (aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) (aset key 4 nil) @@ -156,28 +161,26 @@ Returns VALUE." (let* ((file (tramp-run-real-handler 'directory-file-name (list file))) (truename (tramp-get-file-property key file "file-truename" nil))) - ;; Remove file properties of symlinks. - (when (and (stringp truename) - (not (string-equal file (directory-file-name truename)))) - (tramp-flush-file-property key truename)) ;; Unify localname. Remove hop from vector. + (setq file (tramp-compat-file-name-unquote file)) (setq key (copy-sequence key)) (aset key 3 file) (aset key 4 nil) (tramp-message key 8 "%s" file) - (remhash key tramp-cache-data))) + (remhash key tramp-cache-data) + ;; Remove file properties of symlinks. + (when (and (stringp truename) + (not (string-equal file (directory-file-name truename)))) + (tramp-flush-file-property key truename)))) ;;;###tramp-autoload (defun tramp-flush-directory-property (key directory) "Remove all properties of DIRECTORY in the cache context of KEY. Remove also properties of all files in subdirectories." + (setq directory (tramp-compat-file-name-unquote directory)) (let* ((directory (tramp-run-real-handler 'directory-file-name (list directory))) (truename (tramp-get-file-property key directory "file-truename" nil))) - ;; Remove file properties of symlinks. - (when (and (stringp truename) - (not (string-equal directory (directory-file-name truename)))) - (tramp-flush-directory-property key truename)) (tramp-message key 8 "%s" directory) (maphash (lambda (key _value) @@ -185,7 +188,11 @@ Remove also properties of all files in subdirectories." (string-match (regexp-quote directory) (tramp-file-name-localname key))) (remhash key tramp-cache-data))) - tramp-cache-data))) + tramp-cache-data) + ;; Remove file properties of symlinks. + (when (and (stringp truename) + (not (string-equal directory (directory-file-name truename)))) + (tramp-flush-directory-property key truename)))) ;; Reverting or killing a buffer should also flush file properties. ;; They could have been changed outside Tramp. In eshell, "ls" would @@ -223,8 +230,10 @@ This is suppressed for temporary buffers." ;;;###tramp-autoload (defun tramp-get-connection-property (key property default) "Get the named PROPERTY for the connection. -KEY identifies the connection, it is either a process or a vector. -If the value is not set for the connection, returns DEFAULT." +KEY identifies the connection, it is either a process or a +vector. A special case is nil, which is used to cache connection +properties of the local machine. If the value is not set for the +connection, returns DEFAULT." ;; Unify key by removing localname and hop from vector. Work with a ;; copy in order to avoid side effects. (when (vectorp key) @@ -232,17 +241,24 @@ If the value is not set for the connection, returns DEFAULT." (aset key 3 nil) (aset key 4 nil)) (let* ((hash (tramp-get-hash-table key)) - (value (if (hash-table-p hash) - (gethash property hash default) - default))) + (value + ;; If the key is an auxiliary process object, check whether + ;; the process is still alive. + (if (and (processp key) (not (tramp-compat-process-live-p key))) + default + (if (hash-table-p hash) + (gethash property hash default) + default)))) (tramp-message key 7 "%s %s" property value) value)) ;;;###tramp-autoload (defun tramp-set-connection-property (key property value) "Set the named PROPERTY of a connection to VALUE. -KEY identifies the connection, it is either a process or a vector. -PROPERTY is set persistent when KEY is a vector." +KEY identifies the connection, it is either a process or a +vector. A special case is nil, which is used to cache connection +properties of the local machine. PROPERTY is set persistent when +KEY is a vector." ;; Unify key by removing localname and hop from vector. Work with a ;; copy in order to avoid side effects. (when (vectorp key) @@ -258,13 +274,17 @@ PROPERTY is set persistent when KEY is a vector." ;;;###tramp-autoload (defun tramp-connection-property-p (key property) "Check whether named PROPERTY of a connection is defined. -KEY identifies the connection, it is either a process or a vector." +KEY identifies the connection, it is either a process or a +vector. A special case is nil, which is used to cache connection +properties of the local machine." (not (eq (tramp-get-connection-property key property 'undef) 'undef))) ;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. -KEY identifies the connection, it is either a process or a vector." +KEY identifies the connection, it is either a process or a +vector. A special case is nil, which is used to cache connection +properties of the local machine." ;; Unify key by removing localname and hop from vector. Work with a ;; copy in order to avoid side effects. (when (vectorp key) @@ -315,17 +335,18 @@ KEY identifies the connection, it is either a process or a vector." ;;;###tramp-autoload (defun tramp-list-connections () "Return a list of all known connection vectors according to `tramp-cache'." - (let (result) + (let (result tramp-verbose) (maphash (lambda (key _value) - (when (and (vectorp key) (null (aref key 3))) + (when (and (vectorp key) (null (aref key 3)) + (tramp-connection-property-p key "process-buffer")) (add-to-list 'result key))) tramp-cache-data) result)) (defun tramp-dump-connection-properties () "Write persistent connection properties into file `tramp-persistency-file-name'." - ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed. + ;; We shouldn't fail, otherwise Emacs might not be able to be closed. (ignore-errors (when (and (hash-table-p tramp-cache-data) (not (zerop (hash-table-count tramp-cache-data))) @@ -352,7 +373,7 @@ KEY identifies the connection, it is either a process or a vector." (with-temp-file tramp-persistency-file-name (insert ";; -*- emacs-lisp -*-" - ;; `time-stamp-string' might not exist in all (X)Emacs flavors. + ;; `time-stamp-string' might not exist in all Emacs flavors. (condition-case nil (progn (format diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 856011fc0ee..208859dbe7f 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -101,8 +101,8 @@ When called interactively, a Tramp connection has to be selected." ;; Flush connection cache. (when (processp (tramp-get-connection-process vec)) - (delete-process (tramp-get-connection-process vec)) - (tramp-flush-connection-property (tramp-get-connection-process vec))) + (tramp-flush-connection-property (tramp-get-connection-process vec)) + (delete-process (tramp-get-connection-process vec))) (tramp-flush-connection-property vec) ;; Remove buffers. @@ -190,6 +190,8 @@ This includes password cache, file cache, connection cache, buffers." password-cache password-cache-expiry remote-file-name-inhibit-cache + connection-local-class-alist + connection-local-criteria-alist file-name-handler-alist)))) (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y))))) @@ -294,7 +296,7 @@ buffer in your bug report. 'intern (all-completions "tramp-" (buffer-local-variables buffer))) ;; Non-tramp variables of interest. - '(default-directory)) + '(connection-local-variables-alist default-directory)) 'string<)) (reporter-dump-variable varsym elbuf)) (lisp-indent-line) @@ -345,7 +347,7 @@ names. Passwords will never be included there.") Please note that you have set `tramp-verbose' to a value of at least 6. Therefore, the contents of files might be included in the debug buffer(s).") - (add-text-properties start (point) (list 'face 'italic)))) + (add-text-properties start (point) '(face italic)))) (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -384,10 +386,12 @@ please ensure that the buffers are attached to your email.\n\n")) ;;; TODO: ;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman) +;; ;; * WIBNI there was an interactive command prompting for Tramp ;; method, hostname, username and filename and translates the user ;; input into the correct filename syntax (depending on the Emacs ;; flavor) (Reiner Steib) +;; ;; * Let the user edit the connection properties interactively. ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index f1f31d0398e..9f1c64dd100 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,8 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 25. This -;; package provides compatibility functions for Emacs 23 and Emacs 24. +;; Tramp's main Emacs version for development is Emacs 26. This +;; package provides compatibility functions for Emacs 23, Emacs 24 and +;; Emacs 25. ;;; Code: @@ -36,6 +37,7 @@ (require 'advice) (require 'custom) (require 'format-spec) +(require 'parse-time) (require 'password-cache) (require 'shell) (require 'timer) @@ -50,11 +52,12 @@ (unless (boundp 'remote-file-name-inhibit-cache) (defvar remote-file-name-inhibit-cache nil)) -;; For not existing functions, or functions with a changed argument -;; list, there are compiler warnings. We want to avoid them in cases -;; we know what we do. +;; For not existing functions, obsolete functions, or functions with a +;; changed argument list, there are compiler warnings. We want to +;; avoid them in cases we know what we do. (defmacro tramp-compat-funcall (function &rest arguments) - `(when (or (subrp ,function) (functionp ,function)) + "Call FUNCTION if it exists. Do not raise compiler warnings." + `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) ;; We currently use "[" and "]" in the filename format for IPv6 hosts @@ -117,11 +120,17 @@ Add the extension of F, if existing." (extension (file-name-extension f t))) (make-temp-file prefix dir-flag extension))) +;; `temporary-file-directory' as function is introduced with Emacs 26.1. +(defalias 'tramp-compat-temporary-file-directory-function + (if (fboundp 'temporary-file-directory) + 'temporary-file-directory + 'tramp-handle-temporary-file-directory)) + ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3. (defun tramp-compat-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files (compat function)." (cond (preserve-extended-attributes @@ -174,8 +183,7 @@ Add the extension of F, if existing." (tramp-compat-copy-directory file newname keep-time parents) (copy-file file newname t keep-time))) ;; We do not want to delete "." and "..". - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (directory-files directory 'full directory-files-no-dot-files-regexp)) ;; Set directory attributes. (set-file-modes newname (file-modes directory)) @@ -209,13 +217,13 @@ Add the extension of F, if existing." ;; implementation from Emacs 23.2. (wrong-number-of-arguments (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (tramp-compat-delete-directory file recursive trash) - (tramp-compat-delete-file file trash))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (when (not (file-symlink-p directory)) + (mapc (lambda (file) + (if (eq t (car (file-attributes file))) + (tramp-compat-delete-directory file recursive trash) + (tramp-compat-delete-file file trash))) + (directory-files + directory 'full directory-files-no-dot-files-regexp))) (delete-directory directory)))) (defun tramp-compat-process-running-p (process-name) @@ -242,6 +250,85 @@ Add the extension of F, if existing." process-name)))) (setq result t))))))))) +;; `process-running-live-p' is introduced in Emacs 24. +(defalias 'tramp-compat-process-live-p + (if (fboundp 'process-running-live-p) + 'process-running-live-p + (lambda (process) + "Returns non-nil if PROCESS is alive. +A process is considered alive if its status is `run', `open', +`listen', `connect' or `stop'. Value is nil if PROCESS is not a +process." + (and (processp process) + (memq (process-status process) + '(run open listen connect stop)))))) + +;; `user-error' has appeared in Emacs 24.3. +(defsubst tramp-compat-user-error (vec-or-proc format &rest args) + "Signal a pilot error." + (apply + 'tramp-error vec-or-proc + (if (fboundp 'user-error) 'user-error 'error) format args)) + +;; `file-attribute-*' are introduced in Emacs 25.1. + +(if (fboundp 'file-attribute-type) + (defalias 'tramp-compat-file-attribute-type 'file-attribute-type) + (defsubst tramp-compat-file-attribute-type (attributes) + "The type field in ATTRIBUTES returned by `file-attributes'. +The value is either t for directory, string (name linked to) for +symbolic link, or nil." + (nth 0 attributes))) + +(if (fboundp 'file-attribute-link-number) + (defalias 'tramp-compat-file-attribute-link-number + 'file-attribute-link-number) + (defsubst tramp-compat-file-attribute-link-number (attributes) + "Return the number of links in ATTRIBUTES returned by `file-attributes'." + (nth 1 attributes))) + +(if (fboundp 'file-attribute-user-id) + (defalias 'tramp-compat-file-attribute-user-id 'file-attribute-user-id) + (defsubst tramp-compat-file-attribute-user-id (attributes) + "The UID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 2 attributes))) + +(if (fboundp 'file-attribute-group-id) + (defalias 'tramp-compat-file-attribute-group-id 'file-attribute-group-id) + (defsubst tramp-compat-file-attribute-group-id (attributes) + "The GID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 3 attributes))) + +(if (fboundp 'file-attribute-modification-time) + (defalias 'tramp-compat-file-attribute-modification-time + 'file-attribute-modification-time) + (defsubst tramp-compat-file-attribute-modification-time (attributes) + "The modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of the last change to the file's contents, and +is a list of integers (HIGH LOW USEC PSEC) in the same style +as (current-time)." + (nth 5 attributes))) + +(if (fboundp 'file-attribute-size) + (defalias 'tramp-compat-file-attribute-size 'file-attribute-size) + (defsubst tramp-compat-file-attribute-size (attributes) + "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. +This is a floating point number if the size is too large for an integer." + (nth 7 attributes))) + +(if (fboundp 'file-attribute-modes) + (defalias 'tramp-compat-file-attribute-modes 'file-attribute-modes) + (defsubst tramp-compat-file-attribute-modes (attributes) + "The file modes in ATTRIBUTES returned by `file-attributes'. +This is a string of ten letters or dashes as in ls -l." + (nth 8 attributes))) + ;; `default-toplevel-value' has been declared in Emacs 24. (unless (fboundp 'default-toplevel-value) (defalias 'default-toplevel-value 'symbol-value)) @@ -250,11 +337,47 @@ Add the extension of F, if existing." (unless (fboundp 'format-message) (defalias 'format-message 'format)) +;; `file-missing' is introduced in Emacs 26. +(defconst tramp-file-missing + (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) + "The error symbol for the `file-missing' error.") + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) +;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are +;; introduced in Emacs 26. +(if (fboundp 'file-name-quoted-p) + (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p) + (defsubst tramp-compat-file-name-quoted-p (name) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name, check the local part of NAME." + (string-match "^/:" (or (file-remote-p name 'localname) name)))) + +(if (fboundp 'file-name-quote) + (defalias 'tramp-compat-file-name-quote 'file-name-quote) + (defsubst tramp-compat-file-name-quote (name) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name, the local part of NAME is quoted." + (concat + (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))) + +(if (fboundp 'file-name-unquote) + (defalias 'tramp-compat-file-name-unquote 'file-name-unquote) + (defsubst tramp-compat-file-name-unquote (name) + "Remove quotation prefix \"/:\" from file NAME. +If NAME is a remote file name, the local part of NAME is unquoted." + (save-match-data + (let ((localname (or (file-remote-p name 'localname) name))) + (when (tramp-compat-file-name-quoted-p localname) + (setq + localname + (replace-match + (if (= (length localname) 2) "/" "") nil t localname))) + (concat (file-remote-p name) localname))))) + (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index caca3c0cb4c..20a12eb6936 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -60,6 +60,7 @@ present for backward compatibility." ;;;###autoload (defun tramp-ftp-enable-ange-ftp () + "Reenable Ange-FTP, when Tramp is unloaded." ;; The following code is commented out in Ange-FTP. ;;; This regexp takes care of real ange-ftp file names (with a slash diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 098d40e7cc0..46f252306ec 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,10 +49,10 @@ ;; The custom option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "afp", "dav", -;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might -;; be necessary to pair with the other bluetooth device, if it hasn't -;; been done already. There might be also some few seconds delay in -;; discovering available bluetooth devices. +;; "davs", "gdrive", "obex", "sftp" and "synce". Note that with +;; "obex" it might be necessary to pair with the other bluetooth +;; device, if it hasn't been done already. There might be also some +;; few seconds delay in discovering available bluetooth devices. ;; Other possible connection methods are "ftp" and "smb". When one of ;; these methods is added to the list, the remote access for that @@ -110,21 +110,30 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce") +(defcustom tramp-gvfs-methods + '("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "25.1" + :version "26.1" :type '(repeat (choice (const "afp") (const "dav") (const "davs") (const "ftp") + (const "gdrive") (const "obex") (const "sftp") (const "smb") - (const "synce")))) + (const "synce"))) + :require 'tramp) -;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE -;; method, no user is chosen. +;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. +;;;###tramp-autoload +(when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" + user-mail-address) + (add-to-list 'tramp-default-user-alist + `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address))) + (add-to-list 'tramp-default-host-alist + '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))) ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) @@ -133,7 +142,8 @@ "Zeroconf domain to be used for discovering services, like host names." :group 'tramp :version "23.2" - :type 'string) + :type 'string + :require 'tramp) ;; Add the methods to `tramp-methods', in order to allow minibuffer ;; completion. @@ -385,7 +395,8 @@ completion, nil means to use always cached values for discovered devices." :group 'tramp :version "23.2" - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) (defvar tramp-bluez-discovery nil "Indicator for a running bluetooth device discovery. @@ -407,6 +418,38 @@ Every entry is a list (NAME ADDRESS).") (defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" "The device interface of the HAL daemon.") +(defconst tramp-gvfs-file-attributes + '("name" + "type" + "standard::display-name" + "standard::symlink-target" + "unix::nlink" + "unix::uid" + "owner::user" + "unix::gid" + "owner::group" + "time::access" + "time::modified" + "time::changed" + "standard::size" + "unix::mode" + "access::can-read" + "access::can-write" + "access::can-execute" + "unix::inode" + "unix::device") + "GVFS file attributes.") + +(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp + (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + "Regexp to parse GVFS file attributes with `gvfs-ls'.") + +(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp + (concat "^[[:blank:]]*" + (regexp-opt tramp-gvfs-file-attributes t) + ":[[:blank:]]+\\(.*\\)$") + "Regexp to parse GVFS file attributes with `gvfs-info'.") + ;; New handlers should be added here. (defconst tramp-gvfs-file-name-handler-alist @@ -437,6 +480,7 @@ Every entry is a list (NAME ADDRESS).") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -462,6 +506,7 @@ Every entry is a list (NAME ADDRESS).") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-symbolic-link . tramp-handle-make-symbolic-link) (process-file . ignore) (rename-file . tramp-gvfs-handle-rename-file) @@ -473,6 +518,7 @@ Every entry is a list (NAME ADDRESS).") (shell-command . ignore) (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) @@ -496,7 +542,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.") First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (unless tramp-gvfs-enabled - (tramp-user-error nil "Package `tramp-gvfs' not supported")) + (tramp-compat-user-error nil "Package `tramp-gvfs' not supported")) (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) (if fn (save-match-data (apply (cdr fn) args)) @@ -585,7 +631,7 @@ is no information where to trace the message.") (defun tramp-gvfs-do-copy-or-rename-file (op filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Copy or rename a remote file. OP must be `copy' or `rename' and indicates the operation to perform. FILENAME specifies the file to copy or rename, NEWNAME is the name of @@ -644,7 +690,7 @@ file names." 'tramp-gvfs-send-command v gvfs-operation (append (and (eq op 'copy) (or keep-date preserve-uid-gid) - (list "--preserve")) + '("--preserve")) (list (tramp-gvfs-url-file-name filename) (tramp-gvfs-url-file-name newname)))) @@ -680,7 +726,7 @@ file names." (defun tramp-gvfs-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) @@ -706,14 +752,19 @@ file names." (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (when (and recursive (not (file-symlink-p directory))) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (tramp-compat-delete-directory file recursive trash) - (tramp-compat-delete-file file trash))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) (with-parsed-tramp-file-name directory nil + (if (and recursive (not (file-symlink-p directory))) + (mapc (lambda (file) + (if (eq t (tramp-compat-file-attribute-type + (file-attributes file))) + (tramp-compat-delete-directory file recursive trash) + (tramp-compat-delete-file file trash))) + (directory-files + directory 'full directory-files-no-dot-files-regexp)) + (when (directory-files directory nil directory-files-no-dot-files-regexp) + (tramp-error + v 'file-error "Couldn't delete non-empty %s" directory))) + (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname) (unless @@ -759,7 +810,7 @@ file names." (tramp-gvfs-maybe-open-connection (vector method user host "/" hop))) (setq localname (replace-match - (tramp-get-file-property v "/" "default-location" "~") + (tramp-get-connection-property v "default-location" "~") nil t localname 1))) ;; Tilde expansion is not possible. (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) @@ -784,127 +835,192 @@ file names." (tramp-run-real-handler 'expand-file-name (list localname)))))) -(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp files." - (unless id-format (setq id-format 'integer)) +(defun tramp-gvfs-get-directory-attributes (directory) + "Return GVFS attributes association list of all files in DIRECTORY." (ignore-errors ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) - (process-environment (cons "LC_MESSAGES=C" process-environment)) - dirp res-symlink-target res-numlinks res-uid res-gid res-access - res-mod res-change res-size res-filemodes res-inode res-device) + result) + (with-parsed-tramp-file-name directory nil + (with-tramp-file-property v localname "directory-gvfs-attributes" + (tramp-message v 5 "directory gvfs attributes: %s" localname) + ;; Send command. + (tramp-gvfs-send-command + v "gvfs-ls" "-h" "-n" "-a" + (mapconcat 'identity tramp-gvfs-file-attributes ",") + (tramp-gvfs-url-file-name directory)) + ;; Parse output. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (while (looking-at + (concat "^\\(.+\\)[[:blank:]]" + "\\([[:digit:]]+\\)[[:blank:]]" + "(\\(.+?\\))" + tramp-gvfs-file-attributes-with-gvfs-ls-regexp)) + (let ((item (list (cons "type" (match-string 3)) + (cons "standard::size" (match-string 2)) + (cons "name" (match-string 1))))) + (goto-char (1+ (match-end 3))) + (while (looking-at + (concat + tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\|" "$" "\\)")) + (push (cons (match-string 1) (match-string 2)) item) + (goto-char (match-end 2))) + ;; Add display name as head. + (push + (cons (cdr (or (assoc "standard::display-name" item) + (assoc "name" item))) + (nreverse item)) + result)) + (forward-line))) + result))))) + +(defun tramp-gvfs-get-root-attributes (filename) + "Return GVFS attributes association list of FILENAME." + (ignore-errors + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used) + result) (with-parsed-tramp-file-name filename nil - (with-tramp-file-property - v localname (format "file-attributes-%s" id-format) - (tramp-message v 5 "file attributes: %s" localname) + (with-tramp-file-property v localname "file-gvfs-attributes" + (tramp-message v 5 "file gvfs attributes: %s" localname) + ;; Send command. (tramp-gvfs-send-command v "gvfs-info" (tramp-gvfs-url-file-name filename)) - ;; Parse output ... + ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward "attributes:" nil t) - ;; ... directory or symlink - (goto-char (point-min)) - (setq dirp (if (re-search-forward "type: directory" nil t) t)) - (goto-char (point-min)) - (setq res-symlink-target - (if (re-search-forward - "standard::symlink-target: \\(.+\\)$" nil t) - (match-string 1))) - ;; ... number links - (goto-char (point-min)) - (setq res-numlinks - (if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) 0)) - ;; ... uid and gid - (goto-char (point-min)) - (setq res-uid - (if (eq id-format 'integer) - (if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - -1) - (if (re-search-forward "owner::user: \\(.+\\)$" nil t) - (match-string 1) - "UNKNOWN"))) - (setq res-gid - (if (eq id-format 'integer) - (if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - -1) - (if (re-search-forward "owner::group: \\(.+\\)$" nil t) - (match-string 1) - "UNKNOWN"))) - ;; ... last access, modification and change time - (goto-char (point-min)) - (setq res-access - (if (re-search-forward "time::access: \\([0-9]+\\)" nil t) - (seconds-to-time (string-to-number (match-string 1))) - '(0 0))) - (goto-char (point-min)) - (setq res-mod - (if (re-search-forward "time::modified: \\([0-9]+\\)" nil t) - (seconds-to-time (string-to-number (match-string 1))) - '(0 0))) - (goto-char (point-min)) - (setq res-change - (if (re-search-forward "time::changed: \\([0-9]+\\)" nil t) - (seconds-to-time (string-to-number (match-string 1))) - '(0 0))) - ;; ... size - (goto-char (point-min)) - (setq res-size - (if (re-search-forward "standard::size: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) 0)) - ;; ... file mode flags - (goto-char (point-min)) - (setq res-filemodes - (if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t) - (tramp-file-mode-from-int - (string-to-number (match-string 1))) - (if dirp "drwx------" "-rwx------"))) - ;; ... inode and device - (goto-char (point-min)) - (setq res-inode - (if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - (tramp-get-inode v))) - (goto-char (point-min)) - (setq res-device - (if (re-search-forward "unix::device: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - (tramp-get-device v))) - - ;; Return data gathered. - (list - ;; 0. t for directory, string (name linked to) for - ;; symbolic link, or nil. - (or dirp res-symlink-target) - ;; 1. Number of links to file. - res-numlinks - ;; 2. File uid. - res-uid - ;; 3. File gid. - res-gid - ;; 4. Last access time, as a list of integers. - ;; 5. Last modification time, likewise. - ;; 6. Last status change time, likewise. - res-access res-mod res-change - ;; 7. Size in bytes (-1, if number is out of range). - res-size - ;; 8. File modes. - res-filemodes - ;; 9. t if file's gid would change if file were deleted - ;; and recreated. - nil - ;; 10. Inode number. - res-inode - ;; 11. Device number. - res-device - )))))))) + (while (re-search-forward + tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t) + (push (cons (match-string 1) (match-string 2)) result)) + result)))))) + +(defun tramp-gvfs-get-file-attributes (filename) + "Return GVFS attributes association list of FILENAME." + (setq filename (directory-file-name (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil + (if (or + (and (string-match "^\\(afp\\|smb\\)$" method) + (string-match "^/?\\([^/]+\\)$" localname)) + (string-equal localname "/")) + (tramp-gvfs-get-root-attributes filename) + (assoc + (file-name-nondirectory filename) + (tramp-gvfs-get-directory-attributes (file-name-directory filename)))))) + +(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (unless id-format (setq id-format 'integer)) + (ignore-errors + (let ((attributes (tramp-gvfs-get-file-attributes filename)) + dirp res-symlink-target res-numlinks res-uid res-gid res-access + res-mod res-change res-size res-filemodes res-inode res-device) + (when attributes + ;; ... directory or symlink + (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t)) + (setq res-symlink-target + (cdr (assoc "standard::symlink-target" attributes))) + ;; ... number links + (setq res-numlinks + (string-to-number + (or (cdr (assoc "unix::nlink" attributes)) "0"))) + ;; ... uid and gid + (setq res-uid + (if (eq id-format 'integer) + (string-to-number + (or (cdr (assoc "unix::uid" attributes)) + (format "%s" tramp-unknown-id-integer))) + (or (cdr (assoc "owner::user" attributes)) + (cdr (assoc "unix::uid" attributes)) + tramp-unknown-id-string))) + (setq res-gid + (if (eq id-format 'integer) + (string-to-number + (or (cdr (assoc "unix::gid" attributes)) + (format "%s" tramp-unknown-id-integer))) + (or (cdr (assoc "owner::group" attributes)) + (cdr (assoc "unix::gid" attributes)) + tramp-unknown-id-string))) + ;; ... last access, modification and change time + (setq res-access + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::access" attributes)) "0")))) + (setq res-mod + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::modified" attributes)) "0")))) + (setq res-change + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::changed" attributes)) "0")))) + ;; ... size + (setq res-size + (string-to-number + (or (cdr (assoc "standard::size" attributes)) "0"))) + ;; ... file mode flags + (setq res-filemodes + (let ((n (cdr (assoc "unix::mode" attributes)))) + (if n + (tramp-file-mode-from-int (string-to-number n)) + (format + "%s%s%s%s------" + (if dirp "d" "-") + (if (equal (cdr (assoc "access::can-read" attributes)) + "FALSE") + "-" "r") + (if (equal (cdr (assoc "access::can-write" attributes)) + "FALSE") + "-" "w") + (if (equal (cdr (assoc "access::can-execute" attributes)) + "FALSE") + "-" "x"))))) + ;; ... inode and device + (setq res-inode + (let ((n (cdr (assoc "unix::inode" attributes)))) + (if n + (string-to-number n) + (tramp-get-inode (tramp-dissect-file-name filename))))) + (setq res-device + (let ((n (cdr (assoc "unix::device" attributes)))) + (if n + (string-to-number n) + (tramp-get-device (tramp-dissect-file-name filename))))) + + ;; Return data gathered. + (list + ;; 0. t for directory, string (name linked to) for + ;; symbolic link, or nil. + (or dirp res-symlink-target) + ;; 1. Number of links to file. + res-numlinks + ;; 2. File uid. + res-uid + ;; 3. File gid. + res-gid + ;; 4. Last access time, as a list of integers. + ;; 5. Last modification time, likewise. + ;; 6. Last status change time, likewise. + res-access res-mod res-change + ;; 7. Size in bytes (-1, if number is out of range). + res-size + ;; 8. File modes. + res-filemodes + ;; 9. t if file's gid would change if file were deleted + ;; and recreated. + nil + ;; 10. Inode number. + res-inode + ;; 11. Device number. + res-device + ))))) (defun tramp-gvfs-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (eq t (car (file-attributes filename)))) + (eq t (tramp-compat-file-attribute-type + (file-attributes (file-truename filename))))) (defun tramp-gvfs-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." @@ -918,7 +1034,7 @@ file names." (let ((tmpfile (tramp-compat-make-temp-file filename))) (unless (file-exists-p filename) (tramp-error - v 'file-error + v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) @@ -926,73 +1042,16 @@ file names." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil - - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for filename, filename with last - ;; character removed, filename with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long filenames, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let ((result '("." "..")) - entry) + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let ((result '("./" "../"))) ;; Get a list of directories and files. - (tramp-gvfs-send-command - v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory)) - - ;; Now grab the output. - (with-temp-buffer - (insert-buffer-substring (tramp-get-connection-buffer v)) - (goto-char (point-max)) - (while (zerop (forward-line -1)) - (setq entry (buffer-substring (point) (point-at-eol))) - (when (string-match filename entry) - (if (file-directory-p (expand-file-name entry directory)) - (push (concat entry "/") result) - (push entry result))))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (dolist (item (tramp-gvfs-get-directory-attributes directory) result) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory (car item)) result) + (push (car item) result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1028,7 +1087,7 @@ file names." ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. (tramp-accept-process-output p 1) - (unless (memq (process-status p) '(run open)) + (unless (tramp-compat-process-live-p p) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) @@ -1158,7 +1217,9 @@ file-notify events." ;; Set file modification time. (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime (nth 5 (file-attributes filename)))) + (set-visited-file-modtime + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) ;; The end. (when (or (eq visit t) (null visit) (stringp visit)) @@ -1171,6 +1232,7 @@ file-notify events." (defun tramp-gvfs-url-file-name (filename) "Return FILENAME in URL syntax." ;; "/" must NOT be hexlified. + (setq filename (tramp-compat-file-name-unquote filename)) (let ((url-unreserved-chars (cons ?/ url-unreserved-chars)) result) (setq @@ -1178,6 +1240,8 @@ file-notify events." (url-recreate-url (if (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil + (when (string-equal "gdrive" method) + (setq method "google-drive")) (when (and user (string-match tramp-user-with-domain-regexp user)) (setq user (concat (match-string 2 user) ";" (match-string 1 user)))) @@ -1347,6 +1411,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (unless (zerop (length domain)) (setq user (concat user tramp-prefix-domain-format domain))) (unless (zerop (length port)) @@ -1358,13 +1424,13 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." signal-name (tramp-gvfs-stringify-dbus-message mount-info)) (tramp-set-file-property v "/" "list-mounts" 'undef) (if (string-equal (downcase signal-name) "unmounted") - (tramp-set-file-property v "/" "fuse-mountpoint" nil) + (tramp-flush-file-property v "/") ;; Set prefix, mountpoint and location. (unless (string-equal prefix "/") (tramp-set-file-property v "/" "prefix" prefix)) (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) - (tramp-set-file-property - v "/" "default-location" default-location))))))) + (tramp-set-connection-property + v "default-location" default-location))))))) (when tramp-gvfs-enabled (dbus-register-signal @@ -1432,6 +1498,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) (unless (zerop (length domain)) @@ -1448,7 +1516,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (unless (string-equal prefix "/") (tramp-set-file-property vec "/" "prefix" prefix)) (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) - (tramp-set-file-property vec "/" "default-location" default-location) + (tramp-set-connection-property + vec "default-location" default-location) (throw 'mounted t))))))) (defun tramp-gvfs-mount-spec-entry (key value) @@ -1469,7 +1538,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (localname (tramp-file-name-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) - (ssl (when (string-match "^davs" method) "true" "false")) + (ssl (if (string-match "^davs" method) "true" "false")) (mount-spec `(:array ,@(cond @@ -1489,6 +1558,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "afp-volume") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "volume" share))) + ((string-equal "gdrive" method) + (list (tramp-gvfs-mount-spec-entry "type" "google-drive") + (tramp-gvfs-mount-spec-entry "host" host))) (t (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" host)))) @@ -1511,6 +1583,44 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ;; Connection functions. +(defun tramp-gvfs-get-remote-uid (vec id-format) + "The uid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." + (with-tramp-connection-property vec (format "uid-%s" id-format) + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec)) + (localname + (tramp-get-connection-property vec "default-location" nil))) + (cond + ((and user (equal id-format 'string)) user) + (localname + (tramp-compat-file-attribute-user-id + (file-attributes + (tramp-make-tramp-file-name method user host localname) id-format))) + ((equal id-format 'integer) tramp-unknown-id-integer) + ((equal id-format 'string) tramp-unknown-id-string))))) + +(defun tramp-gvfs-get-remote-gid (vec id-format) + "The gid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." + (with-tramp-connection-property vec (format "gid-%s" id-format) + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec)) + (localname + (tramp-get-connection-property vec "default-location" nil))) + (cond + (localname + (tramp-compat-file-attribute-group-id + (file-attributes + (tramp-make-tramp-file-name method user host localname) id-format))) + ((equal id-format 'integer) tramp-unknown-id-integer) + ((equal id-format 'string) tramp-unknown-id-string))))) + +(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil + "Indication, that remote uid and gid determination is in progress.") + (defun tramp-gvfs-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -1528,7 +1638,7 @@ connection if a previous connection has died for some reason." (let ((p (make-network-process :name (tramp-buffer-name vec) :buffer (tramp-get-connection-buffer vec) - :server t :host 'local :service t))) + :server t :host 'local :service t :noquery t))) (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) @@ -1540,14 +1650,14 @@ connection if a previous connection has died for some reason." (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) - (when (and (string-equal method "smb") - (string-equal localname "/")) - (tramp-error vec 'file-error "Filename must contain a Windows share")) - (when (and (string-equal method "afp") (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain an AFP volume")) + (when (and (string-equal method "smb") + (string-equal localname "/")) + (tramp-error vec 'file-error "Filename must contain a Windows share")) + (with-tramp-progress-reporter vec 3 (if (zerop (length user)) @@ -1615,30 +1725,39 @@ connection if a previous connection has died for some reason." (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/") (tramp-error vec 'file-error "FUSE mount denied")) + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + ;; Mark it as connected. (tramp-set-connection-property (tramp-get-connection-process vec) "connected" t)))) ;; In `tramp-check-cached-permissions', the connection properties - ;; {uig,gid}-{integer,string} are used. We set them to their local - ;; counterparts. - (with-tramp-connection-property - vec "uid-integer" (tramp-get-local-uid 'integer)) - (with-tramp-connection-property - vec "gid-integer" (tramp-get-local-gid 'integer)) - (with-tramp-connection-property - vec "uid-string" (tramp-get-local-uid 'string)) - (with-tramp-connection-property - vec "gid-string" (tramp-get-local-gid 'string))) + ;; {uig,gid}-{integer,string} are used. We set them to proper values. + (unless tramp-gvfs-get-remote-uid-gid-in-progress + (let ((tramp-gvfs-get-remote-uid-gid-in-progress t)) + (tramp-gvfs-get-remote-uid vec 'integer) + (tramp-gvfs-get-remote-gid vec 'integer) + (tramp-gvfs-get-remote-uid vec 'string) + (tramp-gvfs-get-remote-gid vec 'string)))) (defun tramp-gvfs-send-command (vec command &rest args) "Send the COMMAND with its ARGS to connection VEC. COMMAND is usually a command from the gvfs-* utilities. `call-process' is applied, and it returns t if the return code is zero." - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-gvfs-maybe-open-connection vec) - (erase-buffer) - (zerop (apply 'tramp-call-process vec command nil t nil args)))) + (let* ((locale (tramp-get-local-locale vec)) + (process-environment + (append + `(,(format "LANG=%s" locale) + ,(format "LANGUAGE=%s" locale) + ,(format "LC_ALL=%s" locale)) + process-environment))) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-gvfs-maybe-open-connection vec) + (erase-buffer) + (or (zerop (apply 'tramp-call-process vec command nil t nil args)) + ;; Remove information about mounted connection. + (and (tramp-flush-file-property vec "/") nil))))) ;; D-Bus BLUEZ functions. @@ -1772,35 +1891,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. (when tramp-gvfs-enabled - (zeroconf-init tramp-gvfs-zeroconf-domain) - (if (zeroconf-list-service-types) - (progn + ;; Suppress D-Bus error messages. + (let (tramp-gvfs-dbus-event-vector) + (zeroconf-init tramp-gvfs-zeroconf-domain) + (if (zeroconf-list-service-types) + (progn + (tramp-set-completion-function + "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) + (tramp-set-completion-function + "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + (tramp-set-completion-function + "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + (tramp-set-completion-function + "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") + (tramp-zeroconf-parse-device-names "_workstation._tcp"))) + (when (member "smb" tramp-gvfs-methods) + (tramp-set-completion-function + "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) + + (when (executable-find "avahi-browse") (tramp-set-completion-function - "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) + "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp"))) (tramp-set-completion-function - "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) (tramp-set-completion-function - "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) (tramp-set-completion-function - "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") - (tramp-zeroconf-parse-device-names "_workstation._tcp"))) + "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp") + (tramp-gvfs-parse-device-names "_workstation._tcp"))) (when (member "smb" tramp-gvfs-methods) (tramp-set-completion-function - "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) - - (when (executable-find "avahi-browse") - (tramp-set-completion-function - "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp"))) - (tramp-set-completion-function - "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp") - (tramp-gvfs-parse-device-names "_workstation._tcp"))) - (when (member "smb" tramp-gvfs-methods) - (tramp-set-completion-function - "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))) + "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))) ;; D-Bus SYNCE functions. @@ -1845,11 +1966,15 @@ They are retrieved from the hal daemon." ;;; TODO: -;; * Host name completion via afp-server, smb-server or smb-network. -;; * Check how two shares of the same SMB server can be mounted in +;; * Host name completion for existing mount points (afp-server, +;; smb-server) or via smb-network. +;; +;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. +;; ;; * Apply SDP on bluetooth devices, in order to filter out obex ;; capability. +;; ;; * Implement obex for other serial communication but bluetooth. ;;; tramp-gvfs.el ends here diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index a1ddceb4682..8f8f107ec10 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -93,7 +93,7 @@ (defun tramp-gw-gw-proc-sentinel (proc _event) "Delete auxiliary process when we are deleted." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-message tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) (let* ((tramp-verbose 0) @@ -102,7 +102,7 @@ (defun tramp-gw-aux-proc-sentinel (proc _event) "Activate the different filters for involved gateway and auxiliary processes." - (when (memq (process-status proc) '(run open)) + (when (tramp-compat-process-live-p proc) ;; A new process has been spawned from `tramp-gw-aux-proc'. (tramp-message tramp-gw-vector 4 @@ -125,6 +125,7 @@ (tramp-gw-process-filter tramp-gw-gw-proc s)))))) (defun tramp-gw-process-filter (proc string) + "Resend the string to the other process." (let ((tramp-verbose 0)) ;; The other process might have been stopped already. We don't ;; want to be interrupted then. @@ -148,8 +149,7 @@ instead of the host name declared in TARGET-VEC." tramp-gw-gw-vector gw-vec) ;; Start listening auxiliary process. - (unless (and (processp tramp-gw-aux-proc) - (memq (process-status tramp-gw-aux-proc) '(listen))) + (unless (tramp-compat-process-live-p tramp-gw-aux-proc) (let ((aux-vec (vector "aux" (tramp-file-name-user gw-vec) (tramp-file-name-host gw-vec) nil nil))) @@ -331,6 +331,9 @@ password in password cache. This is done for the first try only." ;;; TODO: ;; * Provide descriptive Commentary. +;; ;; * Enable it for several gateway processes in parallel. +;; +;; * Use `url-https-proxy-connect' as of Emacs 26. ;;; tramp-gw.el ends here diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4ff21c1df4b..52746f680bd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -46,7 +46,8 @@ When inline transfer, compress transferred data of file whose size is this value or above (up to `tramp-copy-size-limit'). If it is nil, no compression at all will be applied." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 @@ -54,7 +55,8 @@ If it is nil, no compression at all will be applied." out-of-the-band copy. If it is nil, out-of-the-band copy will be used without a check." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-terminal-type "dumb" @@ -63,29 +65,34 @@ Because Tramp wants to parse the output of the remote shell, it is easily confused by ANSI color escape sequences and suchlike. Often, shell init files conditionalize this setup based on the TERM environment variable." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload -(defcustom tramp-histfile-override ".tramp_history" +(defcustom tramp-histfile-override "~/.tramp_history" "When invoking a shell, override the HISTFILE with this value. When setting to a string, it redirects the shell history to that file. Be careful when setting to \"/dev/null\"; this might result in undesired results when using \"bash\" as shell. -The value t, the default value, unsets any setting of HISTFILE, -and sets both HISTFILESIZE and HISTSIZE to 0. If you set this -variable to nil, however, the *override* is disabled, so the -history will go to the default storage location, -e.g. \"$HOME/.sh_history\"." +The value t unsets any setting of HISTFILE, and sets both +HISTFILESIZE and HISTSIZE to 0. If you set this variable to nil, +however, the *override* is disabled, so the history will go to +the default storage location, e.g. \"$HOME/.sh_history\"." :group 'tramp - :version "25.1" + :version "25.2" :type '(choice (const :tag "Do not override HISTFILE" nil) (const :tag "Unset HISTFILE" t) - (string :tag "Redirect to a file"))) + (string :tag "Redirect to a file")) + :require 'tramp) ;;;###tramp-autoload -(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" - "Escape sequences produced by the \"ls\" command.") +(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m" + "Terminal control escape sequences for display attributes.") + +;;;###tramp-autoload +(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n" + "Terminal control escape sequences for device status.") ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order @@ -111,13 +118,14 @@ detected as prompt when being sent on echoing hosts, therefore.") "Whether to use `tramp-ssh-controlmaster-options'." :group 'tramp :version "24.4" - :type 'boolean) + :type 'boolean + :require 'tramp) (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. If it is a string, it should have the form -\"-o ControlMaster=auto -o ControlPath='tramp.%%r@%%h:%%p' +\"-o ControlMaster=auto -o ControlPath=\\='tramp.%%r@%%h:%%p\\=' -o ControlPersist=no\". Percent characters in the ControlPath spec must be doubled, because the string is used as format string. @@ -199,7 +207,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-copy-program "rsync") - (tramp-copy-args (("-t" "%k") ("-r"))) + (tramp-copy-args (("-t" "%k") ("-p") ("-r") ("-s"))) (tramp-copy-env (("RSYNC_RSH") ("ssh" "%c"))) (tramp-copy-keep-date t) (tramp-copy-keep-tmpfile t) @@ -510,6 +518,7 @@ The string is used in `tramp-methods'.") ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin +;; QNAP QTS: --- ;;;###tramp-autoload (defcustom tramp-remote-path '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin" @@ -525,22 +534,25 @@ tilde expansion, all directory names starting with `~' will be ignored. `Default Directories' represent the list of directories given by the command \"getconf PATH\". It is recommended to use this -entry on top of this list, because these are the default +entry on head of this list, because these are the default directories for POSIX compatible commands. On remote hosts which do not offer the getconf command (like cygwin), the value -\"/bin:/usr/bin\" is used instead of. +\"/bin:/usr/bin\" is used instead. This entry is represented in +the list by the special value `tramp-default-remote-path'. `Private Directories' are the settings of the $PATH environment, -as given in your `~/.profile'." +as given in your `~/.profile'. This entry is represented in +the list by the special value `tramp-own-remote-path'." :group 'tramp :type '(repeat (choice (const :tag "Default Directories" tramp-default-remote-path) (const :tag "Private Directories" tramp-own-remote-path) - (string :tag "Directory")))) + (string :tag "Directory"))) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-remote-process-environment - `("TMOUT=0" "LC_CTYPE=''" + `("ENV=''" "TMOUT=0" "LC_CTYPE=''" ,(format "TERM=%s" tramp-terminal-type) ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat" @@ -554,8 +566,9 @@ which might have been set in the init files like ~/.profile. Special handling is applied to the PATH environment, which should not be set here. Instead, it should be set via `tramp-remote-path'." :group 'tramp - :version "24.4" - :type '(repeat string)) + :version "26.1" + :type '(repeat string) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) @@ -572,7 +585,8 @@ shell from reading its init file." ;; `alist' is available. Who knows the right way to test it? :type (if (get 'alist 'widget-type) '(alist :key-type string :value-type string) - '(repeat (cons string string)))) + '(repeat (cons string string))) + :require 'tramp) (defconst tramp-actions-before-shell '((tramp-login-prompt-regexp tramp-action-login) @@ -658,29 +672,19 @@ Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-file-name-all-completions - "%s -e 'sub case { - my $str = shift; - if ($ARGV[2]) { - return lc($str); - } - else { - return $str; - } -} + "%s -e ' opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); @files = readdir(d); closedir(d); foreach $f (@files) { - if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { - if (-d \"$ARGV[0]/$f\") { - print \"$f/\\n\"; - } - else { - print \"$f\\n\"; - } + if (-d \"$ARGV[0]/$f\") { + print \"$f/\\n\"; + } + else { + print \"$f\\n\"; } } print \"ok\\n\" -' \"$1\" \"$2\" \"$3\" 2>/dev/null" +' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. Escape sequence %s is replaced with name of Perl binary. This string is @@ -1023,6 +1027,7 @@ of command line.") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -1047,6 +1052,7 @@ of command line.") (load . tramp-handle-load) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) (process-file . tramp-sh-handle-process-file) (rename-file . tramp-sh-handle-rename-file) @@ -1058,6 +1064,7 @@ of command line.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-sh-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (unhandled-file-name-directory . ignore) (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) @@ -1139,7 +1146,9 @@ target of the symlink differ." (tramp-make-tramp-file-name method user host (with-tramp-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order + (let ((result nil) ; result steps in reverse order + (quoted (tramp-compat-file-name-quoted-p localname)) + (localname (tramp-compat-file-name-unquote localname))) (tramp-message v 4 "Finding true name for `%s'" filename) (cond ;; Use GNU readlink --canonicalize-missing where available. @@ -1184,14 +1193,15 @@ target of the symlink differ." (append '("") (reverse result) (list thisstep)) "/")) (setq symlink-target - (nth 0 (file-attributes - (tramp-make-tramp-file-name - method user host - (mapconcat 'identity - (append '("") - (reverse result) - (list thisstep)) - "/"))))) + (tramp-compat-file-attribute-type + (file-attributes + (tramp-make-tramp-file-name + method user host + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) (cond ((string= "." thisstep) (tramp-message v 5 "Ignoring step `.'")) ((string= ".." thisstep) @@ -1233,6 +1243,7 @@ target of the symlink differ." (when (string= "" result) (setq result "/"))))) + (when quoted (setq result (tramp-compat-file-name-quote result))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) @@ -1285,7 +1296,7 @@ target of the symlink differ." res-uid res-gid res-size res-symlink-target) (tramp-message vec 5 "file attributes with ls: %s" localname) ;; We cannot send all three commands combined, it could exceed - ;; NAME_MAX or PATH_MAX. Happened on Mac OS X, for example. + ;; NAME_MAX or PATH_MAX. Happened on macOS, for example. (when (or (tramp-send-command-and-check vec (format "%s %s" @@ -1339,8 +1350,10 @@ target of the symlink differ." (setq res-gid (read (current-buffer))) (if (eq id-format 'integer) (progn - (unless (numberp res-uid) (setq res-uid -1)) - (unless (numberp res-gid) (setq res-gid -1))) + (unless (numberp res-uid) + (setq res-uid tramp-unknown-id-integer)) + (unless (numberp res-gid) + (setq res-gid tramp-unknown-id-integer))) (progn (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) @@ -1440,7 +1453,8 @@ target of the symlink differ." (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) ;; '(-1 65535) means file doesn't exists yet. - (modtime (or (nth 5 attr) '(-1 65535)))) + (modtime (or (tramp-compat-file-attribute-modification-time attr) + '(-1 65535)))) (setq coding-system-used last-coding-system-used) ;; We use '(0 0) as a don't-know value. See also ;; `tramp-do-file-attributes-with-ls'. @@ -1479,7 +1493,7 @@ of." (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (nth 5 attr)) + (modtime (tramp-compat-file-attribute-modification-time attr)) (mt (visited-file-modtime))) (cond @@ -1703,9 +1717,16 @@ be non-negative integers." ;; and obtain the result. (let ((fa1 (file-attributes file1)) (fa2 (file-attributes file2))) - (if (and (not (equal (nth 5 fa1) '(0 0))) - (not (equal (nth 5 fa2) '(0 0)))) - (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1))) + (if (and + (not + (equal (tramp-compat-file-attribute-modification-time fa1) + '(0 0))) + (not + (equal (tramp-compat-file-attribute-modification-time fa2) + '(0 0)))) + (> 0 (tramp-time-diff + (tramp-compat-file-attribute-modification-time fa2) + (tramp-compat-file-attribute-modification-time fa1))) ;; If one of them is the dont-know value, then we can ;; still try to run a shell command on the remote host. ;; However, this only works if both files are Tramp @@ -1757,9 +1778,11 @@ be non-negative integers." ;; information would be lost by an (attempted) delete and create. (or (null attributes) (and - (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)) + (= (tramp-compat-file-attribute-user-id attributes) + (tramp-get-remote-uid v 'integer)) (or (not group) - (= (nth 3 attributes) (tramp-get-remote-gid v 'integer))))))))) + (= (tramp-compat-file-attribute-group-id attributes) + (tramp-get-remote-gid v 'integer))))))))) ;; Directory listings. @@ -1862,135 +1885,62 @@ be non-negative integers." (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". Because I + ;; rock. --daniel@danann.net + (tramp-send-command + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-test-command v)))) - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for `filename', `filename' with last - ;; character removed, `filename' with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long file names, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing '/'. Because I - ;; rock. --daniel@danann.net - - ;; Changed to perform `cd' in the same remote op and only - ;; get entries starting with `filename'. Capture any `cd' - ;; error messages. Ensure any `cd' and `echo' aliases are - ;; ignored. - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s %s %d" - (tramp-shell-quote-argument localname) - (tramp-shell-quote-argument filename) - (if read-file-name-completion-ignore-case 1 0))) - - (format (concat - "(cd %s 2>&1 && (%s -a %s 2>/dev/null" - ;; `ls' with wildcard might fail with `Argument - ;; list too long' error in some corner cases; if - ;; `ls' fails after `cd' succeeded, chances are - ;; that's the case, so let's retry without - ;; wildcard. This will return "too many" entries - ;; but that isn't harmful. - " || %s -a 2>/dev/null)" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - ;; When `filename' is empty, just `ls' without - ;; `filename' argument is more efficient than `ls *' - ;; for very large directories and might avoid the - ;; `Argument list too long' error. - ;; - ;; With and only with wildcard, we need to add - ;; `-d' to prevent `ls' from descending into - ;; sub-directories. - (if (zerop (length filename)) - "." - (format "-d %s*" (tramp-shell-quote-argument filename))) - (tramp-get-ls-command v) - (tramp-get-test-command v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (if (looking-at "^fail$") - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (point-at-eol)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at "^ok$") - (tramp-error - v 'file-error - "\ + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + + ;; Check result code, found in last line of output. + (forward-line -1) + (if (looking-at "^fail$") + (progn + ;; Grab error message from line before last line + ;; (it was put there by `cd 2>&1'). + (forward-line -1) + (tramp-error + v 'file-error + "tramp-sh-handle-file-name-all-completions: %s" + (buffer-substring (point) (point-at-eol)))) + ;; For peace of mind, if buffer doesn't end in `fail' + ;; then it should end in `ok'. If neither are in the + ;; buffer something went seriously wrong on the remote + ;; side. + (unless (looking-at "^ok$") + (tramp-error + v 'file-error "\ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" - (tramp-shell-quote-argument localname) (buffer-string)))) + (tramp-shell-quote-argument localname) (buffer-string)))) - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (point-at-eol)) result))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (point-at-eol)) result))) + result)))))) ;; cp, mv and ln @@ -2014,7 +1964,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" "File %s already exists; make it a new name anyway? " newname))) (tramp-error - v2 'file-error "add-name-to-file: file %s already exists" newname)) + v2 'file-already-exists + "add-name-to-file: file %s already exists" newname)) (when ok-if-already-exists (setq ln (concat ln " -f"))) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) @@ -2028,7 +1979,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (defun tramp-sh-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) @@ -2112,7 +2063,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (defun tramp-do-copy-or-rename-file (op filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Copy or rename a remote file. OP must be `copy' or `rename' and indicates the operation to perform. FILENAME specifies the file to copy or rename, NEWNAME is the name of @@ -2131,7 +2082,8 @@ file names." (error "Unknown operation `%s', must be `copy' or `rename'" op)) (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (length (nth 7 (file-attributes (file-truename filename)))) + (length (tramp-compat-file-attribute-size + (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes (apply 'file-extended-attributes (list filename))))) @@ -2242,7 +2194,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." (set-buffer-multibyte nil) (insert-file-contents-literally filename))) ;; KEEP-DATE handling. - (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))) + (when keep-date + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) ;; Set the mode. (set-file-modes newname (tramp-default-file-modes filename)) ;; If the operation was `rename', delete the original file. @@ -2260,7 +2216,8 @@ as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid from FILENAME." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (file-times (nth 5 (file-attributes filename))) + (file-times (tramp-compat-file-attribute-modification-time + (file-attributes filename))) (file-modes (tramp-default-file-modes filename))) (with-parsed-tramp-file-name (if t1 filename newname) nil (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") @@ -2451,20 +2408,17 @@ The method used must be an out-of-band method." (aset v 3 localname) ;; Check which ones of source and target are Tramp files. - (setq source (if t1 - (tramp-make-copy-program-file-name v) - (shell-quote-argument filename)) - target (if t2 - (tramp-make-copy-program-file-name v) - (shell-quote-argument - (funcall + (setq source (funcall (if (and (file-directory-p filename) - (string-equal - (file-name-nondirectory filename) - (file-name-nondirectory newname))) - 'file-name-directory + (not (file-exists-p newname))) + 'file-name-as-directory 'identity) - newname)))) + (if t1 + (tramp-make-copy-program-file-name v) + (tramp-unquote-shell-quote-argument filename))) + target (if t2 + (tramp-make-copy-program-file-name v) + (tramp-unquote-shell-quote-argument newname))) ;; Check for host and port number. We cannot use ;; `tramp-file-name-port', because this returns also @@ -2593,19 +2547,18 @@ The method used must be an out-of-band method." ;; Use an asynchronous process. By this, password can ;; be handled. We don't set a timeout, because the - ;; copying of large files can last longer than 60 - ;; secs. - (let ((p (apply 'start-process-shell-command - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - copy-program - (append - copy-args - (list "&&" "echo" "tramp_exit_status" "0" - "||" "echo" "tramp_exit_status" "1"))))) - (tramp-message - orig-vec 6 "%s" - (mapconcat 'identity (process-command p) " ")) + ;; copying of large files can last longer than 60 secs. + (let* ((command + (mapconcat + 'identity (append (list copy-program) copy-args) + " ")) + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (start-process-shell-command + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + command)))) + (tramp-message orig-vec 6 "%s" command) (tramp-set-connection-property p "vector" orig-vec) (set-process-query-on-exit-flag p nil) @@ -2613,23 +2566,7 @@ The method used must be an out-of-band method." ;; sending the password. (let ((tramp-local-end-of-line tramp-rsh-end-of-line)) (tramp-process-actions - p v nil tramp-actions-copy-out-of-band)) - - ;; Check the return code. - (goto-char (point-max)) - (unless - (re-search-backward "tramp_exit_status [0-9]+" nil t) - (tramp-error - orig-vec 'file-error - "Couldn't find exit status of `%s'" - (mapconcat 'identity (process-command p) " "))) - (skip-chars-forward "^ ") - (unless (zerop (read (current-buffer))) - (forward-line -1) - (tramp-error - orig-vec 'file-error - "Error copying: `%s'" - (buffer-substring (point-min) (point-at-eol)))))) + p v nil tramp-actions-copy-out-of-band)))) ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) @@ -2644,7 +2581,10 @@ The method used must be an out-of-band method." ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) - (set-file-times newname (nth 5 (file-attributes filename)))) + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) ;; Set the mode. (unless (and keep-date copy-keep-date) @@ -2751,6 +2691,8 @@ The method used must be an out-of-band method." filename switches wildcard full-directory-p) (when (stringp switches) (setq switches (split-string switches))) + (when (tramp-get-ls-command-with-quoting-style v) + (setq switches (append switches '("--quoting-style=literal")))) (when (and (member "--dired" switches) (not (tramp-get-ls-command-with-dired v))) (setq switches (delete "--dired" switches))) @@ -2836,7 +2778,8 @@ The method used must be an out-of-band method." (unless (string-match "color" (tramp-get-connection-property v "ls" "")) (goto-char beg) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) (replace-match ""))) ;; Decode the output, it could be multibyte. @@ -2871,8 +2814,7 @@ the result will be a local, non-Tramp, file name." (setq name (concat (file-name-as-directory dir) name))) ;; If connection is not established yet, run the real handler. (if (not (tramp-connectable-p name)) - (tramp-drop-volume-letter - (tramp-run-real-handler 'expand-file-name (list name nil))) + (tramp-run-real-handler 'expand-file-name (list name nil)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) @@ -2921,7 +2863,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-process-sentinel (proc event) "Flush file caches." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (let ((vec (tramp-get-connection-property proc "vector" nil))) (when vec (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) @@ -2934,7 +2876,12 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files." (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let* (;; When PROGRAM matches "*sh", and the first arg is "-c", + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + ;; When PROGRAM matches "*sh", and the first arg is "-c", ;; it might be that the arguments exceed the command line ;; length. Therefore, we modify the command. (heredoc (and (stringp program) @@ -2963,18 +2910,23 @@ the result will be a local, non-Tramp, file name." tramp-initial-end-of-output)) ;; We use as environment the difference to toplevel ;; `process-environment'. - env - (env - (dolist - (elt - (cons prompt (nreverse (copy-sequence process-environment))) - env) - (or (member elt (default-toplevel-value 'process-environment)) - (setq env (cons elt env))))) + env uenv + (env (dolist (elt (cons prompt process-environment) env) + (or (member elt (default-toplevel-value 'process-environment)) + (if (string-match "=" elt) + (setq env (append env `(,elt))) + (if (tramp-get-env-with-u-option v) + (setq env (append `("-u" ,elt) env)) + (setq uenv (cons elt uenv))))))) (command (when (stringp program) - (format "cd %s && exec %s env %s %s" + (format "cd %s && %s exec %s env %s %s" (tramp-shell-quote-argument localname) + (if uenv + (format + "unset %s &&" + (mapconcat 'tramp-shell-quote-argument uenv " ")) + "") (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") (mapconcat 'tramp-shell-quote-argument env " ") (if heredoc @@ -2992,9 +2944,6 @@ the result will be a local, non-Tramp, file name." ;; `eshell' and friends. (tramp-current-connection nil)) - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -3063,20 +3012,28 @@ the result will be a local, non-Tramp, file name." (error "Implementation does not handle immediate return")) (with-parsed-tramp-file-name default-directory nil - (let (command env input tmpinput stderr tmpstderr outbuf ret) + (let (command env uenv input tmpinput stderr tmpstderr outbuf ret) ;; Compute command. (setq command (mapconcat 'tramp-shell-quote-argument (cons program args) " ")) ;; We use as environment the difference to toplevel `process-environment'. - (setq env - (dolist (elt (nreverse (copy-sequence process-environment)) env) - (or (member elt (default-toplevel-value 'process-environment)) - (setq env (cons elt env))))) + (dolist (elt process-environment) + (or (member elt (default-toplevel-value 'process-environment)) + (if (string-match "=" elt) + (setq env (append env `(,elt))) + (if (tramp-get-env-with-u-option v) + (setq env (append `("-u" ,elt) env)) + (setq uenv (cons elt uenv)))))) (when env (setq command (format "env %s %s" (mapconcat 'tramp-shell-quote-argument env " ") command))) + (when uenv + (setq command + (format + "unset %s && %s" + (mapconcat 'tramp-shell-quote-argument uenv " ") command))) ;; Determine input. (if (null infile) (setq input "/dev/null") @@ -3178,10 +3135,11 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) (tramp-error - v 'file-error + v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) - (let* ((size (nth 7 (file-attributes (file-truename filename)))) + (let* ((size (tramp-compat-file-attribute-size + (file-attributes (file-truename filename)))) (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) (loc-dec (tramp-get-inline-coding v "local-decoding" size)) (tmpfile (tramp-compat-make-temp-file filename))) @@ -3272,9 +3230,11 @@ the result will be a local, non-Tramp, file name." (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) - (let ((uid (or (nth 2 (file-attributes filename 'integer)) + (let ((uid (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) - (gid (or (nth 3 (file-attributes filename 'integer)) + (gid (or (tramp-compat-file-attribute-group-id + (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) (if (and (tramp-local-host-p v) @@ -3351,7 +3311,8 @@ the result will be a local, non-Tramp, file name." ;; specified. However, if the method _also_ specifies an ;; encoding function, then that is used for encoding the ;; contents of the tmp file. - (let* ((size (nth 7 (file-attributes tmpfile))) + (let* ((size (tramp-compat-file-attribute-size + (file-attributes tmpfile))) (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) (loc-enc (tramp-get-inline-coding v "local-encoding" size))) (cond @@ -3487,9 +3448,9 @@ the result will be a local, non-Tramp, file name." ;; We must pass modtime explicitly, because FILENAME can ;; be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. - (nth 5 file-attr)) - (when (and (= (nth 2 file-attr) uid) - (= (nth 3 file-attr) gid)) + (tramp-compat-file-attribute-modification-time file-attr)) + (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid) + (= (tramp-compat-file-attribute-group-id file-attr) gid)) (setq need-chown nil)))) ;; Set the ownership. @@ -3674,7 +3635,12 @@ Fall back to normal file name handler if no Tramp handler exists." (concat "create,modify,move,moved_from,moved_to,move_self," "delete,delete_self,ignored")) ((memq 'attribute-change flags) "attrib,ignored")) - sequence `(,command "-mq" "-e" ,events ,localname))) + sequence `(,command "-mq" "-e" ,events ,localname) + ;; Make events a list of symbols. + events + (mapcar + (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x))) + (split-string events "," 'omit)))) ;; None. (t (tramp-error v 'file-notify-error @@ -3695,7 +3661,7 @@ Fall back to normal file name handler if no Tramp handler exists." (mapconcat 'identity sequence " ")) (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p) (tramp-set-connection-property p "vector" v) - ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'. + ;; Needed for process filter. (process-put p 'events events) (process-put p 'watch-name localname) (set-process-query-on-exit-flag p nil) @@ -3703,7 +3669,7 @@ Fall back to normal file name handler if no Tramp handler exists." ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. (tramp-accept-process-output p 1) - (unless (memq (process-status p) '(run open)) + (unless (tramp-compat-process-live-p p) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) @@ -3711,7 +3677,8 @@ Fall back to normal file name handler if no Tramp handler exists." (defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) "Read output from \"gvfs-monitor-dir\" and add corresponding \ file-notify events." - (let ((remote-prefix + (let ((events (process-get proc 'events)) + (remote-prefix (with-current-buffer (process-buffer proc) (file-remote-p default-directory))) (rest-string (process-get proc 'rest-string))) @@ -3737,23 +3704,26 @@ file-notify events." (object (list proc - (intern-soft - (replace-regexp-in-string - "_" "-" (downcase (match-string 4 string)))) + (list + (intern-soft + (replace-regexp-in-string + "_" "-" (downcase (match-string 4 string))))) ;; File names are returned as absolute paths. We must ;; add the remote prefix. (concat remote-prefix file) (when file1 (concat remote-prefix file1))))) (setq string (replace-match "" nil nil string)) ;; Remove watch when file or directory to be watched is deleted. - (when (and (member (cadr object) '(moved deleted)) + (when (and (member (caadr object) '(moved deleted)) (string-equal file (process-get proc 'watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the callback directly. - (when (member (cadr object) (process-get proc 'events)) - (tramp-compat-funcall 'file-notify-callback object)))) + ;; once. Therefore, we apply the handler directly. + (when (member (caadr object) events) + (tramp-compat-funcall + 'file-notify-handle-event + `(file-notify ,object file-notify-callback))))) ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) @@ -3762,33 +3732,37 @@ file-notify events." (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding file-notify events." - (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) - ;; Check, whether there is a problem. - (unless - (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)+" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") - line) - (tramp-error proc 'file-notify-error "%s" line)) - - (let ((object - (list - proc - (mapcar - (lambda (x) - (intern-soft - (replace-regexp-in-string "_" "-" (downcase x)))) - (split-string (match-string 1 line) "," 'omit)) - (match-string 3 line)))) - ;; Remove watch when file or directory to be watched is deleted. - (when (equal (cadr object) 'ignored) - (delete-process proc)) - ;; Usually, we would add an Emacs event now. Unfortunately, - ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the callback directly. - (tramp-compat-funcall 'file-notify-callback object)))) + (let ((events (process-get proc 'events))) + (tramp-message proc 6 "%S\n%s" proc string) + (dolist (line (split-string string "[\n\r]+" 'omit)) + ;; Check, whether there is a problem. + (unless + (string-match + (concat "^[^[:blank:]]+" + "[[:blank:]]+\\([^[:blank:]]+\\)+" + "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + line) + (tramp-error proc 'file-notify-error "%s" line)) + + (let ((object + (list + proc + (mapcar + (lambda (x) + (intern-soft + (replace-regexp-in-string "_" "-" (downcase x)))) + (split-string (match-string 1 line) "," 'omit)) + (match-string 3 line)))) + ;; Remove watch when file or directory to be watched is deleted. + (when (member (caadr object) '(move-self delete-self ignored)) + (delete-process proc)) + ;; Usually, we would add an Emacs event now. Unfortunately, + ;; `unread-command-events' does not accept several events at + ;; once. Therefore, we apply the handler directly. + (when (member (caadr object) events) + (tramp-compat-funcall + 'file-notify-handle-event + `(file-notify ,object file-notify-callback))))))) ;;; Internal Functions: @@ -3997,7 +3971,8 @@ file exists and nonzero exit status otherwise." ;; $HISTFILE is set according to `tramp-histfile-override'. (tramp-send-command vec (format - "exec env ENV='' %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + "exec env ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) (format "HISTFILE=%s" (tramp-shell-quote-argument tramp-histfile-override)) @@ -4006,7 +3981,19 @@ file exists and nonzero exit status otherwise." "")) (tramp-shell-quote-argument tramp-end-of-output) shell (or extra-args "")) - t)) + t) + ;; Check proper HISTFILE setting. We give up when not working. + (when (and (stringp tramp-histfile-override) + (file-name-directory tramp-histfile-override)) + (tramp-barf-unless-okay + vec + (format + "(cd %s)" + (tramp-shell-quote-argument + (file-name-directory tramp-histfile-override))) + "`tramp-histfile-override' uses invalid file `%s'" + tramp-histfile-override))) + (tramp-set-connection-property (tramp-get-connection-process vec) "remote-shell" shell))) @@ -4017,7 +4004,7 @@ file exists and nonzero exit status otherwise." shell) (setq shell (with-tramp-connection-property vec "remote-shell" - ;; CCC: "root" does not exist always, see QNAP 459. + ;; CCC: "root" does not exist always, see my QNAP TS-459. ;; Which check could we apply instead? (tramp-send-command vec "echo ~root" t) (if (or (string-match "^~root$" (buffer-string)) @@ -4075,10 +4062,10 @@ process to set up. VEC specifies the connection." (case-fold-search t)) (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell)) - ;; Disable tab and echo expansion. + ;; Disable echo expansion. (tramp-message vec 5 "Setting up remote shell environment") (tramp-send-command - vec "stty tab0 -inlcr -onlcr -echo kill '^U' erase '^H'" t) + vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) ;; Check whether the echo has really been disabled. Some ;; implementations, like busybox of embedded GNU/Linux, don't ;; support disabling. @@ -4095,7 +4082,8 @@ process to set up. VEC specifies the connection." (tramp-message vec 5 "Setting shell prompt") (tramp-send-command vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" - (tramp-shell-quote-argument tramp-end-of-output)) t) + (tramp-shell-quote-argument tramp-end-of-output)) + t) ;; Check whether the output of "uname -sr" has been changed. If ;; yes, this is a strong indication that we must expire all @@ -4103,139 +4091,132 @@ process to set up. VEC specifies the connection." ;; `tramp-maybe-open-connection', it will be caught there. (tramp-message vec 5 "Checking system information") (let ((old-uname (tramp-get-connection-property vec "uname" nil)) - (new-uname + (uname (tramp-set-connection-property vec "uname" (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) - (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) + (when (and (stringp old-uname) (not (string-equal old-uname uname))) (tramp-message vec 3 "Connection reset, because remote host changed from `%s' to `%s'" - old-uname new-uname) + old-uname uname) ;; We want to keep the password. (tramp-cleanup-connection vec t t) - (throw 'uname-changed (tramp-maybe-open-connection vec)))) + (throw 'uname-changed (tramp-maybe-open-connection vec))) - ;; Try to set up the coding system correctly. - ;; CCC this can't be the right way to do it. Hm. - (tramp-message vec 5 "Determining coding system") - (with-current-buffer (process-buffer proc) - ;; Use MULE to select the right EOL convention for communicating - ;; with the process. - (let ((cs (or (and (memq 'utf-8 (coding-system-list)) - (string-match "utf-?8" (tramp-get-remote-locale vec)) - (cons 'utf-8 'utf-8)) - (process-coding-system proc) - (cons 'undecided 'undecided))) - cs-decode cs-encode) - (when (symbolp cs) (setq cs (cons cs cs))) - (setq cs-decode (or (car cs) 'undecided) - cs-encode (or (cdr cs) 'undecided) - cs-encode - (coding-system-change-eol-conversion - cs-encode - (if (string-match - "^Darwin" (tramp-get-connection-property vec "uname" "")) - 'mac 'unix))) - (tramp-send-command vec "echo foo ; echo bar" t) - (goto-char (point-min)) - (when (search-forward "\r" nil t) - (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) - ;; Special setting for Mac OS X. - (when (and (string-match - "^Darwin" (tramp-get-connection-property vec "uname" "")) - (memq 'utf-8-hfs (coding-system-list))) - (setq cs-decode 'utf-8-hfs - cs-encode 'utf-8-hfs)) - (set-buffer-process-coding-system cs-decode cs-encode) - (tramp-message - vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) + ;; Try to set up the coding system correctly. + ;; CCC this can't be the right way to do it. Hm. + (tramp-message vec 5 "Determining coding system") + (with-current-buffer (process-buffer proc) + ;; Use MULE to select the right EOL convention for communicating + ;; with the process. + (let ((cs (or (and (memq 'utf-8 (coding-system-list)) + (string-match "utf-?8" (tramp-get-remote-locale vec)) + (cons 'utf-8 'utf-8)) + (process-coding-system proc) + (cons 'undecided 'undecided))) + cs-decode cs-encode) + (when (symbolp cs) (setq cs (cons cs cs))) + (setq cs-decode (or (car cs) 'undecided) + cs-encode (or (cdr cs) 'undecided) + cs-encode + (coding-system-change-eol-conversion + cs-encode (if (string-match "^Darwin" uname) 'mac 'unix))) + (tramp-send-command vec "echo foo ; echo bar" t) + (goto-char (point-min)) + (when (search-forward "\r" nil t) + (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) + ;; Special setting for macOS. + (when (and (string-match "^Darwin" uname) + (memq 'utf-8-hfs (coding-system-list))) + (setq cs-decode 'utf-8-hfs + cs-encode 'utf-8-hfs)) + (set-buffer-process-coding-system cs-decode cs-encode) + (tramp-message + vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) - (tramp-send-command vec "set +o vi +o emacs" t) + (tramp-send-command vec "set +o vi +o emacs" t) - ;; Check whether the remote host suffers from buggy - ;; `send-process-string'. This is known for FreeBSD (see comment in - ;; `send_process', file process.c). I've tested sending 624 bytes - ;; successfully, sending 625 bytes failed. Emacs makes a hack when - ;; this host type is detected locally. It cannot handle remote - ;; hosts, though. - (with-tramp-connection-property proc "chunksize" - (cond - ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) - tramp-chunksize) - (t - (tramp-message - vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match - "^FreeBSD" (tramp-get-connection-property vec "uname" "")) - 500 0)))) - - ;; Set remote PATH variable. - (tramp-set-remote-path vec) - - ;; Search for a good shell before searching for a command which - ;; checks if a file exists. This is done because Tramp wants to use - ;; "test foo; echo $?" to check if various conditions hold, and - ;; there are buggy /bin/sh implementations which don't execute the - ;; "echo $?" part if the "test" part has an error. In particular, - ;; the OpenSolaris /bin/sh is a problem. There are also other - ;; problems with /bin/sh of OpenSolaris, like redirection of stderr - ;; in function declarations, or changing HISTFILE in place. - ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when - ;; detected. - (tramp-find-shell vec) - - ;; Disable unexpected output. - (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) - - ;; IRIX64 bash expands "!" even when in single quotes. This - ;; destroys our shell functions, we must disable it. See - ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. - (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" "")) - (tramp-send-command vec "set +H" t)) - - ;; On BSD-like systems, ?\t is expanded to spaces. Suppress this. - (when (string-match "BSD\\|Darwin" - (tramp-get-connection-property vec "uname" "")) - (tramp-send-command vec "stty -oxtabs" t)) - - ;; Set utf8 encoding. Needed for Mac OS X, for example. This is - ;; non-POSIX, so we must expect errors on some systems. - (tramp-send-command vec "stty iutf8 2>/dev/null" t) - - ;; Set `remote-tty' process property. - (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) - (unless (zerop (length tty)) - (process-put proc 'remote-tty tty))) - - ;; Dump stty settings in the traces. - (when (>= tramp-verbose 9) - (tramp-send-command vec "stty -a" t)) - - ;; Set the environment. - (tramp-message vec 5 "Setting default environment") - - (let ((env (append `(,(tramp-get-remote-locale vec)) - (copy-sequence tramp-remote-process-environment))) - unset vars item) - (while env - (setq item (split-string (car env) "=" 'omit)) - (setcdr item (mapconcat 'identity (cdr item) "=")) - (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) - (push (format "%s %s" (car item) (cdr item)) vars) - (push (car item) unset)) - (setq env (cdr env))) - (when vars - (tramp-send-command - vec - (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" - tramp-end-of-heredoc - (mapconcat 'identity vars "\n") - tramp-end-of-heredoc) - t)) - (when unset - (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) + ;; Check whether the remote host suffers from buggy + ;; `send-process-string'. This is known for FreeBSD (see comment + ;; in `send_process', file process.c). I've tested sending 624 + ;; bytes successfully, sending 625 bytes failed. Emacs makes a + ;; hack when this host type is detected locally. It cannot handle + ;; remote hosts, though. + (with-tramp-connection-property proc "chunksize" + (cond + ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) + tramp-chunksize) + (t + (tramp-message + vec 5 "Checking remote host type for `send-process-string' bug") + (if (string-match "^FreeBSD" uname) 500 0)))) + + ;; Set remote PATH variable. + (tramp-set-remote-path vec) + + ;; Search for a good shell before searching for a command which + ;; checks if a file exists. This is done because Tramp wants to + ;; use "test foo; echo $?" to check if various conditions hold, + ;; and there are buggy /bin/sh implementations which don't execute + ;; the "echo $?" part if the "test" part has an error. In + ;; particular, the OpenSolaris /bin/sh is a problem. There are + ;; also other problems with /bin/sh of OpenSolaris, like + ;; redirection of stderr in function declarations, or changing + ;; HISTFILE in place. Therefore, OpenSolaris' /bin/sh is replaced + ;; by bash, when detected. + (tramp-find-shell vec) + + ;; Disable unexpected output. + (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) + + ;; IRIX64 bash expands "!" even when in single quotes. This + ;; destroys our shell functions, we must disable it. See + ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. + (when (string-match "^IRIX64" uname) + (tramp-send-command vec "set +H" t)) + + ;; Disable tab expansion. + (if (string-match "BSD\\|Darwin" uname) + (tramp-send-command vec "stty tabs" t) + (tramp-send-command vec "stty tab0" t)) + + ;; Set utf8 encoding. Needed for macOS, for example. This is + ;; non-POSIX, so we must expect errors on some systems. + (tramp-send-command vec "stty iutf8 2>/dev/null" t) + + ;; Set `remote-tty' process property. + (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) + (unless (zerop (length tty)) + (process-put proc 'remote-tty tty))) + + ;; Dump stty settings in the traces. + (when (>= tramp-verbose 9) + (tramp-send-command vec "stty -a" t)) + + ;; Set the environment. + (tramp-message vec 5 "Setting default environment") + + (let (unset vars) + (dolist (item (reverse + (append `(,(tramp-get-remote-locale vec)) + (copy-sequence tramp-remote-process-environment)))) + (setq item (split-string item "=" 'omit)) + (setcdr item (mapconcat 'identity (cdr item) "=")) + (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) + (push (format "%s %s" (car item) (cdr item)) vars) + (push (car item) unset))) + (when vars + (tramp-send-command + vec + (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" + tramp-end-of-heredoc + (mapconcat 'identity vars "\n") + tramp-end-of-heredoc) + t)) + (when unset + (tramp-send-command + vec (format "unset %s" (mapconcat 'identity unset " ")) t))))) ;; Old text from documentation of tramp-methods: ;; Using a uuencode/uudecode inline method is discouraged, please use one @@ -4703,7 +4684,7 @@ connection if a previous connection has died for some reason." ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. - (unless (or (and p (processp p) (memq (process-status p) '(run open))) + (unless (or (tramp-compat-process-live-p p) (not (equal (butlast (append vec nil) 2) (car tramp-current-connection))) (> (tramp-time-diff @@ -4724,9 +4705,9 @@ connection if a previous connection has died for some reason." (tramp-get-connection-property p "last-cmd-time" '(0 0 0))) 60) - p (processp p) (memq (process-status p) '(run open))) + (tramp-compat-process-live-p p)) (tramp-send-command vec "echo are you awake" t t) - (unless (and (memq (process-status p) '(run open)) + (unless (and (tramp-compat-process-live-p p) (tramp-wait-for-output p 10)) ;; The error will be caught locally. (tramp-error vec 'file-error "Awake did fail"))) @@ -4736,7 +4717,7 @@ connection if a previous connection has died for some reason." ;; New connection must be opened. (condition-case err - (unless (and p (processp p) (memq (process-status p) '(run open))) + (unless (tramp-compat-process-live-p p) ;; If `non-essential' is non-nil, don't reopen a new connection. ;; This variable has been introduced with Emacs 24.1. @@ -4759,7 +4740,7 @@ connection if a previous connection has died for some reason." (when (and p (processp p)) (delete-process p)) (setenv "TERM" tramp-terminal-type) - (setenv "LC_ALL" "en_US.utf8") + (setenv "LC_ALL" (tramp-get-local-locale vec)) (if (stringp tramp-histfile-override) (setenv "HISTFILE" tramp-histfile-override) (if tramp-histfile-override @@ -4769,12 +4750,17 @@ connection if a previous connection has died for some reason." (setenv "HISTSIZE" "0")))) (setenv "PROMPT_COMMAND") (setenv "PS1" tramp-initial-end-of-output) + (unless (stringp tramp-encoding-shell) + (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((target-alist (tramp-compute-multi-hops vec)) ;; We will apply `tramp-ssh-controlmaster-options' ;; only for the first hop. (options (tramp-ssh-controlmaster-options vec)) (process-connection-type tramp-process-connection-type) (process-adaptive-read-buffering nil) + ;; There are unfortunate settings for "cmdproxy" on + ;; W32 systems. + (process-coding-system-alist nil) (coding-system-for-read nil) ;; This must be done in order to avoid our file ;; name handler. @@ -4926,7 +4912,10 @@ connection if a previous connection has died for some reason." (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) (tramp-process-actions - p vec pos tramp-actions-before-shell + p vec + (min + pos (with-current-buffer (process-buffer p) (point-max))) + tramp-actions-before-shell (or connection-timeout tramp-connection-timeout)) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) @@ -4934,16 +4923,18 @@ connection if a previous connection has died for some reason." (setq options "" target-alist (cdr target-alist))) + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + ;; Make initial shell settings. (tramp-open-connection-setup-interactive-shell p vec) ;; Mark it as connected. (tramp-set-connection-property p "connected" t))))) - ;; When the user did interrupt, we must cleanup. - (quit + ;; Cleanup, and propagate the signal. + ((error quit) (tramp-cleanup-connection vec t) - ;; Propagate the quit signal. (signal (car err) (cdr err)))))) (defun tramp-send-command (vec command &optional neveropen nooutput) @@ -4982,7 +4973,12 @@ function waits for output unless NOOUTPUT is set." (with-current-buffer (process-buffer proc) (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might ;; be leading escape sequences, which must be ignored. - (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) + ;; Busyboxes built with the EDITING_ASK_TERMINAL config + ;; option send also escape sequences, which must be + ;; ignored. + (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$" + (regexp-quote tramp-end-of-output) + tramp-device-escape-sequence-regexp)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". @@ -5085,16 +5081,17 @@ Return ATTR." (when attr ;; Remove color escape sequences from symlink. (when (stringp (car attr)) - (while (string-match tramp-color-escape-sequence-regexp (car attr)) + (while (string-match tramp-display-escape-sequence-regexp (car attr)) (setcar attr (replace-match "" nil nil (car attr))))) - ;; Convert uid and gid. Use -1 as indication of unusable value. + ;; Convert uid and gid. Use `tramp-unknown-id-integer' as + ;; indication of unusable value. (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) - (setcar (nthcdr 2 attr) -1)) + (setcar (nthcdr 2 attr) tramp-unknown-id-integer)) (when (and (floatp (nth 2 attr)) (<= (nth 2 attr) most-positive-fixnum)) (setcar (nthcdr 2 attr) (round (nth 2 attr)))) (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) - (setcar (nthcdr 3 attr) -1)) + (setcar (nthcdr 3 attr) tramp-unknown-id-integer)) (when (and (floatp (nth 3 attr)) (<= (nth 3 attr) most-positive-fixnum)) (setcar (nthcdr 3 attr) (round (nth 3 attr)))) @@ -5169,7 +5166,8 @@ Return ATTR." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec)) - (localname (tramp-file-name-localname vec))) + (localname (tramp-compat-file-name-unquote + (directory-file-name (tramp-file-name-localname vec))))) (when (string-match tramp-ipv6-regexp host) (setq host (format "[%s]" host))) (unless (string-match "ftp$" method) @@ -5178,8 +5176,8 @@ Return ATTR." ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) ((not (zerop (length user))) - (shell-quote-argument (format "%s@%s:%s" user host localname))) - (t (shell-quote-argument (format "%s:%s" host localname)))))) + (tramp-shell-quote-argument (format "%s@%s:%s" user host localname))) + (t (tramp-shell-quote-argument (format "%s:%s" host localname)))))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." @@ -5197,6 +5195,8 @@ Return ATTR." ;; Variables local to connection. (defun tramp-get-remote-path (vec) + "Compile list of remote directories for $PATH. +Nonexistent directories are removed from spec." (with-tramp-connection-property ;; When `tramp-own-remote-path' is in `tramp-remote-path', we ;; cache the result for the session only. Otherwise, the result @@ -5285,6 +5285,7 @@ Return ATTR." remote-path))))) (defun tramp-get-remote-locale (vec) + "Determine remote locale, supporting UTF8 if possible." (with-tramp-connection-property vec "locale" (tramp-send-command vec "locale -a") (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) @@ -5301,6 +5302,7 @@ Return ATTR." (format "LC_ALL=%s" (or locale "C"))))) (defun tramp-get-ls-command (vec) + "Determine remote `ls' command." (with-tramp-connection-property vec "ls" (tramp-message vec 5 "Finding a suitable `ls' command") (or @@ -5326,6 +5328,7 @@ Return ATTR." (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) (defun tramp-get-ls-command-with-dired (vec) + "Check, whether the remote `ls' command supports the --dired option." (save-match-data (with-tramp-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") @@ -5336,6 +5339,7 @@ Return ATTR." vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec)))))) (defun tramp-get-ls-command-with-quoting-style (vec) + "Check, whether the remote `ls' command supports the --quoting-style option." (save-match-data (with-tramp-connection-property vec "ls-quoting-style" (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works") @@ -5344,6 +5348,7 @@ Return ATTR." (tramp-get-ls-command vec)))))) (defun tramp-get-ls-command-with-w-option (vec) + "Check, whether the remote `ls' command supports the -w option." (save-match-data (with-tramp-connection-property vec "ls-w-option" (tramp-message vec 5 "Checking, whether `ls -w' works") @@ -5354,6 +5359,7 @@ Return ATTR." vec (format "%s -alw" (tramp-get-ls-command vec)))))) (defun tramp-get-test-command (vec) + "Determine remote `test' command." (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command") (if (tramp-send-command-and-check vec "test 0") @@ -5361,6 +5367,7 @@ Return ATTR." (tramp-find-executable vec "test" (tramp-get-remote-path vec))))) (defun tramp-get-test-nt-command (vec) + "Check, whether the remote `test' command supports the -nt option." ;; Does `test A -nt B' work? Use abominable `find' construct if it ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, ;; for otherwise the shell crashes. @@ -5382,51 +5389,62 @@ Return ATTR." "tramp_test_nt %s %s")))) (defun tramp-get-file-exists-command (vec) + "Determine remote command for file existing check." (with-tramp-connection-property vec "file-exists" (tramp-message vec 5 "Finding command to check if file exists") (tramp-find-file-exists-command vec))) (defun tramp-get-remote-ln (vec) + "Determine remote `ln' command." (with-tramp-connection-property vec "ln" (tramp-message vec 5 "Finding a suitable `ln' command") (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) (defun tramp-get-remote-perl (vec) + "Determine remote `perl' command." (with-tramp-connection-property vec "perl" (tramp-message vec 5 "Finding a suitable `perl' command") (let ((result (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) - (tramp-find-executable - vec "perl" (tramp-get-remote-path vec))))) + (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))) + ;; Perform a basic check. + (and result + (null (tramp-send-command-and-check + vec (format "%s -e 'print \"Hello\n\";'" result))) + (setq result nil)) ;; We must check also for some Perl modules. (when result (with-tramp-connection-property vec "perl-file-spec" - (tramp-send-command-and-check - vec (format "%s -e 'use File::Spec;'" result))) + (tramp-send-command-and-check + vec (format "%s -e 'use File::Spec;'" result))) (with-tramp-connection-property vec "perl-cwd-realpath" - (tramp-send-command-and-check - vec (format "%s -e 'use Cwd \"realpath\";'" result)))) + (tramp-send-command-and-check + vec (format "%s -e 'use Cwd \"realpath\";'" result)))) result))) (defun tramp-get-remote-stat (vec) + "Determine remote `stat' command." (with-tramp-connection-property vec "stat" (tramp-message vec 5 "Finding a suitable `stat' command") (let ((result (tramp-find-executable vec "stat" (tramp-get-remote-path vec))) tmp) ;; Check whether stat(1) returns usable syntax. "%s" does not - ;; work on older AIX systems. + ;; work on older AIX systems. Recent GNU stat versions (8.24?) + ;; use shell quoted format for "%N", we check the boundaries "`" + ;; and "'", therefore. See Bug#23422 in coreutils. (when result (setq tmp (tramp-send-command-and-read vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) - (string-match "^./.$" (car tmp)) + (string-match "^`/'$" (car tmp)) (integerp (cadr tmp))) (setq result nil))) result))) (defun tramp-get-remote-readlink (vec) + "Determine remote `readlink' command." (with-tramp-connection-property vec "readlink" (tramp-message vec 5 "Finding a suitable `readlink' command") (let ((result (tramp-find-executable @@ -5437,11 +5455,13 @@ Return ATTR." result)))) (defun tramp-get-remote-trash (vec) + "Determine remote `trash' command." (with-tramp-connection-property vec "trash" (tramp-message vec 5 "Finding a suitable `trash' command") (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) (defun tramp-get-remote-touch (vec) + "Determine remote `touch' command." (with-tramp-connection-property vec "touch" (tramp-message vec 5 "Finding a suitable `touch' command") (let ((result (tramp-find-executable @@ -5466,17 +5486,20 @@ Return ATTR." result))) (defun tramp-get-remote-gvfs-monitor-dir (vec) + "Determine remote `gvfs-monitor-dir' command." (with-tramp-connection-property vec "gvfs-monitor-dir" (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") (tramp-find-executable vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))) (defun tramp-get-remote-inotifywait (vec) + "Determine remote `inotifywait' command." (with-tramp-connection-property vec "inotifywait" (tramp-message vec 5 "Finding a suitable `inotifywait' command") (tramp-find-executable vec "inotifywait" (tramp-get-remote-path vec) t t))) (defun tramp-get-remote-id (vec) + "Determine remote `id' command." (with-tramp-connection-property vec "id" (tramp-message vec 5 "Finding POSIX `id' command") (catch 'id-found @@ -5490,6 +5513,7 @@ Return ATTR." (setq dl (cdr dl)))))))) (defun tramp-get-remote-uid-with-id (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using `id'." (tramp-send-command-and-read vec (format "%s -u%s %s" @@ -5499,6 +5523,7 @@ Return ATTR." "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))) (defun tramp-get-remote-uid-with-perl (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using a Perl script." (tramp-send-command-and-read vec (format "%s -le '%s'" @@ -5508,6 +5533,7 @@ Return ATTR." "print \"\\\"\", scalar getpwuid($>), \"\\\"\"")))) (defun tramp-get-remote-python (vec) + "Determine remote `python' command." (with-tramp-connection-property vec "python" (tramp-message vec 5 "Finding a suitable `python' command") (or (tramp-find-executable vec "python" (tramp-get-remote-path vec)) @@ -5515,6 +5541,7 @@ Return ATTR." (tramp-find-executable vec "python3" (tramp-get-remote-path vec))))) (defun tramp-get-remote-uid-with-python (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using `python'." (tramp-send-command-and-read vec (format "%s -c \"%s\"" @@ -5524,6 +5551,8 @@ Return ATTR." "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')")))) (defun tramp-get-remote-uid (vec id-format) + "The uid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "uid-%s" id-format) (let ((res (ignore-errors @@ -5536,11 +5565,14 @@ Return ATTR." (tramp-get-remote-uid-with-python vec id-format)))))) ;; Ensure there is a valid result. (cond - ((and (equal id-format 'integer) (not (integerp res))) -1) - ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") + ((and (equal id-format 'integer) (not (integerp res))) + tramp-unknown-id-integer) + ((and (equal id-format 'string) (not (stringp res))) + tramp-unknown-id-string) (t res))))) (defun tramp-get-remote-gid-with-id (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using `id'." (tramp-send-command-and-read vec (format "%s -g%s %s" @@ -5550,6 +5582,7 @@ Return ATTR." "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))) (defun tramp-get-remote-gid-with-perl (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using a Perl script." (tramp-send-command-and-read vec (format "%s -le '%s'" @@ -5559,6 +5592,7 @@ Return ATTR." "print \"\\\"\", scalar getgrgid($)), \"\\\"\"")))) (defun tramp-get-remote-gid-with-python (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using `python'." (tramp-send-command-and-read vec (format "%s -c \"%s\"" @@ -5568,6 +5602,8 @@ Return ATTR." "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')")))) (defun tramp-get-remote-gid (vec id-format) + "The gid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "gid-%s" id-format) (let ((res (ignore-errors @@ -5580,10 +5616,20 @@ Return ATTR." (tramp-get-remote-gid-with-python vec id-format)))))) ;; Ensure there is a valid result. (cond - ((and (equal id-format 'integer) (not (integerp res))) -1) - ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") + ((and (equal id-format 'integer) (not (integerp res))) + tramp-unknown-id-integer) + ((and (equal id-format 'string) (not (stringp res))) + tramp-unknown-id-string) (t res))))) +(defun tramp-get-env-with-u-option (vec) + "Check, whether the remote `env' command supports the -u option." + (with-tramp-connection-property vec "env-u-option" + (tramp-message vec 5 "Checking, whether `env -u' works") + ;; Option "-u" is a GNU extension. + (tramp-send-command-and-check + vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t))) + ;; Some predefined connection properties. (defun tramp-get-inline-compress (vec prop size) "Return the compress command related to PROP. @@ -5640,18 +5686,14 @@ function cell is returned to be applied on a buffer." `(lambda (beg end) (,coding beg end) (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary) - (default-directory - (tramp-compat-temporary-file-directory))) + (coding-system-for-read 'binary)) (apply 'tramp-call-process-region ,vec (point-min) (point-max) (car (split-string ,compress)) t t nil (cdr (split-string ,compress))))) `(lambda (beg end) (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary) - (default-directory - (tramp-compat-temporary-file-directory))) + (coding-system-for-read 'binary)) (apply 'tramp-call-process-region ,vec beg end (car (split-string ,compress)) t t nil @@ -5699,14 +5741,18 @@ function cell is returned to be applied on a buffer." ;; * Don't use globbing for directories with many files, as this is ;; likely to produce long command lines, and some shells choke on ;; long command lines. +;; ;; * Don't search for perl5 and perl. Instead, only search for perl and ;; then look if it's the right version (with `perl -v'). +;; ;; * When editing a remote CVS controlled file as a different user, VC ;; gets confused about the file locking status. Try to find out why ;; the workaround doesn't work. +;; ;; * Allow out-of-band methods as _last_ multi-hop. Open a connection ;; until the last but one hop via `start-file-process'. Apply it ;; also for ftp and smb. +;; ;; * WIBNI if we had a command "trampclient"? If I was editing in ;; some shell with root privileges, it would be nice if I could ;; just call @@ -5728,21 +5774,60 @@ function cell is returned to be applied on a buffer." ;; reasonably unproblematic. And maybe trampclient should have some ;; way of passing credentials, like by using an SSL socket or ;; something. (David Kastrup) +;; ;; * Reconnect directly to a compliant shell without first going ;; through the user's default shell. (Pete Forman) +;; ;; * How can I interrupt the remote process with a signal ;; (interrupt-process seems not to work)? (Markus Triska) +;; ;; * Avoid the local shell entirely for starting remote processes. If ;; so, I think even a signal, when delivered directly to the local ;; SSH instance, would correctly be propagated to the remote process ;; automatically; possibly SSH would have to be started with ;; "-t". (Markus Triska) +;; ;; * It makes me wonder if tramp couldn't fall back to ssh when scp ;; isn't on the remote host. (Mark A. Hershberger) +;; ;; * Use lsh instead of ssh. (Alfred M. Szmidt) +;; ;; * Optimize out-of-band copying when both methods are scp-like (not ;; rsync). +;; ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. +;; +;; * Implement completion for "/method:user@host:~<abc> TAB". +;; +;; * I think you could get the best of both worlds by using an +;; approach similar to Tramp but running a little tramp-daemon on +;; the other end, such that we can use a more efficient +;; communication protocol (e.g. when saving a file we could locally +;; diff it against the last version (of which the remote daemon +;; would also keep a copy), and then only send the diff). +;; +;; This said, even using such a daemon it might be difficult to get +;; good performance: part of the problem is the number of +;; round-trips. E.g. when saving a file we have to check if the +;; file was modified in the mean time and whether saving into a new +;; inode would change the owner (etc...), which each require a +;; round-trip. To get rid of these round-trips, we'd have to +;; shortcut this code and delegate the higher-level "save file" +;; operation to the remote server, which then has to perform those +;; tasks but still obeying the locally set customizations about how +;; to do each one of those tasks. +;; +;; We could either put higher-level ops in there (like +;; `save-buffer'), which implies replicating the whole `save-buffer' +;; behavior, which is a lot of work and likely to be not 100% +;; faithful. +;; +;; Or we could introduce new low-level ops that are asynchronous, +;; and then rewrite save-buffer to use them. IOW save-buffer would +;; start with a bunch of calls like `start-getting-file-attributes' +;; which could immediately be passed on to the remote side, and +;; later on checks the return value of those calls as and when +;; needed. (Stefan Monnier) ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c4dde050c83..7d0dc664f8d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -49,7 +49,9 @@ ;; This is just a guess. We don't know whether the share "C$" ;; is available for public use, and whether the user has write ;; access. - (tramp-tmpdir "/C$/Temp")))) + (tramp-tmpdir "/C$/Temp") + ;; Another guess. We might implement a better check later on. + (tramp-case-insensitive t)))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -74,14 +76,16 @@ (defcustom tramp-smb-program "smbclient" "Name of SMB client to run." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-smb-acl-program "smbcacls" "Name of SMB acls to run." :group 'tramp :type 'string - :version "24.4") + :version "24.4" + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-smb-conf "/dev/null" @@ -89,7 +93,8 @@ If it is nil, no smb.conf will be added to the `tramp-smb-program' call, letting the SMB client use the default one." :group 'tramp - :type '(choice (const nil) (file :must-match t))) + :type '(choice (const nil) (file :must-match t)) + :require 'tramp) (defvar tramp-smb-version nil "Version string of the SMB client.") @@ -129,7 +134,8 @@ call, letting the SMB client use the default one." "ERRnosuchshare" ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), - ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7). + ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), + ;; Windows 6.3 (Windows Server 2012, Windows 10). "NT_STATUS_ACCESS_DENIED" "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" @@ -239,6 +245,7 @@ See `tramp-actions-before-shell' for more info.") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -264,6 +271,7 @@ See `tramp-actions-before-shell' for more info.") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-smb-handle-make-directory) (make-directory-internal . tramp-smb-handle-make-directory-internal) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) (process-file . tramp-smb-handle-process-file) (rename-file . tramp-smb-handle-rename-file) @@ -275,6 +283,7 @@ See `tramp-actions-before-shell' for more info.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) + (temporary-file-directory . tramp-handle-temporary-file-directory) (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) @@ -290,7 +299,8 @@ If it isn't found in the local $PATH, the absolute path of winexe shall be given. This is needed for remote processes." :group 'tramp :type 'string - :version "24.3") + :version "24.3" + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-smb-winexe-shell-command "powershell.exe" @@ -298,7 +308,8 @@ shall be given. This is needed for remote processes." This must be Powershell V2 compatible." :group 'tramp :type 'string - :version "24.3") + :version "24.3" + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-smb-winexe-shell-command-switch "-file -" @@ -306,7 +317,8 @@ This must be Powershell V2 compatible." This can be used to disable echo etc." :group 'tramp :type 'string - :version "24.3") + :version "24.3" + :require 'tramp) ;; It must be a `defsubst' in order to push the whole code into ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. @@ -379,7 +391,7 @@ pass to the OPERATION." (defun tramp-smb-action-with-tar (proc vec) "Untar from connection buffer." - (if (not (memq (process-status proc) '(run open))) + (if (not (tramp-compat-process-live-p proc)) (throw 'tramp-action 'process-died) (with-current-buffer (tramp-get-connection-buffer vec) @@ -425,7 +437,7 @@ pass to the OPERATION." (delete-directory tmpdir 'recursive)))) ;; We can copy recursively. - ((or t1 t2) + ((and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) (when (and (file-directory-p newname) (not (string-equal (file-name-nondirectory dirname) (file-name-nondirectory newname)))) @@ -466,15 +478,19 @@ pass to the OPERATION." (if t1 ;; Source is remote. (append args - (list "-D" (shell-quote-argument localname) + (list "-D" (tramp-unquote-shell-quote-argument + localname) "-c" (shell-quote-argument "tar qc - *") "|" "tar" "xfC" "-" - (shell-quote-argument tmpdir))) + (tramp-unquote-shell-quote-argument + tmpdir))) ;; Target is remote. (append (list "tar" "cfC" "-" - (shell-quote-argument dirname) "." "|") + (tramp-unquote-shell-quote-argument dirname) + "." "|") args - (list "-D" (shell-quote-argument localname) + (list "-D" (tramp-unquote-shell-quote-argument + localname) "-c" (shell-quote-argument "tar qx -"))))) (unwind-protect @@ -492,7 +508,8 @@ pass to the OPERATION." ;; target. (make-directory (expand-file-name - ".." (concat tmpdir localname)) 'parents) + ".." (concat tmpdir localname)) + 'parents) (make-symbolic-link newname (directory-file-name (concat tmpdir localname)))) @@ -511,7 +528,7 @@ pass to the OPERATION." (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-with-tar) - (while (memq (process-status p) '(run open)) + (while (tramp-compat-process-live-p p) (sit-for 0.1)) (tramp-message v 6 "\n%s" (buffer-string)))) @@ -522,7 +539,10 @@ pass to the OPERATION." ;; Handle KEEP-DATE argument. (when keep-date - (set-file-times newname (nth 5 (file-attributes dirname)))) + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes dirname)))) ;; Set the mode. (unless keep-date @@ -541,7 +561,7 @@ pass to the OPERATION." (defun tramp-smb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - _preserve-uid-gid _preserve-extended-attributes) + _preserve-uid-gid _preserve-extended-attributes) "Like `copy-file' for Tramp files. KEEP-DATE has no effect in case NEWNAME resides on an SMB server. PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." @@ -584,27 +604,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." v 'file-error "Target `%s' must contain a share name" newname)) (unless (tramp-smb-send-command v (format "put \"%s\" \"%s\"" - filename (tramp-smb-get-localname v))) + (tramp-compat-file-name-unquote filename) + (tramp-smb-get-localname v))) (tramp-error v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))) ;; KEEP-DATE handling. (when keep-date - (set-file-times newname (nth 5 (file-attributes filename)))))) + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))))) (defun tramp-smb-handle-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files." (setq directory (directory-file-name (expand-file-name directory))) (when (file-exists-p directory) - (if recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (when recursive + (mapc + (lambda (file) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp))) (with-parsed-tramp-file-name directory nil ;; We must also flush the cache of the directory, because @@ -663,8 +686,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." result))) ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) - ;; Remove double entries. - (delete-dups result))) + result)) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -698,7 +720,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-action-get-acl (proc vec) "Read ACL data from connection buffer." - (when (not (memq (process-status proc) '(run open))) + (unless (tramp-compat-process-live-p proc) ;; Accept pending output. (while (tramp-accept-process-output proc 0.1)) (with-current-buffer (tramp-get-connection-buffer vec) @@ -743,7 +765,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq args (append args (list "-s" tramp-smb-conf)))) (setq args - (append args (list (shell-quote-argument localname) "2>/dev/null"))) + (append args (list (tramp-unquote-shell-quote-argument localname) + "2>/dev/null"))) (unwind-protect (with-temp-buffer @@ -880,14 +903,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." (and (file-exists-p filename) - (eq ?d (aref (nth 8 (file-attributes filename)) 0)))) + (eq ?d + (aref (tramp-compat-file-attribute-modes (file-attributes filename)) + 0)))) (defun tramp-smb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) (tramp-error - v 'file-error + v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter @@ -907,22 +932,24 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" (save-match-data - (let ((entries (tramp-smb-get-file-entries directory))) - (mapcar - (lambda (x) - (list - (if (string-match "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - entries))))))) + (delete-dups + (mapcar + (lambda (x) + (list + (if (string-match "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory)))))))) (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) - (string-match "w" (or (nth 8 (file-attributes filename)) "")) + (string-match + "w" + (or (tramp-compat-file-attribute-modes (file-attributes filename)) "")) (let ((dir (file-name-directory filename))) (and (file-exists-p dir) (file-writable-p dir))))) @@ -1007,11 +1034,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (insert (format "%10s %3d %-8s %-8s %8s %s " - (or (nth 8 attr) (nth 1 x)) ; mode - (or (nth 1 attr) 1) ; inode - (or (nth 2 attr) "nobody") ; uid - (or (nth 3 attr) "nogroup") ; gid - (or (nth 7 attr) (nth 2 x)) ; size + (or (tramp-compat-file-attribute-modes attr) (nth 1 x)) + (or (tramp-compat-file-attribute-link-number attr) 1) + (or (tramp-compat-file-attribute-user-id attr) "nobody") + (or (tramp-compat-file-attribute-group-id attr) "nogroup") + (or (tramp-compat-file-attribute-size attr) (nth 2 x)) (format-time-string (if (time-less-p (time-subtract (current-time) (nth 3 x)) tramp-half-a-year) @@ -1108,7 +1135,7 @@ target of the symlink differ." "File %s already exists; make it a new name anyway? " linkname))) (tramp-error - v2 'file-error + v2 'file-already-exists "make-symbolic-link: file %s already exists" linkname)) (unless (tramp-smb-get-cifs-capabilities v1) (tramp-error v2 'file-error "make-symbolic-link not supported")) @@ -1211,7 +1238,7 @@ target of the symlink differ." (narrow-to-region (point-max) (point-max)) (let ((p (tramp-get-connection-process v))) (tramp-smb-send-command v "exit $lasterrorcode") - (while (memq (process-status p) '(run open)) + (while (tramp-compat-process-live-p p) (sleep-for 0.1) (setq ret (process-exit-status p)))) (delete-region (point-min) (point-max)) @@ -1295,7 +1322,7 @@ target of the symlink differ." (defun tramp-smb-action-set-acl (proc vec) "Read ACL data from connection buffer." - (when (not (memq (process-status proc) '(run open))) + (unless (tramp-compat-process-live-p proc) ;; Accept pending output. (while (tramp-accept-process-output proc 0.1)) (with-current-buffer (tramp-get-connection-buffer vec) @@ -1333,7 +1360,7 @@ target of the symlink differ." (setq args (append args (list "-s" tramp-smb-conf)))) (setq args - (append args (list (shell-quote-argument localname) + (append args (list (tramp-unquote-shell-quote-argument localname) "&&" "echo" "tramp_exit_status" "0" "||" "echo" "tramp_exit_status" "1"))) @@ -1389,16 +1416,18 @@ target of the symlink differ." (defun tramp-smb-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files." (with-parsed-tramp-file-name default-directory nil - (let ((command (mapconcat 'identity (cons program args) " ")) - (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) - (name1 name) - (i 0)) + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + (command (mapconcat 'identity (cons program args) " ")) + (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) + (name1 name) + (i 0)) (unwind-protect (save-excursion (save-restriction - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -1435,15 +1464,18 @@ target of the symlink differ." "Like `handle-substitute-in-file-name' for Tramp files. \"//\" substitutes only in the local filename part. Catches errors for shares like \"C$/\", which are common in Microsoft Windows." - (with-parsed-tramp-file-name filename nil - ;; Ignore in LOCALNAME everything before "//". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) - (setq filename - (concat (file-remote-p filename) - (replace-match "\\1" nil nil localname))))) - (condition-case nil - (tramp-run-real-handler 'substitute-in-file-name (list filename)) - (error filename))) + ;; Check, whether the local part is a quoted file name. + (if (tramp-compat-file-name-quoted-p filename) + filename + (with-parsed-tramp-file-name filename nil + ;; Ignore in LOCALNAME everything before "//". + (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (setq filename + (concat (file-remote-p filename) + (replace-match "\\1" nil nil localname))))) + (condition-case nil + (tramp-run-real-handler 'substitute-in-file-name (list filename)) + (error filename)))) (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname confirm) @@ -1493,7 +1525,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (defun tramp-smb-get-share (vec) "Returns the share name of LOCALNAME." (save-match-data - (let ((localname (tramp-file-name-localname vec))) + (let ((localname + (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))) (when (string-match "^/?\\([^/]+\\)/" localname) (match-string 1 localname))))) @@ -1501,7 +1534,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." "Returns the file name of LOCALNAME. If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (save-match-data - (let ((localname (tramp-file-name-localname vec))) + (let ((localname + (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))) (setq localname (if (string-match "^/?[^/]+\\(/.*\\)" localname) @@ -1701,7 +1735,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (if (and sec min hour day month year) (encode-time sec min hour day - (cdr (assoc (downcase month) tramp-parse-time-months)) + (cdr (assoc (downcase month) parse-time-months)) year) '(0 0))) (list localname mode size mtime)))) @@ -1709,8 +1743,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (defun tramp-smb-get-cifs-capabilities (vec) "Check, whether the SMB server supports POSIX commands." ;; When we are not logged in yet, we return nil. - (if (let ((p (tramp-get-connection-process vec))) - (and p (processp p) (memq (process-status p) '(run open)))) + (if (tramp-compat-process-live-p (tramp-get-connection-process vec)) (with-tramp-connection-property (tramp-get-connection-process vec) "cifs-capabilities" (save-match-data @@ -1728,8 +1761,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." "Check, whether the SMB server supports the STAT command." ;; When we are not logged in yet, we return nil. (if (and (tramp-smb-get-share vec) - (let ((p (tramp-get-connection-process vec))) - (and p (processp p) (memq (process-status p) '(run open))))) + (tramp-compat-process-live-p (tramp-get-connection-process vec))) (with-tramp-connection-property (tramp-get-connection-process vec) "stat-capability" (tramp-smb-send-command vec "stat \"/\"")))) @@ -1796,18 +1828,17 @@ If ARGUMENT is non-nil, use it as argument for (tramp-get-connection-property p "last-cmd-time" '(0 0 0))) 60) - p (processp p) (memq (process-status p) '(run open)) + (tramp-compat-process-live-p p) (re-search-forward tramp-smb-errors nil t)) (delete-process p) (setq p nil))) ;; Check whether it is still the same share. - (unless - (and p (processp p) (memq (process-status p) '(run open)) - (or argument - (string-equal - share - (tramp-get-connection-property p "smb-share" "")))) + (unless (and (tramp-compat-process-live-p p) + (or argument + (string-equal + share + (tramp-get-connection-property p "smb-share" "")))) (save-match-data ;; There might be unread output from checking for share names. @@ -1900,6 +1931,9 @@ If ARGUMENT is non-nil, use it as argument for (tramp-set-connection-property p "smb-share" share) (tramp-set-connection-property p "chunksize" 1) + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + ;; Mark it as connected. (tramp-set-connection-property p "connected" t)) @@ -1938,7 +1972,7 @@ Returns nil if an error message has appeared." ;; Algorithm: get waiting output. See if last line contains ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err) (memq (process-status p) '(run open))) + (while (and (not found) (not err) (tramp-compat-process-live-p p)) ;; Accept pending output. (tramp-accept-process-output p 0.1) @@ -1952,7 +1986,7 @@ Returns nil if an error message has appeared." (setq err (re-search-forward tramp-smb-errors nil t))) ;; When the process is still alive, read pending output. - (while (and (not found) (memq (process-status p) '(run open))) + (while (and (not found) (tramp-compat-process-live-p p)) ;; Accept pending output. (tramp-accept-process-output p 0.1) @@ -1976,7 +2010,7 @@ Returns nil if an error message has appeared." "Send SIGKILL to the winexe process." (ignore-errors (let ((p (get-buffer-process (current-buffer)))) - (when (and p (processp p) (memq (process-status p) '(run open))) + (when (tramp-compat-process-live-p p) (signal-process (process-id p) 'SIGINT))))) (defun tramp-smb-call-winexe (vec) @@ -2015,7 +2049,7 @@ Returns nil if an error message has appeared." (defun tramp-smb-shell-quote-argument (s) "Similar to `shell-quote-argument', but uses windows cmd syntax." (let ((system-type 'ms-dos)) - (shell-quote-argument s))) + (tramp-unquote-shell-quote-argument s))) (add-hook 'tramp-unload-hook (lambda () @@ -2026,8 +2060,10 @@ Returns nil if an error message has appeared." ;;; TODO: ;; * Return more comprehensive file permission string. +;; ;; * Try to remove the inclusion of dummy "" directory. Seems to be at ;; several places, especially in `tramp-smb-handle-insert-directory'. +;; ;; * Ignore case in file names. ;;; tramp-smb.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3b8510ede48..100be3ac541 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -76,7 +76,8 @@ "Whether Tramp is enabled. If it is set to nil, all remote file names are used literally." :group 'tramp - :type 'boolean) + :type 'boolean + :require 'tramp) (defcustom tramp-verbose 3 "Verbosity level for Tramp messages. @@ -94,7 +95,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are 9 test commands 10 traces (huge)." :group 'tramp - :type 'integer) + :type 'integer + :require 'tramp) (defcustom tramp-backup-directory-alist nil "Alist of filename patterns and backup directory names. @@ -109,7 +111,8 @@ gives the same backup policy for Tramp files on their hosts like the policy for local files." :group 'tramp :type '(repeat (cons (regexp :tag "Regexp matching filename") - (directory :tag "Backup directory name")))) + (directory :tag "Backup directory name"))) + :require 'tramp) (defcustom tramp-auto-save-directory nil "Put auto-save files in this directory, if set. @@ -117,12 +120,11 @@ The idea is to use a local directory so that auto-saving is faster. This setting has precedence over `auto-save-file-name-transforms'." :group 'tramp :type '(choice (const :tag "Use default" nil) - (directory :tag "Auto save directory name"))) + (directory :tag "Auto save directory name")) + :require 'tramp) (defcustom tramp-encoding-shell - (if (memq system-type '(windows-nt)) - (getenv "COMSPEC") - "/bin/sh") + (or (tramp-compat-funcall 'w32-shell-name) "/bin/sh") "Use this program for encoding and decoding commands on the local host. This shell is used to execute the encoding and decoding command on the local host, so if you want to use `~' in those commands, you should @@ -143,24 +145,25 @@ Note that this variable is not used for remote commands. There are mechanisms in tramp.el which automatically determine the right shell to use for the remote host." :group 'tramp - :type '(file :must-match t)) + :type '(file :must-match t) + :require 'tramp) (defcustom tramp-encoding-command-switch - (if (string-match "cmd\\.exe" tramp-encoding-shell) - "/c" - "-c") + (if (tramp-compat-funcall 'w32-shell-dos-semantics) "/c" "-c") "Use this switch together with `tramp-encoding-shell' for local commands. See the variable `tramp-encoding-shell' for more information." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) (defcustom tramp-encoding-command-interactive - (unless (string-match "cmd\\.exe" tramp-encoding-shell) "-i") + (unless (tramp-compat-funcall 'w32-shell-dos-semantics) "-i") "Use this switch together with `tramp-encoding-shell' for interactive shells. See the variable `tramp-encoding-shell' for more information." :version "24.1" :group 'tramp - :type '(choice (const nil) string)) + :type '(choice (const nil) string) + :require 'tramp) ;;;###tramp-autoload (defvar tramp-methods nil @@ -252,6 +255,11 @@ pair of the form (KEY VALUE). The following KEYs are defined: In general, the global default value shall be used, but for some methods, like \"su\" or \"sudo\", a shorter timeout might be desirable. + * `tramp-case-insensitive' + Whether the remote file system handles file names case insensitive. + Only a non-nil value counts, the default value nil means to + perform further checks on the remote host. See + `tramp-connection-properties' for a way to overwrite this. What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, @@ -304,7 +312,8 @@ useful only in combination with `tramp-default-proxies-alist'.") See `tramp-methods' for possibilities. Also see `tramp-default-method-alist'." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-default-method-alist nil @@ -322,7 +331,8 @@ See `tramp-methods' for a list of possibilities for METHOD." :group 'tramp :type '(repeat (list (choice :tag "Host regexp" regexp sexp) (choice :tag "User regexp" regexp sexp) - (choice :tag "Method name" string (const nil))))) + (choice :tag "Method name" string (const nil)))) + :require 'tramp) (defcustom tramp-default-user nil "Default user to use for transferring files. @@ -331,7 +341,8 @@ It is nil by default; otherwise settings in configuration files like This variable is regarded as obsolete, and will be removed soon." :group 'tramp - :type '(choice (const nil) string)) + :type '(choice (const nil) string) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-default-user-alist nil @@ -347,13 +358,15 @@ empty string for the method name." :group 'tramp :type '(repeat (list (choice :tag "Method regexp" regexp sexp) (choice :tag " Host regexp" regexp sexp) - (choice :tag " User name" string (const nil))))) + (choice :tag " User name" string (const nil)))) + :require 'tramp) (defcustom tramp-default-host (system-name) "Default host to use for transferring files. Useful for su and sudo methods mostly." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-default-host-alist nil @@ -370,7 +383,8 @@ empty string for the method name." :version "24.4" :type '(repeat (list (choice :tag "Method regexp" regexp sexp) (choice :tag " User regexp" regexp sexp) - (choice :tag " Host name" string (const nil))))) + (choice :tag " Host name" string (const nil)))) + :require 'tramp) (defcustom tramp-default-proxies-alist nil "Route to be followed for specific host/user pairs. @@ -389,13 +403,15 @@ interpreted as a regular expression which always matches." :group 'tramp :type '(repeat (list (choice :tag "Host regexp" regexp sexp) (choice :tag "User regexp" regexp sexp) - (choice :tag " Proxy name" string (const nil))))) + (choice :tag " Proxy name" string (const nil)))) + :require 'tramp) (defcustom tramp-save-ad-hoc-proxies nil "Whether to save ad-hoc proxies persistently." :group 'tramp :version "24.3" - :type 'boolean) + :type 'boolean + :require 'tramp) (defcustom tramp-restricted-shell-hosts-alist (when (memq system-type '(windows-nt)) @@ -407,7 +423,8 @@ proxies only, see `tramp-default-proxies-alist'. If the local host runs a registered shell, it shall be added to this list, too." :version "24.3" :group 'tramp - :type '(repeat (regexp :tag "Host regexp"))) + :type '(repeat (regexp :tag "Host regexp")) + :require 'tramp) ;;;###tramp-autoload (defconst tramp-local-host-regexp @@ -468,14 +485,16 @@ the remote shell.") "String used for end of line in local processes." :version "24.1" :group 'tramp - :type 'string) + :type 'string + :require 'tramp) (defcustom tramp-rsh-end-of-line "\n" "String used for end of line in rsh connections. I don't think this ever needs to be changed, so please tell me about it if you need to change this." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) (defcustom tramp-login-prompt-regexp ".*\\(user\\|login\\)\\( .*\\)?: *" @@ -484,7 +503,8 @@ The regexp should match at end of buffer. Sometimes the prompt is reported to look like \"login as:\"." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-shell-prompt-pattern ;; Allow a prompt to start right after a ^M since it indeed would be @@ -506,7 +526,8 @@ which should work well in many cases. This regexp must match both `tramp-initial-end-of-output' and `tramp-end-of-output'." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-password-prompt-regexp (format "^.*\\(%s\\).*:\^@? *" @@ -520,7 +541,8 @@ The regexp should match at end of buffer. The `sudo' program appears to insert a `^@' character into the prompt." :version "24.4" :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-wrong-passwd-regexp (concat "^.*" @@ -544,7 +566,8 @@ The `sudo' program appears to insert a `^@' character into the prompt." "Regexp matching a `login failed' message. The regexp should match at end of buffer." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-yesno-prompt-regexp (concat @@ -555,19 +578,22 @@ The confirmation should be done with yes or no. The regexp should match at end of buffer. See also `tramp-yn-prompt-regexp'." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-yn-prompt-regexp (concat (regexp-opt '("Store key in cache? (y/n)" - "Update cached key? (y/n, Return cancels connection)") t) + "Update cached key? (y/n, Return cancels connection)") + t) "\\s-*") "Regular expression matching all y/n queries which need to be confirmed. The confirmation should be done with y or n. The regexp should match at end of buffer. See also `tramp-yesno-prompt-regexp'." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-terminal-prompt-regexp (concat "\\(" @@ -579,7 +605,8 @@ See also `tramp-yesno-prompt-regexp'." The regexp should match at end of buffer. The answer will be provided by `tramp-action-terminal', which see." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" @@ -588,18 +615,21 @@ The answer will be provided by `tramp-action-terminal', which see." Copying has been performed successfully already, so this message can be ignored safely." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-copy-failed-regexp (concat "\\(.+: " (regexp-opt '("Permission denied" "not a regular file" "is a directory" - "No such file or directory") t) + "No such file or directory") + t) "\\)\\s-*") "Regular expression matching copy problems in (s)cp operations." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defcustom tramp-process-alive-regexp "" @@ -609,7 +639,8 @@ check regularly the status of the associated process. The answer will be provided by `tramp-action-process-alive', `tramp-action-out-of-band', which see." :group 'tramp - :type 'regexp) + :type 'regexp + :require 'tramp) (defconst tramp-temp-name-prefix "tramp." "Prefix to use for temporary files. @@ -640,7 +671,8 @@ It can have the following values: :group 'tramp :version "24.4" :type '(choice (const :tag "Ange-FTP" ftp) - (const :tag "XEmacs" sep))) + (const :tag "XEmacs" sep)) + :require 'tramp) (defconst tramp-prefix-format (cond ((equal tramp-syntax 'ftp) "/") @@ -778,6 +810,12 @@ Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp ".*$" "Regexp matching localnames.") +(defconst tramp-unknown-id-string "UNKNOWN" + "String used to denote an unknown user or group") + +(defconst tramp-unknown-id-integer -1 + "Integer used to denote an unknown user or group") + ;;; File name format: (defconst tramp-remote-file-name-spec-regexp @@ -788,7 +826,7 @@ Derived from `tramp-postfix-host-format'.") tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?" tramp-postfix-ipv6-regexp "\\)" "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?") -"Regular expression matching a Tramp file name between prefix and postfix.") + "Regular expression matching a Tramp file name between prefix and postfix.") (defconst tramp-file-name-structure (list @@ -834,24 +872,14 @@ On W32 systems, the volume letter must be ignored.") See `tramp-file-name-structure' for more explanations.") ;;;###autoload -(defconst tramp-file-name-regexp +(defvar tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (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. -When tramp.el is loaded, this regular expression is prepended to -`file-name-handler-alist', and that is searched sequentially. Thus, -if the Tramp entry appears rather early in the `file-name-handler-alist' -and is a bit too general, then some files might be considered Tramp -files which are not really Tramp files. - -Please note that the entry in `file-name-handler-alist' is made when -this file \(tramp.el) is loaded. This means that this variable must be set -before loading tramp.el. Alternatively, `file-name-handler-alist' can be -updated after changing this variable. - -Also see `tramp-file-name-structure'.") +This regexp should match Tramp file names but no other file +names. When calling `tramp-register-file-name-handlers', the +initial value is overwritten by the car of `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-completion-file-name-regexp-unified @@ -906,14 +934,14 @@ checked via the following code: (erase-buffer) (let ((proc (start-process (buffer-name) (current-buffer) \"ssh\" \"-l\" user host \"wc\" \"-c\"))) - (when (memq (process-status proc) \\='(run open)) + (when (process-live-p proc) (process-send-string proc (make-string sent ?\\ )) (process-send-eof proc) (process-send-eof proc)) (while (not (progn (goto-char (point-min)) (re-search-forward \"\\\\w+\" (point-max) t))) (accept-process-output proc 1)) - (when (memq (process-status proc) \\='(run open)) + (when (process-live-p proc) (setq received (string-to-number (match-string 0))) (delete-process proc) (message \"Bytes sent: %s\\tBytes received: %s\" sent received) @@ -949,10 +977,11 @@ in the third line of the code. Please raise a bug report via \"M-x tramp-bug\" if your system needs this variable to be set as well." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) ;; Logging in to a remote host normally requires obtaining a pty. But -;; Emacs on MacOS X has process-connection-type set to nil by default, +;; Emacs on macOS has process-connection-type set to nil by default, ;; so on those systems Tramp doesn't obtain a pty. Here, we allow ;; for an override of the system default. (defcustom tramp-process-connection-type t @@ -960,7 +989,8 @@ this variable to be set as well." Tramp binds `process-connection-type' to the value given here before opening a connection to a remote host." :group 'tramp - :type '(choice (const nil) (const t) (const pty))) + :type '(choice (const nil) (const t) (const pty)) + :require 'tramp) (defcustom tramp-connection-timeout 60 "Defines the max time to wait for establishing a connection (in seconds). @@ -969,7 +999,8 @@ This can be overwritten for different connection types in `tramp-methods'. The timeout does not include the time reading a password." :group 'tramp :version "24.4" - :type 'integer) + :type 'integer + :require 'tramp) (defcustom tramp-connection-min-time-diff 5 "Defines seconds between two consecutive connection attempts. @@ -983,7 +1014,8 @@ in a short time frame. In those cases it is recommended to let-bind this variable." :group 'tramp :version "24.4" - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) (defcustom tramp-completion-reread-directory-timeout 10 "Defines seconds since last remote command before rereading a directory. @@ -995,7 +1027,8 @@ have been gone since last remote command execution. A value of t would require an immediate reread during filename completion, nil means to use always cached values for the directory contents." :group 'tramp - :type '(choice (const nil) (const t) integer)) + :type '(choice (const nil) (const t) integer) + :require 'tramp) ;;; Internal Variables: @@ -1011,14 +1044,15 @@ means to use always cached values for the directory contents." (defvar tramp-current-connection nil "Last connection timestamp.") -;;;###autoload (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-name-all-completions + . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "Alist of completion handler functions. -Used for file names matching `tramp-file-name-regexp'. Operations -not mentioned here will be handled by Tramp's file name handler -functions, or the normal Emacs functions.") +Used for file names matching `tramp-completion-file-name-regexp'. +Operations not mentioned here will be handled by Tramp's file +name handler functions, or the normal Emacs functions.") ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here. ;;;###tramp-autoload @@ -1029,12 +1063,6 @@ calling HANDLER.") ;;; Internal functions which must come first: -(defsubst tramp-user-error (vec-or-proc format &rest args) - "Signal a pilot error." - (apply - 'tramp-error vec-or-proc - (if (fboundp 'user-error) 'user-error 'error) format args)) - ;; Conversion functions between external representation and ;; internal data structure. Convenience functions for internal ;; data structure. @@ -1123,21 +1151,17 @@ entry does not exist, return nil." "Return t if NAME is a string with Tramp file name syntax." (save-match-data (and (stringp name) + ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'. + (not (string-match + (if (memq system-type '(cygwin windows-nt)) + "^/[[:alpha:]]?:" "^/:") + name)) (string-match tramp-file-name-regexp name)))) -;; Obsoleted with Tramp 2.2.7. -(defconst tramp-obsolete-methods - '("ssh1" "ssh2" "scp1" "scp2" "scpc" "rsyncc" "plink1") - "Obsolete methods.") - -(defvar tramp-warned-obsolete-methods nil - "Which methods the user has been warned to be obsolete.") - (defun tramp-find-method (method user host) "Return the right method string to use. This is METHOD, if non-nil. Otherwise, do a lookup in -`tramp-default-method-alist'. It maps also obsolete methods to -their replacement." +`tramp-default-method-alist'." (let ((result (or method (let ((choices tramp-default-method-alist) @@ -1150,19 +1174,6 @@ their replacement." (setq choices nil))) lmethod) tramp-default-method))) - ;; This is needed for a transition period only. - (when (member result tramp-obsolete-methods) - (unless (member result tramp-warned-obsolete-methods) - (if noninteractive - (warn "Method %s is obsolete, using %s" - result (substring result 0 -1)) - (unless (y-or-n-p (format "Method \"%s\" is obsolete, use \"%s\"? " - result (substring result 0 -1))) - (tramp-user-error nil "Method \"%s\" not supported" result))) - (add-to-list 'tramp-warned-obsolete-methods result)) - ;; This works with the current set of `tramp-obsolete-methods'. - ;; Must be improved, if their are more sophisticated replacements. - (setq result (substring result 0 -1))) ;; We must mark, whether a default value has been used. (if (or method (null result)) result @@ -1212,13 +1223,14 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." (methods (mapcar 'car tramp-methods))) (when (and method (not (member method methods))) (tramp-cleanup-connection vec) - (tramp-user-error vec "Unknown method \"%s\"" method)) + (tramp-compat-user-error vec "Unknown method \"%s\"" method)) (when (and (equal tramp-syntax 'ftp) host (or (null method) (get-text-property 0 'tramp-default method)) (or (null user) (get-text-property 0 'tramp-default user)) (member host methods)) (tramp-cleanup-connection vec) - (tramp-user-error vec "Host name must not match method \"%s\"" host)))) + (tramp-compat-user-error + vec "Host name must not match method \"%s\"" host)))) (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure. @@ -1227,8 +1239,9 @@ localname (file name on remote host) and hop. If NODEFAULT is non-nil, the file name parts are not expanded to their default values." (save-match-data + (unless (tramp-tramp-file-p name) + (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match (tramp-user-error nil "Not a Tramp file name: \"%s\"" name)) (let ((method (match-string (nth 1 tramp-file-name-structure) name)) (user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) @@ -1296,6 +1309,11 @@ necessary only. This function will be used in file name completion." "Get the connection buffer to be used for VEC." (or (get-buffer (tramp-buffer-name vec)) (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + ;; We use the existence of connection property "process-buffer" + ;; as indication, whether a connection is active. + (tramp-set-connection-property + vec "process-buffer" + (tramp-get-connection-property vec "process-buffer" nil)) (setq buffer-undo-list t) (setq default-directory (tramp-make-tramp-file-name @@ -1325,6 +1343,15 @@ In case a second asynchronous communication has been started, it is different from the default one." (get-process (tramp-get-connection-name vec))) +(defun tramp-set-connection-local-variables (vec) + "Set connection-local variables in the connection buffer used for VEC. +If connection-local variables are not supported by this Emacs +version, the function does nothing." + ;; `tramp-get-connection-buffer' sets proper `default-directory'." + (with-current-buffer (tramp-get-connection-buffer vec) + ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. + (tramp-compat-funcall 'hack-connection-local-variables-apply))) + (defun tramp-debug-buffer-name (vec) "A name for the debug buffer for VEC." ;; We must use `tramp-file-name-real-host', because for gateway @@ -1411,12 +1438,12 @@ ARGUMENTS to actually emit the message (if applicable)." '("tramp-backtrace" "tramp-compat-condition-case-unless-debug" "tramp-compat-funcall" + "tramp-compat-user-error" "tramp-condition-case-unless-debug" "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message" - "tramp-user-error") + "tramp-message") t) "$") fn))) @@ -1583,6 +1610,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) (defun tramp-progress-reporter-update (reporter &optional value) + "Report progress of an operation for Tramp." (let* ((parameters (cdr reporter)) (message (aref parameters 3))) (when (string-match message (or (current-message) "")) @@ -1713,16 +1741,17 @@ Example: (defun tramp-get-completion-function (method) "Returns a list of completion functions for METHOD. For definition of that list see `tramp-set-completion-function'." - (cons - ;; Hosts visited once shall be remembered. - `(tramp-parse-connection-properties ,method) + (append + `(;; Default settings are taken into account. + (tramp-parse-default-user-host ,method) + ;; Hosts visited once shall be remembered. + (tramp-parse-connection-properties ,method)) ;; The method related defaults. (cdr (assoc method tramp-completion-function-alist)))) ;;; Fontification of `read-file-name': -;; rfn-eshadow.el is part of Emacs 22. It is autoloaded. (defvar tramp-rfn-eshadow-overlay) (make-variable-buffer-local 'tramp-rfn-eshadow-overlay) @@ -1906,7 +1935,9 @@ ARGS are the arguments OPERATION has been called with." unhandled-file-name-directory vc-registered ;; Emacs 24+ only. file-acl file-notify-add-watch file-selinux-context - set-file-acl set-file-selinux-context)) + set-file-acl set-file-selinux-context + ;; Emacs 26+ only. + file-name-case-insensitive-p)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) (expand-file-name (nth 0 args)))) @@ -1933,7 +1964,9 @@ ARGS are the arguments OPERATION has been called with." (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - '(process-file shell-command start-file-process)) + '(process-file shell-command start-file-process + ;; Emacs 26+ only. + make-nearby-temp-file temporary-file-directory)) default-directory) ;; PROC. ((member operation @@ -1947,7 +1980,8 @@ ARGS are the arguments OPERATION has been called with." ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) -(defun tramp-find-foreign-file-name-handler (filename) +(defun tramp-find-foreign-file-name-handler + (filename &optional operation completion) "Return foreign file name handler if exists." (when (tramp-tramp-file-p filename) (let ((v (tramp-dissect-file-name filename t)) @@ -1955,11 +1989,17 @@ ARGS are the arguments OPERATION has been called with." elt res) ;; When we are not fully sure that filename completion is safe, ;; we should not return a handler. - (when (or (tramp-file-name-method v) (tramp-file-name-user v) + (when (or (not completion) + (tramp-file-name-method v) (tramp-file-name-user v) (and (tramp-file-name-host v) (not (member (tramp-file-name-host v) (mapcar 'car tramp-methods)))) - (not (tramp-completion-mode-p))) + ;; Some operations are safe by default. + (member + operation + '(file-name-as-directory + file-name-directory + file-name-nondirectory))) (while handler (setq elt (car handler) handler (cdr handler)) @@ -1981,18 +2021,19 @@ ARGS are the arguments OPERATION has been called with." (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler. Falls back to normal file name handler if no Tramp file name handler exists." - (if tramp-mode - (save-match-data - (let* ((filename - (tramp-replace-environment-variables - (apply 'tramp-file-name-for-operation operation args))) - (completion (tramp-completion-mode-p)) - (foreign (tramp-find-foreign-file-name-handler filename)) - result) - (with-parsed-tramp-file-name filename nil - ;; Call the backend function. - (if foreign - (tramp-condition-case-unless-debug err + (let ((filename (apply 'tramp-file-name-for-operation operation args))) + (if (and tramp-mode (tramp-tramp-file-p filename)) + (save-match-data + (let* ((filename (tramp-replace-environment-variables filename)) + (completion (tramp-completion-mode-p)) + (foreign + (tramp-find-foreign-file-name-handler + filename operation completion)) + result) + (with-parsed-tramp-file-name filename nil + ;; Call the backend function. + (if foreign + (tramp-condition-case-unless-debug err (let ((sf (symbol-function foreign))) ;; Some packages set the default directory to a ;; remote path, before respective Tramp packages @@ -2030,43 +2071,44 @@ Falls back to normal file name handler if no Tramp file name handler exists." (tramp-run-real-handler operation args))) (t result))) - ;; Trace that somebody has interrupted the operation. - ((debug quit) - (let (tramp-message-show-message) - (tramp-message - v 1 "Interrupt received in operation %s" - (cons operation args))) - ;; Propagate the quit signal. - (signal (car err) (cdr err))) - - ;; When we are in completion mode, some failed - ;; operations shall return at least a default value - ;; in order to give the user a chance to correct the - ;; file name in the minibuffer. - ;; In order to get a full backtrace, one could apply - ;; (setq tramp-debug-on-error t) - (error - (cond - ((and completion (zerop (length localname)) - (memq operation '(file-exists-p file-directory-p))) - t) - ((and completion (zerop (length localname)) - (memq operation - '(expand-file-name file-name-as-directory))) - filename) - ;; Propagate the error. - (t (signal (car err) (cdr err)))))) - - ;; Nothing to do for us. However, since we are in - ;; `tramp-mode', we must suppress the volume letter on - ;; MS Windows. - (setq result (tramp-run-real-handler operation args)) - (if (stringp result) - (tramp-drop-volume-letter result) - result))))) - - ;; When `tramp-mode' is not enabled, we don't do anything. - (tramp-run-real-handler operation args))) + ;; Trace that somebody has interrupted the operation. + ((debug quit) + (let (tramp-message-show-message) + (tramp-message + v 1 "Interrupt received in operation %s" + (cons operation args))) + ;; Propagate the quit signal. + (signal (car err) (cdr err))) + + ;; When we are in completion mode, some failed + ;; operations shall return at least a default + ;; value in order to give the user a chance to + ;; correct the file name in the minibuffer. + ;; In order to get a full backtrace, one could apply + ;; (setq tramp-debug-on-error t) + (error + (cond + ((and completion (zerop (length localname)) + (memq operation '(file-exists-p file-directory-p))) + t) + ((and completion (zerop (length localname)) + (memq operation + '(expand-file-name file-name-as-directory))) + filename) + ;; Propagate the error. + (t (signal (car err) (cdr err)))))) + + ;; Nothing to do for us. However, since we are in + ;; `tramp-mode', we must suppress the volume letter on + ;; MS Windows. + (setq result (tramp-run-real-handler operation args)) + (if (stringp result) + (tramp-drop-volume-letter result) + result))))) + + ;; When `tramp-mode' is not enabled, or the file name is quoted, + ;; we don't do anything. + (tramp-run-real-handler operation args)))) ;; In Emacs, there is some concurrency due to timers. If a timer ;; interrupts Tramp and wishes to use the same connection buffer as @@ -2095,14 +2137,17 @@ preventing reentrant calls of Tramp.") Together with `tramp-locked', this implements a locking mechanism preventing reentrant calls of Tramp.") -;;;###autoload -(progn (defun tramp-completion-file-name-handler (operation &rest args) +;; Avoid recursive loading of tramp.el. +;;;###autoload(defun tramp-completion-file-name-handler (operation &rest args) +;;;###autoload (tramp-completion-run-real-handler operation args)) + +(defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. Falls back to normal file name handler if no Tramp file name handler exists." (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and ;; When `tramp-mode' is not enabled, we don't do anything. - fn tramp-mode + fn tramp-mode (tramp-completion-mode-p) ;; For other syntaxes than `sep', the regexp matches many common ;; situations where the user doesn't actually want to use Tramp. ;; So to avoid autoloading Tramp after typing just "/s", we @@ -2118,7 +2163,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (featurep 'ido) (featurep 'icicles))) (save-match-data (apply (cdr fn) args)) - (tramp-completion-run-real-handler operation args))))) + (tramp-completion-run-real-handler operation args)))) ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) @@ -2158,6 +2203,10 @@ Falls back to normal file name handler if no Tramp file name handler exists." tramp-autoload-file-name-handler)) (let ((a1 (rassq fnh file-name-handler-alist))) (setq file-name-handler-alist (delq a1 file-name-handler-alist)))) + ;; The initial value of `tramp-file-name-regexp' is too simple + ;; minded, but we cannot give it the real value in the autoload + ;; pattern. See Bug#24889. + (setq tramp-file-name-regexp (car tramp-file-name-structure)) ;; Add the handlers. (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler)) @@ -2198,6 +2247,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;;;###autoload (defun tramp-unload-file-name-handlers () + "Unload Tramp file name handlers from `file-name-handler-alist'." (setq file-name-handler-alist (delete (rassoc 'tramp-file-name-handler file-name-handler-alist) @@ -2209,6 +2259,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;;; File name handler functions for completion mode: +;;;###autoload (defvar tramp-completion-mode nil "If non-nil, external packages signal that they are in file name completion. @@ -2228,7 +2279,6 @@ should never be set globally, the intention is to let-bind it.") ;; Tramp file name syntax. Maybe another variable should be introduced ;; overwriting this check in such cases. Or we change Tramp file name ;; syntax in order to avoid ambiguities. -;;;###tramp-autoload (defun tramp-completion-mode-p () "Check, whether method / user name / host name completion is active." (or @@ -2248,17 +2298,31 @@ should never be set globally, the intention is to let-bind it.") "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (and (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil + (let (tramp-verbose) + (and (tramp-tramp-file-p filename) (or (not (tramp-completion-mode-p)) - (let* ((tramp-verbose 0) - (p (tramp-get-connection-process v))) - (and p (processp p) (memq (process-status p) '(run open)))))))) + (tramp-compat-process-live-p + (tramp-get-connection-process + (tramp-dissect-file-name filename))))))) + +(defun tramp-completion-handle-expand-file-name (name &optional dir) + "Like `expand-file-name' for Tramp files." + (if (tramp-completion-mode-p) + (progn + ;; If DIR is not given, use `default-directory' or "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; Return NAME. + name) + + (tramp-completion-run-real-handler + 'expand-file-name (list name dir)))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; tramp-file-name structures. For all of them we return possible completions. -;;;###autoload (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." @@ -2331,7 +2395,6 @@ not in completion mode." 'file-name-all-completions (list (list filename directory))))))) ;; Method, host name and user name completion for a file. -;;;###autoload (defun tramp-completion-handle-file-name-completion (filename directory &optional predicate) "Like `file-name-completion' for Tramp files." @@ -2523,6 +2586,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-parse-default-user-host (method) + "Return a list of (user host) tuples allowed to access for METHOD. +This function is added always in `tramp-get-completion-function' +for all methods. Resulting data are derived from default settings." + `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil)))) + ;; Generic function. (defun tramp-parse-group (regexp match-level skip-regexp) "Return a (user host) tuple allowed to access. @@ -2803,7 +2872,8 @@ User is always nil." "Like `file-modes' for Tramp files." (let ((truename (or (file-truename filename) filename))) (when (file-exists-p truename) - (tramp-mode-string-to-int (nth 8 (file-attributes truename)))))) + (tramp-mode-string-to-int + (tramp-compat-file-attribute-modes (file-attributes truename)))))) ;; Localname manipulation functions that grok Tramp localnames... (defun tramp-handle-file-name-as-directory (file) @@ -2811,15 +2881,64 @@ User is always nil." ;; `file-name-as-directory' would be sufficient except localname is ;; the empty string. (let ((v (tramp-dissect-file-name file t))) - ;; Run the command on the localname portion only. + ;; Run the command on the localname portion only unless we are in + ;; completion mode. (tramp-make-tramp-file-name (tramp-file-name-method v) (tramp-file-name-user v) (tramp-file-name-host v) - (tramp-run-real-handler - 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))) + (if (and (tramp-completion-mode-p) + (zerop (length (tramp-file-name-localname v)))) + "" + (tramp-run-real-handler + 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))) (tramp-file-name-hop v)))) +(defun tramp-handle-file-name-case-insensitive-p (filename) + "Like `file-name-case-insensitive-p' for Tramp files." + ;; We make it a connection property, assuming that all file systems + ;; on the remote host behave similar. This might be wrong for + ;; mounted NFS directories or SMB/AFP shares; such more granular + ;; tests will be added in case they are needed. + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (or ;; Maybe there is a default value. + (tramp-get-method-parameter v 'tramp-case-insensitive) + + ;; There isn't. So we must check, in case there's a connection already. + (and (tramp-connectable-p filename) + (with-tramp-connection-property v "case-insensitive" + ;; The idea is to compare a file with lower case letters + ;; with the same file with upper case letters. + (let ((candidate (directory-file-name filename)) + tmpfile) + ;; Check, whether we find an existing file with lower case + ;; letters. This avoids us to create a temporary file. + (while (and (string-match + "[a-z]" (file-remote-p candidate 'localname)) + (not (file-exists-p candidate))) + (setq candidate + (directory-file-name (file-name-directory candidate)))) + ;; Nothing found, so we must use a temporary file for + ;; comparison. `make-nearby-temp-file' is added to + ;; Emacs 26+ like `file-name-case-insensitive-p', so + ;; there is no compatibility problem calling it. + (unless + (string-match "[a-z]" (file-remote-p candidate 'localname)) + (setq tmpfile + (let ((default-directory (file-name-directory filename))) + (tramp-compat-funcall 'make-nearby-temp-file "tramp.")) + candidate tmpfile)) + ;; Check for the existence of the same file with upper + ;; case letters. + (unwind-protect + (file-exists-p + (concat + (file-remote-p candidate) + (upcase (file-remote-p candidate 'localname)))) + ;; Cleanup. + (when tmpfile (delete-file tmpfile))))))))) + (defun tramp-handle-file-name-completion (filename directory &optional predicate) "Like `file-name-completion' for Tramp files." @@ -2827,11 +2946,21 @@ User is always nil." (error "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" directory)) - (try-completion - filename - (mapcar 'list (file-name-all-completions filename directory)) - (when predicate - (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) + (let (hits-ignored-extensions) + (or + (try-completion + filename (file-name-all-completions filename directory) + (lambda (x) + (when (funcall (or predicate 'identity) (expand-file-name x directory)) + (not + (and + completion-ignored-extensions + (string-match + (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) + ;; We remember the hit. + (push x hits-ignored-extensions)))))) + ;; No match. So we try again for ignored files. + (try-completion filename hits-ignored-extensions)))) (defun tramp-handle-file-name-directory (file) "Like `file-name-directory' but aware of Tramp files." @@ -2859,13 +2988,17 @@ User is always nil." (cond ((not (file-exists-p file1)) nil) ((not (file-exists-p file2)) t) - (t (time-less-p (nth 5 (file-attributes file2)) - (nth 5 (file-attributes file1)))))) + (t (time-less-p (tramp-compat-file-attribute-modification-time + (file-attributes file2)) + (tramp-compat-file-attribute-modification-time + (file-attributes file1)))))) (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." (and (file-exists-p filename) - (eq ?- (aref (nth 8 (file-attributes filename)) 0)))) + (eq ?- + (aref (tramp-compat-file-attribute-modes (file-attributes filename)) + 0)))) (defun tramp-handle-file-remote-p (filename &optional identification connected) "Like `file-remote-p' for Tramp files." @@ -2874,7 +3007,7 @@ User is always nil." (when (tramp-tramp-file-p filename) (let* ((v (tramp-dissect-file-name filename)) (p (tramp-get-connection-process v)) - (c (and p (processp p) (memq (process-status p) '(run open)) + (c (and (tramp-compat-process-live-p p) (tramp-get-connection-property p "connected" nil)))) ;; We expand the file name only, if there is already a connection. (with-parsed-tramp-file-name @@ -2891,7 +3024,7 @@ User is always nil." (defun tramp-handle-file-symlink-p (filename) "Like `file-symlink-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (let ((x (car (file-attributes filename)))) + (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) (when (stringp x) (if (file-name-absolute-p x) (tramp-make-tramp-file-name method user host x) @@ -2957,7 +3090,8 @@ User is always nil." (unwind-protect (if (not (file-exists-p filename)) (tramp-error - v 'file-error "File `%s' not found on remote host" filename) + v tramp-file-missing + "File `%s' not found on remote host" filename) (with-tramp-progress-reporter v 3 (format-message "Inserting `%s'" filename) @@ -3082,7 +3216,8 @@ User is always nil." "File `%s' does not include a `.el' or `.elc' suffix" file))) (unless noerror (when (not (file-exists-p file)) - (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file))) + (tramp-error + v tramp-file-missing "Cannot load nonexistent file `%s'" file))) (if (not (file-exists-p file)) nil (let ((tramp-message-show-message (not nomessage))) @@ -3143,7 +3278,7 @@ User is always nil." (when p (if (yes-or-no-p "A command is running. Kill it? ") (ignore-errors (kill-process p)) - (tramp-user-error p "Shell command in progress"))) + (tramp-compat-user-error p "Shell command in progress"))) (if current-buffer-p (progn @@ -3188,20 +3323,23 @@ 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." - ;; First, we must replace environment variables. - (setq filename (tramp-replace-environment-variables filename)) - (with-parsed-tramp-file-name filename nil - ;; 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 "/")))) - ;; We do not want to replace environment variables, again. - (let (process-environment) - (tramp-run-real-handler 'substitute-in-file-name (list filename))))) + ;; Check, whether the local part is a quoted file name. + (if (tramp-compat-file-name-quoted-p filename) + filename + ;; First, we must replace environment variables. + (setq filename (tramp-replace-environment-variables filename)) + (with-parsed-tramp-file-name filename nil + ;; 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 "/")))) + ;; We do not want to replace environment variables, again. + (let (process-environment) + (tramp-run-real-handler 'substitute-in-file-name (list filename)))))) (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." @@ -3212,7 +3350,9 @@ User is always nil." (let ((remote-file-name-inhibit-cache t)) ;; '(-1 65535) means file doesn't exists yet. (setq time-list - (or (nth 5 (file-attributes (buffer-file-name))) '(-1 65535))))) + (or (tramp-compat-file-attribute-modification-time + (file-attributes (buffer-file-name))) + '(-1 65535))))) ;; We use '(0 0) as a don't-know value. (unless (equal time-list '(0 0)) (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))) @@ -3236,7 +3376,7 @@ of." (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (nth 5 attr)) + (modtime (tramp-compat-file-attribute-modification-time attr)) (mt (visited-file-modtime))) (cond @@ -3276,7 +3416,7 @@ of." (defun tramp-handle-file-notify-valid-p (proc) "Like `file-notify-valid-p' for Tramp files." - (and proc (processp proc) (memq (process-status proc) '(run open)) + (and (tramp-compat-process-live-p proc) ;; Sometimes, the process is still in status `run' when the ;; file or directory to be watched is deleted already. (with-current-buffer (process-buffer proc) @@ -3371,14 +3511,14 @@ The terminal type can be configured with `tramp-terminal-type'." (defun tramp-action-process-alive (proc _vec) "Check, whether a process has finished." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. (tramp-accept-process-output proc 0.1) - (cond ((and (memq (process-status proc) '(stop exit)) + (cond ((and (not (tramp-compat-process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") (throw 'tramp-action 'ok)) @@ -3395,7 +3535,7 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-message vec 3 "Process has finished.") (throw 'tramp-action 'ok)) (tramp-message vec 3 "Process has died.") - (throw 'tramp-action 'process-died)))) + (throw 'tramp-action 'out-of-band-failed)))) (t nil))) ;;; Functions for processing the actions: @@ -3456,6 +3596,10 @@ connection buffer." (tramp-get-connection-buffer vec) vec 'file-error (cond ((eq exit 'permission-denied) "Permission denied") + ((eq exit 'out-of-band-failed) + (format-message + "Copy failed, see buffer `%s' for details" + (tramp-get-connection-buffer vec))) ((eq exit 'process-died) (substitute-command-keys (concat @@ -3470,7 +3614,7 @@ connection buffer." (with-current-buffer (tramp-get-connection-buffer vec) (let (buffer-read-only) (delete-region pos (point)))))))) -:;; Utility functions: +;;; Utility functions: (defun tramp-accept-process-output (&optional proc timeout timeout-msecs) "Like `accept-process-output' for Tramp processes. @@ -3536,14 +3680,14 @@ nil." (with-timeout (timeout) (while (not found) (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-error-with-buffer nil proc 'file-error "Process has died")) (setq found (tramp-check-for-regexp proc regexp))))) (t (while (not found) (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-error-with-buffer nil proc 'file-error "Process has died")) (setq found (tramp-check-for-regexp proc regexp))))) @@ -3738,14 +3882,40 @@ This is used internally by `tramp-file-mode-from-int'." ;;;###tramp-autoload (defun tramp-get-local-uid (id-format) + "The uid of the local user, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." (if (equal id-format 'integer) (user-uid) (user-login-name))) ;;;###tramp-autoload (defun tramp-get-local-gid (id-format) + "The gid of the local user, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." ;; `group-gid' has been introduced with Emacs 24.4. (if (and (fboundp 'group-gid) (equal id-format 'integer)) (tramp-compat-funcall 'group-gid) - (nth 3 (file-attributes "~/" id-format)))) + (tramp-compat-file-attribute-group-id (file-attributes "~/" id-format)))) + +(defun tramp-get-local-locale (&optional vec) + "Determine locale, supporting UTF8 if possible. +VEC is used for tracing." + ;; We use key nil for local connection properties. + (with-tramp-connection-property nil "locale" + (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) + locale) + (with-temp-buffer + (unless (or (memq system-type '(windows-nt)) + (not (zerop (tramp-call-process + nil "locale" nil t nil "-a")))) + (while candidates + (goto-char (point-min)) + (if (string-match (format "^%s\r?$" (regexp-quote (car candidates))) + (buffer-string)) + (setq locale (car candidates) + candidates nil) + (setq candidates (cdr candidates)))))) + ;; Return value. + (when vec (tramp-message vec 7 "locale %s" (or locale "C"))) + (or locale "C")))) ;;;###tramp-autoload (defun tramp-check-cached-permissions (vec access) @@ -3780,25 +3950,39 @@ be granted." vec (concat "uid-" suffix) nil)) (remote-gid (tramp-get-connection-property - vec (concat "gid-" suffix) nil))) + vec (concat "gid-" suffix) nil)) + (unknown-id + (if (string-equal suffix "string") + tramp-unknown-id-string tramp-unknown-id-integer))) (and file-attr (or - ;; Not a symlink - (eq t (car file-attr)) - (null (car file-attr))) + ;; Not a symlink. + (eq t (tramp-compat-file-attribute-type file-attr)) + (null (tramp-compat-file-attribute-type file-attr))) (or ;; World accessible. - (eq access (aref (nth 8 file-attr) (+ offset 6))) + (eq access + (aref (tramp-compat-file-attribute-modes file-attr) + (+ offset 6))) ;; User accessible and owned by user. (and - (eq access (aref (nth 8 file-attr) offset)) - (equal remote-uid (nth 2 file-attr))) - ;; Group accessible and owned by user's - ;; principal group. + (eq access + (aref (tramp-compat-file-attribute-modes file-attr) offset)) + (or (equal remote-uid + (tramp-compat-file-attribute-user-id file-attr)) + (equal unknown-id + (tramp-compat-file-attribute-user-id file-attr)))) + ;; Group accessible and owned by user's principal group. (and - (eq access (aref (nth 8 file-attr) (+ offset 3))) - (equal remote-gid (nth 3 file-attr))))))))))) + (eq access + (aref (tramp-compat-file-attribute-modes file-attr) + (+ offset 3))) + (or (equal remote-gid + (tramp-compat-file-attribute-group-id file-attr)) + (equal unknown-id + (tramp-compat-file-attribute-group-id + file-attr)))))))))))) ;;;###tramp-autoload (defun tramp-local-host-p (vec) @@ -3828,19 +4012,17 @@ be granted." (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." - (when (file-remote-p (tramp-get-connection-property vec "tmpdir" "")) - ;; Compatibility code: Cached value shall be the local path only. - (tramp-set-connection-property vec "tmpdir" 'undef)) - (let ((dir (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) - (with-tramp-connection-property vec "tmpdir" + (with-tramp-connection-property vec "tmpdir" + (let ((dir (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp") + (tramp-file-name-hop vec)))) (or (and (file-directory-p dir) (file-writable-p dir) (file-remote-p dir 'localname)) - (tramp-error vec 'file-error "Directory %s not accessible" dir))) - dir)) + (tramp-error vec 'file-error "Directory %s not accessible" dir)) + dir))) ;;;###tramp-autoload (defun tramp-make-tramp-temp-file (vec) @@ -3902,7 +4084,7 @@ this file, if that variable is non-nil." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (buffer-file-name)) + (tramp-compat-file-name-unquote (buffer-file-name))) tramp-auto-save-directory)))) ;; Run plain `make-auto-save-file-name'. (tramp-run-real-handler 'make-auto-save-file-name nil))) @@ -3920,6 +4102,22 @@ ALIST is of the form ((FROM . TO) ...)." (setq alist (cdr alist)))) string)) +(defun tramp-handle-temporary-file-directory () + "Like `temporary-file-directory' for Tramp files." + (catch 'result + (dolist (dir `(,(ignore-errors + (tramp-get-remote-tmpdir + (tramp-dissect-file-name default-directory))) + ,default-directory)) + (when (and (stringp dir) (file-directory-p dir) (file-writable-p dir)) + (throw 'result (expand-file-name dir)))))) + +(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix) + "Like `make-nearby-temp-file' for Tramp files." + (let ((temporary-file-directory + (tramp-compat-temporary-file-directory-function))) + (make-temp-file prefix dir-flag suffix))) + ;;; Compatibility functions section: (defun tramp-call-process @@ -3928,11 +4126,12 @@ ALIST is of the form ((FROM . TO) ...)." It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." - (let ((v (or vec + (let ((default-directory (tramp-compat-temporary-file-directory)) + (v (or vec (vector tramp-current-method tramp-current-user tramp-current-host nil nil))) (destination (if (eq destination t) (current-buffer) destination)) - result) + output error result) (tramp-message v 6 "`%s %s' %s %s" program (mapconcat 'identity args " ") infile destination) @@ -3943,13 +4142,17 @@ are written with verbosity of 6." 'call-process program infile (or destination t) display args)) ;; `result' could also be an error string. (when (stringp result) - (signal 'file-error (list result))) + (setq error result + result 1)) (with-current-buffer (if (bufferp destination) destination (current-buffer)) - (tramp-message v 6 "%d\n%s" result (buffer-string)))) + (setq output (buffer-string)))) (error - (setq result 1) - (tramp-message v 6 "%d\n%s" result (error-message-string err)))) + (setq error (error-message-string err) + result 1))) + (if (zerop (length error)) + (tramp-message v 6 "%d\n%s" result output) + (tramp-message v 6 "%d\n%s\n%s" result output error)) result)) (defun tramp-call-process-region @@ -3958,7 +4161,8 @@ are written with verbosity of 6." It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." - (let ((v (or vec + (let ((default-directory (tramp-compat-temporary-file-directory)) + (v (or vec (vector tramp-current-method tramp-current-user tramp-current-host nil nil))) (buffer (if (eq buffer t) (current-buffer) buffer)) @@ -4018,15 +4222,20 @@ Invokes `password-read' if available, `read-passwd' else." (setq auth-info (auth-source-search :max 1 - :user (or tramp-current-user t) + (and tramp-current-user :user) + tramp-current-user :host tramp-current-host - :port tramp-current-method) + :port tramp-current-method + :require + (cons + :secret (and tramp-current-user '(:user)))) auth-passwd (plist-get (nth 0 auth-info) :secret) auth-passwd (if (functionp auth-passwd) (funcall auth-passwd) auth-passwd)) - (tramp-compat-funcall 'auth-source-user-or-password + (tramp-compat-funcall + 'auth-source-user-or-password "password" tramp-current-host tramp-current-method)))) ;; Try the password cache. (let ((password (password-read pw-prompt key))) @@ -4041,7 +4250,10 @@ Invokes `password-read' if available, `read-passwd' else." ;;;###tramp-autoload (defun tramp-clear-passwd (vec) "Clear password cache for connection related to VEC." - (let ((hop (tramp-file-name-hop vec))) + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec)) + (hop (tramp-file-name-hop vec))) (when hop ;; Clear also the passwords of the hops. (tramp-clear-passwd @@ -4050,31 +4262,31 @@ Invokes `password-read' if available, `read-passwd' else." tramp-prefix-format (replace-regexp-in-string (concat tramp-postfix-hop-regexp "$") - tramp-postfix-host-format hop)))))) - (password-cache-remove - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - ""))) - -;; Snarfed code from time-date.el and parse-time.el + tramp-postfix-host-format hop))))) + ;; `auth-source-forget-user-or-password' is an obsoleted function + ;; since Emacs 24.1, it has been replaced by `auth-source-forget'. + (if (fboundp 'auth-source-forget) + (auth-source-forget + `(:max 1 ,(and user :user) ,user :host ,host :port ,method)) + (tramp-compat-funcall + 'auth-source-forget-user-or-password "password" host method)) + (password-cache-remove (tramp-make-tramp-file-name method user host "")))) + +;; Snarfed code from time-date.el. (defconst tramp-half-a-year '(241 17024) "Evaluated by \"(days-to-time 183)\".") -(defconst tramp-parse-time-months - '(("jan" . 1) ("feb" . 2) ("mar" . 3) - ("apr" . 4) ("may" . 5) ("jun" . 6) - ("jul" . 7) ("aug" . 8) ("sep" . 9) - ("oct" . 10) ("nov" . 11) ("dec" . 12)) - "Alist mapping month names to integers.") - ;;;###tramp-autoload (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." - (float-time (subtract-time t1 t2))) + ;; Starting with Emacs 25.1, we could change this to use `time-subtract'. + (float-time (tramp-compat-funcall 'subtract-time t1 t2))) + +(defun tramp-unquote-shell-quote-argument (s) + "Remove quotation prefix \"/:\" from string S, and quote it then for shell." + (shell-quote-argument (tramp-compat-file-name-unquote s))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -4107,7 +4319,7 @@ T1 and T2 are time values (as returned by `current-time' for example)." Only works for Bourne-like shells." (let ((system-type 'not-windows)) (save-match-data - (let ((result (shell-quote-argument s)) + (let ((result (tramp-unquote-shell-quote-argument s)) (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line)))) (when (and (>= (length result) 2) (string= (substring result 0 2) "\\~")) @@ -4139,11 +4351,14 @@ Only works for Bourne-like shells." (eval-after-load "esh-util" '(progn - (tramp-eshell-directory-change) + (add-hook 'eshell-first-time-mode-hook + 'tramp-eshell-directory-change) (add-hook 'eshell-directory-change-hook 'tramp-eshell-directory-change) (add-hook 'tramp-unload-hook (lambda () + (remove-hook 'eshell-first-time-mode-hook + 'tramp-eshell-directory-change) (remove-hook 'eshell-directory-change-hook 'tramp-eshell-directory-change))))) @@ -4168,30 +4383,33 @@ Only works for Bourne-like shells." ;; * In Emacs 21, `insert-directory' shows total number of bytes used ;; by the files in that directory. Add this here. +;; ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) +;; ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) -;; * Username and hostname completion. -;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'. -;; * Make `tramp-default-user' obsolete. -;; * Implement a general server-local-variable mechanism, as there are -;; probably other variables that need different values for different -;; servers too. The user could then configure a variable (such as -;; tramp-server-local-variable-alist) to define any such variables -;; that they need to, which would then be let bound as appropriate -;; in tramp functions. (Jason Rumney) +;; ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) +;; ;; * I was wondering if it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like ;; to get it executed on the remote machine where the files really ;; are. (Andrea Crotti) +;; ;; * Run emerge on two remote files. Bug is described here: ;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>. ;; (Bug#6850) +;; ;; * Use also port to distinguish connections. This is needed for ;; different hosts sitting behind a single router (distinguished by ;; different port numbers). (Tzvi Edelman) +;; +;; * Refactor code from different handlers. Start with +;; *-process-file. One idea is to generalize `tramp-send-command' +;; and friends, for most of the handlers this is the major +;; difference between the different backends. Other handlers but +;; *-process-file would profit from this as well. ;;; tramp.el ends here diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 64cc47e26a5..fad7e7f77c1 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -6,7 +6,7 @@ ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.0-pre +;; Version: 2.3.1-pre ;; This file is part of GNU Emacs. @@ -32,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.0-pre" +(defconst tramp-version "2.3.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -54,7 +54,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 23) "ok" - (format "Tramp 2.3.0-pre is not fit for %s" + (format "Tramp 2.3.1-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index 41b7a7bb9cd..46f17afed47 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -67,142 +67,18 @@ ;;------------------------------------------------------------------- Constants -(defvar webjump-sample-sites +(defgroup webjump nil + "Programmable Web hotlist." + :prefix "webjump-" + :group 'browse-url) + +(defconst webjump-sample-sites '( ;; FSF, not including Emacs-specific. ("GNU Project FTP Archive" . ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html [mirrors "ftp://ftp.gnu.org/pub/gnu/" - ;; United States - "ftp://mirrors.kernel.org/gnu" - "ftp://gatekeeper.dec.com/pub/GNU/" - "ftp://ftp.keystealth.org/pub/gnu/" - "ftp://mirrors.usc.edu/pub/gnu/" - "ftp://cudlug.cudenver.edu/pub/mirrors/ftp.gnu.org/" - "ftp://ftp.cise.ufl.edu/pub/mirrors/GNU/" - "ftp://uiarchive.cso.uiuc.edu/pub/ftp/ftp.gnu.org/gnu/" - "ftp://gnu.cs.lewisu.edu/gnu/" - "ftp://ftp.in-span.net/pub/mirrors/ftp.gnu.org/" - "ftp://gnu.ms.uky.edu/pub/mirrors/gnu/" - "ftp://ftp.algx.net/pub/gnu/" - "ftp://aeneas.mit.edu/pub/gnu/" - "ftp://ftp.egr.msu.edu/pub/gnu/" - "ftp://ftp.wayne.edu/pub/gnu/" - "ftp://wuarchive.wustl.edu/mirrors/gnu/" - "ftp://gnu.teleglobe.net/ftp.gnu.org/" - "ftp://ftp.cs.columbia.edu/archives/gnu/prep/" - "ftp://ftp.ece.cornell.edu/pub/mirrors/gnu/" - "ftp://ftp.ibiblio.org/pub/mirrors/gnu/" - "ftp://ftp.cis.ohio-state.edu/mirror/gnu/" - "ftp://ftp.club.cc.cmu.edu/gnu/" - "ftp://ftp.sunsite.utk.edu/pub/gnu/ftp/" - "ftp://thales.memphis.edu/pub/gnu/" - "ftp://gnu.wwc.edu" - "ftp://ftp.twtelecom.net/pub/GNU/" - ;; Africa - "ftp://ftp.sun.ac.za/mirrorsites/ftp.gnu.org" - ;; The Americas - "ftp://ftp.unicamp.br/pub/gnu/" - "ftp://master.softaplic.com.br/pub/gnu/" - "ftp://ftp.matrix.com.br/pub/gnu/" - "ftp://ftp.pucpr.br/gnu" - "ftp://ftp.linorg.usp.br/gnu" - "ftp://ftp.cs.ubc.ca/mirror2/gnu/" - "ftp://cs.ubishops.ca/pub/ftp.gnu.org/" - "ftp://ftp.inf.utfsm.cl/pub/gnu/" - "ftp://sunsite.ulatina.ac.cr/Mirrors/GNU/" - "ftp://www.gnu.unam.mx/pub/gnu/software/" - "ftp://gnu.cem.itesm.mx/pub/mirrors/gnu.org/" - "ftp://ftp.azc.uam.mx/mirrors/gnu/" - ;; Australia - "ftp://mirror.aarnet.edu.au/pub/gnu/" - "ftp://gnu.mirror.pacific.net.au/gnu/" - ;; Asia - "ftp://ftp.cs.cuhk.edu.hk/pub/gnu/gnu/" - "ftp://sunsite.ust.hk/pub/gnu/" - "ftp://ftp.gnupilgrims.org/pub/gnu" - "ftp://www.imtech.res.in/mirror/gnuftp/" - "ftp://kambing.vlsm.org/gnu" - "ftp://ftp.cs.huji.ac.il/mirror/GNU/" - "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/" - "ftp://core.ring.gr.jp/pub/GNU/" - "ftp://ftp.ring.gr.jp/pub/GNU/" - "ftp://mirrors.hbi.co.jp/gnu/" - "ftp://ftp.cs.titech.ac.jp/pub/gnu/" - "ftp://ftpmirror.hanyang.ac.kr/GNU/" - "ftp://ftp.linux.sarang.net/mirror/gnu/gnu/" - "ftp://ftp.xgate.co.kr/pub/mirror/gnu/" - "ftp://ftp://gnu.xinicks.com/" - "ftp://ftp.isu.net.sa/pub/gnu/" - "ftp://ftp.nctu.edu.tw/UNIX/gnu/" - "ftp://coda.nctu.edu.tw/UNIX/gnu/" - "ftp://ftp1.sinica.edu.tw/pub3/GNU/gnu/" - "ftp://gnu.cdpa.nsysu.edu.tw/gnu" - "ftp://ftp.nectec.or.th/pub/mirrors/gnu/" - ;; Europe - "ftp://ftp.gnu.vbs.at/" - "ftp://ftp.univie.ac.at/packages/gnu/" - "ftp://gd.tuwien.ac.at/gnu/gnusrc/" - "ftp://ftp.belnet.be/mirror/ftp.gnu.org/" - "ftp://gnu.blic.net/pub/gnu/" - "ftp://ftp.fi.muni.cz/pub/gnu/" - "ftp://ftp.dkuug.dk/pub/gnu/" - "ftp://sunsite.dk/mirrors/gnu" - "ftp://ftp.funet.fi/pub/gnu/prep/" - "ftp://ftp.irisa.fr/pub/gnu/" - "ftp://ftp.cs.univ-paris8.fr/mirrors/ftp.gnu.org/" - "ftp://ftp.cs.tu-berlin.de/pub/gnu/" - "ftp://ftp.leo.org/pub/comp/os/unix/gnu/" - "ftp://ftp.informatik.rwth-aachen.de/pub/gnu/" - "ftp://ftp.de.uu.net/pub/gnu/" - "ftp://ftp.freenet.de/pub/ftp.gnu.org/gnu/" - "ftp://ftp.cs.uni-bonn.de/pub/gnu/" - "ftp://ftp-stud.fht-esslingen.de/pub/Mirrors/ftp.gnu.org/" - "ftp://ftp.stw-bonn.de/pub/mirror/ftp.gnu.org/" - "ftp://ftp.math.uni-bremen.de/pub/gnu" - "ftp://ftp.forthnet.gr/pub/gnu/" - "ftp://ftp.ntua.gr/pub/gnu/" - "ftp://ftp.duth.gr/pub/gnu/" - "ftp://ftp.physics.auth.gr/pub/gnu/" - "ftp://ftp.esat.net/pub/gnu/" - "ftp://ftp.heanet.ie/mirrors/ftp.gnu.org" - "ftp://ftp.lugroma2.org/pub/gnu/" - "ftp://ftp.gnu.inetcosmos.org/pub/gnu/" - "ftp://ftp.digitaltrust.it/pub/gnu" - "ftp://ftp://rm.mirror.garr.it/mirrors/gnuftp" - "ftp://ftp.nluug.nl/pub/gnu/" - "ftp://ftp.mirror.nl/pub/mirror/gnu/" - "ftp://ftp.nl.uu.net/pub/gnu/" - "ftp://mirror.widexs.nl/pub/gnu/" - "ftp://ftp.easynet.nl/mirror/GNU/" - "ftp://ftp.win.tue.nl/pub/gnu" - "ftp://gnu.mirror.vuurwerk.net/pub/GNU/" - "ftp://gnu.kookel.org/pub/ftp.gnu.org/" - "ftp://ftp.uninett.no/pub/gnu/" - "ftp://ftp.task.gda.pl/pub/gnu/" - "ftp://sunsite.icm.edu.pl/pub/gnu/" - "ftp://ftp.man.poznan.pl/pub/gnu" - "ftp://ftp.ist.utl.pt/pub/GNU/gnu/" - "ftp://ftp.telepac.pt/pub/gnu/" - "ftp://ftp.timisoara.roedu.net/mirrors/ftp.gnu.org/pub/gnu" - "ftp://ftp.chg.ru/pub/gnu/" - "ftp://gnuftp.axitel.ru/" - "ftp://ftp.arnes.si/software/gnu/" - "ftp://ftp.etsimo.uniovi.es/pub/gnu/" - "ftp://ftp.rediris.es/pub/gnu/" - "ftp://ftp.chl.chalmers.se/pub/gnu/" - "ftp://ftp.isy.liu.se/pub/gnu/" - "ftp://ftp.luth.se/pub/unix/gnu/" - "ftp://ftp.stacken.kth.se/pub/gnu/" - "ftp://ftp.sunet.se/pub/gnu/" - "ftp://sunsite.cnlab-switch.ch/mirror/gnu/" - "ftp://ftp.ulak.net.tr/gnu/" - "ftp://ftp.gnu.org.ua" - "ftp://ftp.mcc.ac.uk/pub/gnu/" - "ftp://ftp.mirror.ac.uk/sites/ftp.gnu.org/gnu/" - "ftp://ftp.warwick.ac.uk/pub/gnu/" - "ftp://ftp.hands.com/ftp.gnu.org/" - "ftp://gnu.teleglobe.net/ftp.gnu.org/"]) + "http://ftpmirror.gnu.org"]) ("GNU Project Home Page" . "www.gnu.org") ;; Emacs. @@ -233,7 +109,7 @@ [simple-query "wikipedia.org" "wikipedia.org/wiki/" ""]) ;; Misc. general interest. - ("Interactive Weather Information Network" . webjump-to-iwin) + ("National Weather Service" . webjump-to-iwin) ("Usenet FAQs" . "www.faqs.org/faqs/") ("RTFM Usenet FAQs by Group" . @@ -254,10 +130,10 @@ "www.neilvandyke.org/webjump/") ) - "Sample hotlist for WebJump. See the documentation for the `webjump' -function and the `webjump-sites' variable.") + "Sample hotlist for WebJump. +See the documentation for `webjump' and `webjump-sites'.") -(defvar webjump-state-to-postal-alist +(defconst webjump-state-to-postal-alist '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar") ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct") ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi") @@ -277,8 +153,7 @@ function and the `webjump-sites' variable.") ;;------------------------------------------------------------ Option Variables -(defvar webjump-sites - webjump-sample-sites +(defcustom webjump-sites webjump-sample-sites "Hotlist for WebJump. The hotlist is represented as an association list, with the CAR of each cell @@ -309,33 +184,47 @@ parameter. This might come in handy for various kludges. For convenience, if the `http://', `ftp://', or `file://' prefix is missing from a URL, WebJump will make a guess at what you wanted and prepend it before -submitting the URL.") +submitting the URL." + :type '(alist :key-type (string :tag "Name") + :value-type (choice :tag "URL" + (string :tag "URL") + function + (vector :tag "Builtin" + (symbol :tag "Name") + (repeat :inline t :tag "Arguments" + string)) + (sexp :tag "Expression to eval")))) ;;------------------------------------------------------- Sample Site Functions (defun webjump-to-iwin (name) - (let ((prefix "http://iwin.nws.noaa.gov/") - (state (webjump-read-choice name "state" - (append '(("Puerto Rico" . "pr")) - webjump-state-to-postal-alist)))) - (if state - (concat prefix "iwin/" state "/" - (webjump-read-choice name "option" - '(("Hourly Report" . "hourly") - ("State Forecast" . "state") - ("Local Forecast" . "local") - ("Zone Forecast" . "zone") - ("Short-Term Forecast" . "shortterm") - ("Weather Summary" . "summary") - ("Public Information" . "public") - ("Climatic Data" . "climate") - ("Aviation Products" . "aviation") - ("Hydro Products" . "hydro") - ("Special Weather" . "special") - ("Watches and Warnings" . "warnings")) - "zone") - ".html") - prefix))) + (let* ((prefix "http://www.nws.noaa.gov/view/") + (state (webjump-read-choice name "state" + (append '(("Puerto Rico" . "pr") + ("Guam" . "gu") + ("American Samoa" . "as") + ("District of Columbia" . "dc") + ("US Virgin Islands" . "vi")) + webjump-state-to-postal-alist))) + (opt (if state + (webjump-read-choice + name "option" + '(("Hourly Report" . "hourly") + ("State Forecast" . "state") + ("Zone Forecast" . "zone") + ("Short-Term Forecast" . "shortterm") + ("Forecast Discussion" . "discussion") + ("Weather Summary" . "summary") + ("Public Information" . "public") + ("Climatic Data" . "climate") + ("Hydro Products" . "hydro") + ("Watches" . "watches") + ("Special Weather" . "special") + ("Warnings and Advisories" . "warnings") + ("Fire Weather" . "firewx")))))) + (cond (opt (concat prefix "prodsByState.php?state=" state "&prodtype=" opt)) + (state (concat prefix "states.php?state=" state)) + (t prefix)))) (defun webjump-to-risks (name) (let (issue volume) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 88ed08d4429..80b52ed9561 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -990,6 +990,14 @@ comment markers." (goto-char (point-max)))))) (set-marker end nil)) +(defun comment-make-bol-ws (len) + "Make a white-space string of width LEN for use at BOL. +When `indent-tabs-mode' is non-nil, tab characters will be used." + (if (and indent-tabs-mode (> tab-width 0)) + (concat (make-string (/ len tab-width) ?\t) + (make-string (% len tab-width) ? )) + (make-string len ? ))) + (defun comment-make-extra-lines (cs ce ccs cce min-indent max-indent &optional block) "Make the leading and trailing extra lines. This is used for `extra-line' style (or `box' style if BLOCK is specified)." @@ -1025,8 +1033,8 @@ This is used for `extra-line' style (or `box' style if BLOCK is specified)." (setq cs (replace-match fill t t s))) (string-match re e) (setq ce (replace-match fill t t e)))) - (cons (concat cs "\n" (make-string min-indent ? ) ccs) - (concat cce "\n" (make-string (+ min-indent eindent) ? ) ce)))) + (cons (concat cs "\n" (comment-make-bol-ws min-indent) ccs) + (concat cce "\n" (comment-make-bol-ws (+ min-indent eindent)) ce)))) (defmacro comment-with-narrowing (beg end &rest body) "Execute BODY with BEG..END narrowing. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index edc7414bfbf..8c249d54073 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -1521,7 +1521,7 @@ references and character references. A processing instruction consists of a target and a content string. A comment or a CDATA section contains a single string. An entity reference contains a single name. A character reference contains a character number." - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (cond ((> arg 0) (while (progn @@ -1733,7 +1733,7 @@ single name. A character reference contains a character number." ret)) (defun nxml-up-element (&optional arg) - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-backward-up-element (- arg)) @@ -1761,7 +1761,7 @@ single name. A character reference contains a character number." (apply #'error (cddr err)))))) (defun nxml-backward-up-element (&optional arg) - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-up-element (- arg)) @@ -1793,7 +1793,7 @@ single name. A character reference contains a character number." "Move forward down into the content of an element. With ARG, do this that many times. Negative ARG means move backward but still down." - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-backward-down-element (- arg)) @@ -1811,7 +1811,7 @@ Negative ARG means move backward but still down." (setq arg (1- arg))))) (defun nxml-backward-down-element (&optional arg) - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-down-element (- arg)) @@ -1839,7 +1839,7 @@ Negative ARG means move backward but still down." "Move forward over one element. With ARG, do it that many times. Negative ARG means move backward." - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-backward-element (- arg)) @@ -1858,7 +1858,7 @@ Negative ARG means move backward." "Move backward over one element. With ARG, do it that many times. Negative ARG means move forward." - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (if (< arg 0) (nxml-forward-element (- arg)) @@ -1893,7 +1893,7 @@ The paragraph marked is the one that contains point or follows point." (nxml-backward-paragraph)) (defun nxml-forward-paragraph (&optional arg) - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (cond ((< arg 0) (nxml-backward-paragraph (- arg))) @@ -1903,7 +1903,7 @@ The paragraph marked is the one that contains point or follows point." (> (setq arg (1- arg)) 0)))))) (defun nxml-backward-paragraph (&optional arg) - (interactive "p") + (interactive "^p") (or arg (setq arg 1)) (cond ((< arg 0) (nxml-forward-paragraph (- arg))) diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 946bf791ff8..239b1d11db1 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -101,7 +101,7 @@ (defgroup relax-ng nil "Validation of XML using RELAX NG." - :group 'wp + :group 'text :group 'nxml :group 'languages) diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el index bcd468c2b06..eebaa34de10 100644 --- a/lisp/obsolete/mailpost.el +++ b/lisp/obsolete/mailpost.el @@ -26,7 +26,7 @@ (defun post-mail-send-it () "The MH -post interface for `rmail-mail' to call. -To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in +To use it, include \"(setq send-mail-function \\='post-mail-send-it)\" in site-init." (let ((errbuf (if mail-interactive (generate-new-buffer " post-mail errors") diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el new file mode 100644 index 00000000000..faebcc84cba --- /dev/null +++ b/lisp/obsolete/messcompat.el @@ -0,0 +1,55 @@ +;;; messcompat.el --- making message mode compatible with mail mode + +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: mail, news +;; Obsolete-since: 26.1 + +;; This file is part of GNU Emacs. + +;; 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file tries to provide backward compatibility with sendmail.el +;; for Message mode. It should be used by simply adding +;; +;; (require 'messcompat) +;; +;; to the .emacs file. Loading it after Message mode has been +;; loaded will have no effect. + +;;; Code: + +(require 'sendmail) + +;(setq message-from-style mail-from-style) +;(setq message-interactive mail-interactive) +(setq message-setup-hook mail-setup-hook) +(setq message-mode-hook mail-mode-hook) +;(setq message-indentation-spaces mail-indentation-spaces) +;(setq message-signature mail-signature) +;(setq message-signature-file mail-signature-file) +(setq message-default-headers mail-default-headers) +(setq message-send-hook mail-send-hook) +(setq message-send-mail-function send-mail-function) + +(provide 'messcompat) + +;;; messcompat.el ends here + +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index 63af3693b5c..5119fb003d8 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -300,8 +300,6 @@ To disable timer scans, set this to zero." (:background "white"))) "Face used for highlighting the bogus whitespaces that exist in the buffer." :group 'whitespace) -(define-obsolete-face-alias 'whitespace-highlight-face - 'whitespace-highlight "22.1") (if (not (assoc 'whitespace-mode minor-mode-alist)) (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index ccc849d226a..caa461d7714 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -2809,7 +2809,7 @@ * ox-html.el (org-html-style-default): New classes `footpara' and `footdef' for the footnotes paragraphs and definitions. (org-html-format-footnote-definition): Wrap the footnote - defintions into their own div. + definitions into their own div. (org-html-paragraph): Don't add extra <br/> after a paragraph in a footnote. (org-html-container-element, org-html-divs): Mention that @@ -9043,7 +9043,7 @@ (pcomplete/org-mode/file-option/email) (pcomplete/org-mode/file-option/date): Use the new macro to offer completion over default values for #+OPTIONS, #+TITLE, #+AUTHOR, - #+EMAIL and #+DATE. + #+EMAIL and #+DATE. * org-agenda.el (org-agenda-write): Fix bug when writing agenda to an external file while `org-agenda-sticky' is non-nil. diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index ddfc8c2bf6b..2d27757fe12 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -45,7 +45,8 @@ (require 'ob) (eval-when-compile (require 'cl)) -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (declare-function org-combine-plists "org" (&rest plists)) (defvar org-babel-tangle-lang-exts) diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index bf46197c47d..3d074d8af9f 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -36,7 +36,8 @@ (eval-when-compile (require 'cl)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk")) diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 325a935760e..e5949b6cd86 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -34,8 +34,9 @@ (require 'org-compat) (require 'comint) (eval-when-compile (require 'cl)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function tramp-flush-directory-property "tramp" (vec directory)) +(declare-function with-parsed-tramp-file-name "tramp" + (filename var &rest body) t) +(declare-function tramp-flush-directory-property "tramp-cache" (key directory)) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index d0a0d9b6d55..c76d276369f 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -37,22 +37,17 @@ (defvar org-babel-call-process-region-original nil) (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) -(declare-function show-all "outline" ()) +(declare-function outline-show-all "outline" ()) (declare-function org-every "org" (pred seq)) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) -(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) -(declare-function tramp-file-name-user "tramp" (vec)) -(declare-function tramp-file-name-host "tramp" (vec)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name quietp)) + (&optional context code edit-buffer-name)) (declare-function org-edit-src-exit "org-src" (&optional context)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) (declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) @@ -73,7 +68,8 @@ (hook function &optional append local)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (declare-function orgtbl-to-orgtbl "org-table" (table params)) (declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) (declare-function org-babel-lob-get-info "ob-lob" nil) @@ -2669,7 +2665,7 @@ of the string." (start end program &optional delete buffer display &rest args) "Use Tramp to handle `call-process-region'. Fixes a bug in `tramp-handle-call-process-region'." - (if (and (featurep 'tramp) (file-remote-p default-directory)) + (if (file-remote-p default-directory) (let ((tmpfile (tramp-compat-make-temp-file ""))) (write-region start end tmpfile) (when delete (delete-region start end)) @@ -2684,13 +2680,12 @@ Fixes a bug in `tramp-handle-call-process-region'." (apply org-babel-call-process-region-original start end program delete buffer display args))) -(defun org-babel-local-file-name (file) - "Return the local name component of FILE." - (if (file-remote-p file) - (let (localname) - (with-parsed-tramp-file-name file nil - localname)) - file)) +(defalias 'org-babel-local-file-name + (if (fboundp 'file-local-name) + 'file-local-name + (lambda (file) + "Return the local name component of FILE." + (or (file-remote-p file 'localname) file)))) (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index c0480f4bdeb..ae4d703e833 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -32,7 +32,8 @@ '((:hlines . "yes") (:colnames . "no")) "Default arguments for evaluating an emacs-lisp source block.") -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (defun org-babel-expand-body:emacs-lisp (body params) "Expand BODY according to PARAMS, return the expanded body." diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index c04e1307314..dbe7ba7b312 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -45,7 +45,7 @@ (declare-function org-fill-template "org" (template alist)) (declare-function org-split-string "org" (string &optional separators)) (declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-context "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-escape-code-in-string "org-src" (s)) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 0dcb1ba6175..abf45af8523 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -41,9 +41,10 @@ (require 'ob) (eval-when-compile (require 'cl)) -(declare-function org-time-string-to-time "org" (s)) +(declare-function org-time-string-to-time "org" (s &optional buffer pos)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (declare-function gnuplot-mode "ext:gnuplot-mode" ()) (declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) (declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index ec9a5113f73..fc1b4d781a3 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -150,7 +150,8 @@ specifying a variable of the same value." (defvar org-export-copy-to-kill-ring) (declare-function org-export-to-file "ox" (backend file - &optional async subtreep visible-only body-only ext-plist)) + &optional async subtreep visible-only body-only + ext-plist post-process)) (defun org-babel-haskell-export-to-lhs (&optional arg) "Export to a .lhs file with all haskell code blocks escaped. When called with a prefix argument the resulting diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 1f5e2979f92..c08717d7c7b 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -32,11 +32,12 @@ ;;; Code: (require 'ob) -(declare-function org-create-formula-image "org" (string tofile options buffer)) +(declare-function org-create-formula-image "org" + (string tofile options buffer &optional type)) (declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) (declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-compile "ox-latex" (file)) +(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index ed377e530ad..2bfbd4e0d0d 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -33,7 +33,7 @@ (declare-function org-remove-indentation "org" ) (declare-function py-shell "ext:python-mode" (&optional argprompt)) (declare-function py-toggle-shells "ext:python-mode" (arg)) -(declare-function run-python "ext:python" (cmd &optional dedicated show)) +(declare-function run-python "ext:python" (&optional cmd dedicated show)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index 83baf9c5e70..685fa01b63e 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -45,10 +45,11 @@ (defvar geiser-default-implementation) ; Defined in geiser-impl.el (defvar geiser-active-implementations) ; Defined in geiser-impl.el -(declare-function run-geiser "geiser-repl" (impl)) -(declare-function geiser-mode "geiser-mode" ()) -(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) -(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) +(declare-function run-geiser "ext:geiser-repl" (impl)) +(declare-function geiser-mode "ext:geiser-mode" ()) +(declare-function geiser-eval-region "ext:geiser-mode" + (start end &optional and-go raw nomsg)) +(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg)) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 5f234b5edbc..b6f0404bbcd 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -30,11 +30,10 @@ (require 'shell) (eval-when-compile (require 'cl)) -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) (declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) (declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) -(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-generic "org-table" + (table params &optional backend)) (defvar org-babel-default-header-args:sh '()) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index bfd5a062fc1..2e42d94831e 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -31,13 +31,13 @@ (require 'cl)) (declare-function org-edit-special "org" (&optional arg)) -(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-link-escape "org" (text &optional table merge)) (declare-function org-store-link "org" (arg)) (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) (declare-function org-heading-components "org" ()) -(declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-fill-template "org" (template alist)) -(declare-function org-babel-update-block-body "org" (new-body)) +(declare-function org-babel-update-block-body "ob-core" (new-body)) (declare-function make-directory "files" (dir &optional parents)) (defcustom org-babel-tangle-lang-exts diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index e77b53aadca..19f9a822bd6 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -52,7 +52,7 @@ (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) -(declare-function calendar-absolute-from-iso "cal-iso" (date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function calendar-astro-date-string "cal-julian" (&optional date)) (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) (declare-function calendar-chinese-date-string "cal-china" (&optional date)) @@ -3903,7 +3903,7 @@ functions do." (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") -(defvar org-agenda-last-marker-time (org-float-time) +(defvar org-agenda-last-marker-time (float-time) "Creation time of the last agenda marker.") (defun org-agenda-new-marker (&optional pos) @@ -3911,7 +3911,7 @@ functions do." Org-mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point))))) - (setq org-agenda-last-marker-time (org-float-time)) + (setq org-agenda-last-marker-time (float-time)) (if org-agenda-buffer (with-current-buffer org-agenda-buffer (push m org-agenda-markers)) @@ -5231,7 +5231,7 @@ So the example above may also be written as The function expects the lisp variables `entry' and `date' to be provided by the caller, because this is how the calendar works. Don't use this function from a program - use `org-agenda-get-day-entries' instead." - (when (> (- (org-float-time) + (when (> (- (float-time) org-agenda-last-marker-time) 5) ;; I am not sure if this works with sticky agendas, because the marker @@ -5243,7 +5243,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) - (time (org-float-time)) + (time (float-time)) file rtn results) (when (or (not org-diary-last-run-time) (> (- time @@ -5912,9 +5912,9 @@ See also the user option `org-agenda-clock-consistency-checks'." (throw 'next t)) (setq ts (match-string 1) te (match-string 3) - ts (org-float-time + ts (float-time (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time + te (float-time (apply 'encode-time (org-parse-time-string te))) dt (- te ts)))) (cond diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 92e5d4470e1..2e849d2e0f6 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -120,7 +120,7 @@ (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function org-babel-trim "ob" (string &optional regexp)) +(declare-function org-babel-trim "ob-core" (string &optional regexp)) ;;; Bibtex data diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 9374f5fc3a3..7b55153b5f9 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -32,7 +32,7 @@ (require 'cl)) (require 'org) -(declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function notifications-notify "notifications" (&rest params)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (declare-function org-refresh-properties "org" (dprop tprop)) @@ -658,8 +658,8 @@ If not, show simply the clocked time like 01:50." The time returned includes the time spent on this task in previous clocking intervals." (let ((currently-clocked-time - (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) + (floor (- (float-time) + (float-time org-clock-start-time)) 60))) (+ currently-clocked-time (or org-clock-total-time 0)))) (defun org-clock-modify-effort-estimate (&optional value) @@ -978,7 +978,7 @@ to be CLOCKED OUT.")))) nil 45))) (and (not (memq char-pressed '(?i ?q))) char-pressed))))) (default - (floor (/ (org-float-time + (floor (/ (float-time (time-subtract (current-time) last-valid)) 60))) (keep (and (memq ch '(?k ?K)) @@ -987,8 +987,8 @@ to be CLOCKED OUT.")))) (and (memq ch '(?g ?G)) (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) - (barely-started-p (< (- (org-float-time last-valid) - (org-float-time (cdr clock))) 45)) + (barely-started-p (< (- (float-time last-valid) + (float-time (cdr clock))) 45)) (start-over (and subtractp barely-started-p))) (cond ((memq ch '(?j ?J)) @@ -1047,8 +1047,8 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (lambda (clock) (format "Dangling clock started %d mins ago" - (floor (- (org-float-time) - (org-float-time (cdr clock))) + (floor (- (float-time) + (float-time (cdr clock))) 60))))) (or last-valid (cdr clock))))))))))) @@ -1057,7 +1057,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling "Return the current Emacs idle time in seconds, or nil if not idle." (let ((idle-time (current-idle-time))) (if idle-time - (org-float-time idle-time) + (float-time idle-time) 0))) (defun org-mac-idle-seconds () @@ -1109,7 +1109,7 @@ so long." (function (lambda (clock) (format "Clocked in & idle for %.1f mins" - (/ (org-float-time + (/ (float-time (time-subtract (current-time) org-clock-user-idle-start)) 60.0)))) @@ -1271,9 +1271,9 @@ make this the default behavior.)" (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " - (/ (- (org-float-time + (/ (- (float-time (org-current-time org-clock-rounding-minutes t)) - (org-float-time leftover)) 60))) + (float-time leftover)) 60))) leftover) start-time (org-current-time org-clock-rounding-minutes t))) @@ -1517,8 +1517,8 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) - (org-float-time (apply 'encode-time (org-parse-time-string ts)))) + (setq s (- (float-time (apply 'encode-time (org-parse-time-string te))) + (float-time (apply 'encode-time (org-parse-time-string ts)))) h (floor (/ s 3600)) s (- s (* 3600 h)) m (floor (/ s 60)) @@ -1630,13 +1630,13 @@ Optional argument N tells to change by that many units." (let ((ts (if updatets1 ts2 ts1)) (begts (if updatets1 begts1 begts2))) (setq tdiff - (subtract-time + (time-subtract (org-time-string-to-time org-last-changed-timestamp) (org-time-string-to-time ts))) (save-excursion (goto-char begts) (org-timestamp-change - (round (/ (org-float-time tdiff) + (round (/ (float-time tdiff) (cond ((eq org-ts-what 'minute) 60) ((eq org-ts-what 'hour) 3600) ((eq org-ts-what 'day) (* 24 3600)) @@ -1739,8 +1739,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." time) (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) - (if (consp tstart) (setq tstart (org-float-time tstart))) - (if (consp tend) (setq tend (org-float-time tend))) + (if (consp tstart) (setq tstart (float-time tstart))) + (if (consp tend) (setq tend (float-time tend))) (remove-text-properties (point-min) (point-max) `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) @@ -1752,9 +1752,9 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." ;; Two time stamps (setq ts (match-string 2) te (match-string 3) - ts (org-float-time + ts (float-time (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time + te (float-time (apply 'encode-time (org-parse-time-string te))) ts (if tstart (max ts tstart) ts) te (if tend (min te tend) te) @@ -1771,10 +1771,10 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (equal (marker-position org-clock-hd-marker) (point)) tstart tend - (>= (org-float-time org-clock-start-time) tstart) - (<= (org-float-time org-clock-start-time) tend)) - (let ((time (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (let ((time (floor (- (float-time) + (float-time org-clock-start-time)) 60))) (setq t1 (+ t1 time)))) (let* ((headline-forced (get-text-property (point) @@ -2584,17 +2584,17 @@ from the dynamic block definition." ((numberp ts) ;; If ts is a number, it's an absolute day number from org-agenda. (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) - (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + (setq ts (float-time (encode-time 0 0 0 day month year))))) (ts - (setq ts (org-float-time + (setq ts (float-time (apply 'encode-time (org-parse-time-string ts)))))) (cond ((numberp te) ;; Likewise for te. (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) - (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (setq te (float-time (encode-time 0 0 0 day month year))))) (te - (setq te (org-float-time + (setq te (float-time (apply 'encode-time (org-parse-time-string te)))))) (setq tsb (if (eq step0 'week) @@ -2788,9 +2788,9 @@ Otherwise, return nil." (end-of-line 1) (setq ts (match-string 1) te (match-string 3)) - (setq s (- (org-float-time + (setq s (- (float-time (apply 'encode-time (org-parse-time-string te))) - (org-float-time + (float-time (apply 'encode-time (org-parse-time-string ts)))) neg (< s 0) s (abs s) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index fdf24b265df..c089866af86 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -31,7 +31,7 @@ (eval-when-compile (require 'cl)) (require 'org) -(declare-function org-agenda-redo "org-agenda" ()) +(declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-agenda-do-context-action "org-agenda" ()) (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index cf6aafc9854..912ec5a7a0a 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -34,8 +34,6 @@ (require 'org-macs) -(declare-function w32-focus-frame "term/w32-win" (frame)) - ;; The following constant is for backward compatibility. We do not use ;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) ;; at compilation time and can therefore optimize code better. @@ -411,10 +409,9 @@ Pass BUFFER to the XEmacs version of `move-to-column'." (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0))))) -(defalias 'org-float-time - (if (featurep 'xemacs) 'time-to-seconds 'float-time)) +(define-obsolete-function-alias 'org-float-time 'float-time "26.1") -;; `user-error' is only available from 24.2.50 on +;; `user-error' is only available from 24.3 on (unless (fboundp 'user-error) (defalias 'user-error 'error)) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 6d6f996954a..38f4a9fac4f 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -93,7 +93,8 @@ (require 'org) (require 'sha1) -(declare-function url-retrieve-synchronously "url" (url)) +(declare-function url-retrieve-synchronously "url" + (url &optional silent inhibit-cookies timeout)) (declare-function xml-node-children "xml" (node)) (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index ed6d11d5514..fd7dd0bcb4e 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -38,7 +38,6 @@ ;; Declare external functions and variables (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) -(declare-function nnimap-group-overview-filename "nnimap" (group server)) ;; The following line suppresses a compiler warning stemming from gnus-sum.el (declare-function gnus-summary-last-subject "gnus-sum" nil) ;; Customization variables @@ -78,6 +77,8 @@ this variable to t." ;; Implementation +;; FIXME: nnimap-group-overview-filename was removed from Gnus in +;; September 2010. Perhaps remove this function? (defun org-gnus-nnimap-cached-article-number (group server message-id) "Return cached article number (uid) of message in GROUP on SERVER. MESSAGE-ID is the message-id header field that identifies the diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 8eb69550801..4ee5ee4e2e8 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -34,8 +34,8 @@ ;; Declare external functions and variables -(declare-function Info-find-node "info" (filename nodename - &optional no-going-back)) +(declare-function Info-find-node "info" + (filename nodename &optional no-going-back strict-case)) (defvar Info-current-file) (defvar Info-current-node) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 2c1e3775b0d..a84c0039087 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -115,7 +115,7 @@ (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-at-heading-p "org" (&optional invisible-ok)) -(declare-function org-previous-line-empty-p "org" ()) +(declare-function org-previous-line-empty-p "org" (&optional next)) (declare-function org-remove-if "org" (predicate seq)) (declare-function org-reduced-level "org" (L)) (declare-function org-show-subtree "org" ()) @@ -2884,7 +2884,7 @@ ignores hidden links." (save-excursion (re-search-forward org-ts-regexp-both (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) - (t (org-float-time now)))) + (t (float-time now)))) ((= dcst ?x) (or (and (stringp (match-string 1)) (match-string 1)) "")) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index d8e2fd3534f..f6bb6b3d3a9 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -48,7 +48,6 @@ (declare-function org-remove-double-quotes "org" (s)) (declare-function org-mode "org" ()) (declare-function org-file-contents "org" (file &optional noerror)) -(declare-function org-with-wide-buffer "org-macs" (&rest body)) ;;; Variables diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 4ffa547b7fb..a74a5a0ce41 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -45,7 +45,8 @@ (string (decode-char 'ucs c))))) (declare-function org-add-props "org-compat" (string plist &rest props)) -(declare-function org-string-match-p "org-compat" (&rest args)) +(declare-function org-string-match-p "org-compat" + (regexp string &optional start)) (defmacro org-with-gensyms (symbols &rest body) (declare (debug (sexp body)) (indent 1)) diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 26799967af6..09e637a49a4 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -258,7 +258,7 @@ When completing for #+STARTUP, for example, this function returns (buffer-name (buffer-base-buffer))))))) -(declare-function org-export-backend-options "org-export" (cl-x)) +(declare-function org-export-backend-options "ox" (cl-x) t) (defun pcomplete/org-mode/file-option/options () "Complete arguments for the #+OPTIONS file option." (while (pcomplete-here diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 2f2c54b6af6..667b7482d09 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -119,7 +119,7 @@ (eval-when-compile (require 'cl)) -(declare-function org-publish-get-project-from-filename "org-publish" +(declare-function org-publish-get-project-from-filename "ox-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 20334f30504..3292590e8ed 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -303,7 +303,7 @@ The car of each element is a name of a constant, without the `$' before it. The cdr is the value as a string. For example, if you'd like to use the speed of light in a formula, you would configure - (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) + (setq org-table-formula-constants \\='((\"c\" . \"299792458.\"))) and then use it in an equation like `$1*$c'. diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 667f6021b0d..079bed42d0d 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -123,7 +123,7 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- (org-float-time) delta)))) + (- (float-time) delta)))) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) @@ -142,9 +142,9 @@ With prefix arg STOP, stop it entirely." (setq org-timer-start-time (seconds-to-time (- - (org-float-time) - (- (org-float-time org-timer-pause-time) - (org-float-time org-timer-start-time)))) + (float-time) + (- (float-time org-timer-pause-time) + (float-time org-timer-start-time)))) org-timer-pause-time nil) (org-timer-set-mode-line 'on) (run-hooks 'org-timer-continue-hook) @@ -194,10 +194,10 @@ it in the buffer." (defvar org-timer-timer-is-countdown nil) (defun org-timer-seconds () (if org-timer-timer-is-countdown - (- (org-float-time org-timer-start-time) - (org-float-time)) - (- (org-float-time org-timer-pause-time) - (org-float-time org-timer-start-time)))) + (- (float-time org-timer-start-time) + (float-time)) + (- (float-time org-timer-pause-time) + (float-time org-timer-start-time)))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) diff --git a/lisp/org/org.el b/lisp/org/org.el index 6e7d54d39c0..15f45822026 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -127,7 +127,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function orgtbl-mode "org-table" (&optional arg)) (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) -(declare-function org-beamer-mode "ox-beamer" ()) +(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) (declare-function org-table-edit-field "org-table" (arg)) (declare-function org-table-justify-field-maybe "org-table" (&optional new)) (declare-function org-table-set-constants "org-table" ()) @@ -135,7 +135,8 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-id-get-create "org-id" (&optional force)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) -(declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) +(declare-function org-agenda-list "org-agenda" + (&optional arg start-day span with-hour)) (declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-table-align "org-table" ()) (declare-function org-table-begin "org-table" (&optional table-type)) @@ -154,7 +155,8 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-element-interpret-data "org-element" (data &optional parent)) (declare-function org-element-map "org-element" - (data types fun &optional info first-match no-recursion)) + (data types fun &optional + info first-match no-recursion with-affiliated)) (declare-function org-element-nested-p "org-element" (elem-a elem-b)) (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) @@ -448,7 +450,8 @@ For export specific modules, see also `org-export-backends'." (defvar org-export--registered-backends) ; From ox.el. (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) -(declare-function org-export-backend-name "ox" (backend)) +(declare-function org-export-backend-name "ox" (backend) t) +(declare-function org-export-backend-options "ox" (cl-x) t) (defcustom org-export-backends '(ascii html icalendar latex) "List of export back-ends that should be always available. @@ -1937,7 +1940,7 @@ See `org-file-apps'.") ("eps.gz" . "gv %s") ("dvi" . "xdvi %s") ("fig" . "xfig %s")) - "Default file applications on a MacOS X system. + "Default file applications on a macOS system. The system \"open\" is known as a default, but we use X11 applications for some files for which the OS does not have a good default. See `org-file-apps'.") @@ -2012,7 +2015,7 @@ file identifier are (\"html\" . default) to the list as well. t Default for files not matched by any of the other options. `system' The system command to open files, like `open' on Windows - and Mac OS X, and mailcap under GNU/Linux. This is the command + and macOS, and mailcap under GNU/Linux. This is the command that will be selected if you call `C-c C-o' with a double \\[universal-argument] \\[universal-argument] prefix. @@ -4213,7 +4216,7 @@ Normal means, no org-mode-specific context." (defvar mark-active) ;; Various packages -(declare-function calendar-absolute-from-iso "cal-iso" (date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function calendar-forward-day "cal-move" (arg)) (declare-function calendar-goto-date "cal-move" (date)) (declare-function calendar-goto-today "cal-move" ()) @@ -4225,14 +4228,15 @@ Normal means, no org-mode-specific context." (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) (defvar font-lock-unfontify-region-function) (declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional default require-match start matches-set)) + (prompt &optional + default require-match _predicate start matches-set)) (defvar iswitchb-temp-buflist) (declare-function org-gnus-follow-link "org-gnus" (&optional group article)) (defvar org-agenda-tags-todo-honor-ignore-options) (declare-function org-agenda-skip "org-agenda" ()) (declare-function org-agenda-format-item "org-agenda" - (extra txt &optional level category tags dotime noprefix remove-re habitp)) + (extra txt &optional level category tags dotime remove-re habitp)) (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) @@ -5280,7 +5284,6 @@ This variable is set by `org-before-change-function'. ;; Other stuff we need. (require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) (require 'overlay) @@ -5514,8 +5517,8 @@ the rounding returns a past time." (apply 'encode-time (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) (nthcdr 2 time)))) - (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) - (seconds-to-time (- (org-float-time res) (* r 60))) + (if (and past (< (float-time (time-subtract (current-time) res)) 0)) + (seconds-to-time (- (float-time res) (* r 60))) res)))) (defun org-today () @@ -8779,24 +8782,24 @@ links." (if (or (re-search-forward org-ts-regexp end t) (re-search-forward org-ts-regexp-both end t)) (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?c) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") end t) (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?s) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-scheduled-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?d) (let ((end (save-excursion (outline-next-heading) (point)))) (if (re-search-forward org-deadline-time-regexp end t) (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) + (float-time now)))) ((= dcst ?p) (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) @@ -8860,7 +8863,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." (lambda (x) (if (or (string-match org-ts-regexp x) (string-match org-ts-regexp-both x)) - (org-float-time + (float-time (org-time-string-to-time (match-string 0 x))) 0)) comparefun (if (= dcst sorting-type) '< '>))) @@ -12039,8 +12042,6 @@ This function can be used in a hook." ;;;; Completion -(declare-function org-export-backend-name "org-export" (cl-x)) -(declare-function org-export-backend-options "org-export" (cl-x)) (defun org-get-export-keywords () "Return a list of all currently understood export keywords. Export keywords include options, block names, attributes and @@ -15069,7 +15070,7 @@ a *different* entry, you cannot use these techniques." (if (not scope) (progn (org-agenda-prepare-buffers - (list (buffer-file-name (current-buffer)))) + (and buffer-file-name (list buffer-file-name))) (setq res (org-scan-tags func matcher todo-only start-level))) ;; Get the right scope (cond @@ -15081,7 +15082,7 @@ a *different* entry, you cannot use these techniques." (setq scope (org-agenda-files t)) (setq scope (org-add-archive-files scope))) ((eq scope 'file) - (setq scope (list (buffer-file-name)))) + (setq scope (and buffer-file-name (list buffer-file-name)))) ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name)))))) (org-agenda-prepare-buffers scope) @@ -16296,10 +16297,10 @@ So these are more for recording a certain time/date." (message ""))) (org-defkey map ">" (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) + (org-eval-in-calendar '(calendar-scroll-left 1)))) (org-defkey map "<" (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-eval-in-calendar '(calendar-scroll-right 1)))) (org-defkey map "\C-v" (lambda () (interactive) (org-eval-in-calendar @@ -16886,7 +16887,7 @@ Don't touch the rest." (defun org-time-stamp-to-now (timestamp-string &optional seconds) "Difference between TIMESTAMP-STRING and now in days. If SECONDS is non-nil, return the difference in seconds." - (let ((fdiff (if seconds 'org-float-time 'time-to-days))) + (let ((fdiff (if seconds 'float-time 'time-to-days))) (- (funcall fdiff (org-time-string-to-time timestamp-string)) (funcall fdiff (current-time))))) @@ -17041,8 +17042,8 @@ days in order to avoid rounding problems." (match-end (match-end 0)) (time1 (org-time-string-to-time ts1)) (time2 (org-time-string-to-time ts2)) - (t1 (org-float-time time1)) - (t2 (org-float-time time2)) + (t1 (float-time time1)) + (t2 (float-time time2)) (diff (abs (- t2 t1))) (negative (< (- t2 t1) 0)) ;; (ys (floor (* 365 24 60 60))) @@ -17107,7 +17108,7 @@ days in order to avoid rounding problems." (defun org-time-string-to-seconds (s) "Convert a timestamp string to a number of seconds." - (org-float-time (org-time-string-to-time s))) + (float-time (org-time-string-to-time s))) (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) "Convert a time stamp to an absolute day number. @@ -17459,8 +17460,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) - (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) - (nthcdr 6 time0))) + (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)))) (when (and (member org-ts-what '(hour minute)) extra (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) @@ -22663,7 +22663,7 @@ contains commented lines. Otherwise, comment them." "Non-nil when TIMESTAMP has a time specified." (org-element-property :hour-start timestamp)) -(defun org-timestamp-format (timestamp format &optional end utc) +(defun org-timestamp-format (timestamp format &optional end zone) "Format a TIMESTAMP element into a string. FORMAT is a format specifier to be passed to @@ -22672,8 +22672,11 @@ FORMAT is a format specifier to be passed to When optional argument END is non-nil, use end of date-range or time-range, if possible. -When optional argument UTC is non-nil, time will be expressed as -Universal Time." +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, `wall' for system wall clock time, or a string as +in the TZ environment variable. It can also be a list (as from +`current-time-zone') or an integer (as from `decode-time') +applied without consideration for daylight saving time." (format-time-string format (apply 'encode-time @@ -22683,7 +22686,7 @@ Universal Time." (if end '(:minute-end :hour-end :day-end :month-end :year-end) '(:minute-start :hour-start :day-start :month-start :year-start))))) - utc)) + zone)) (defun org-timestamp-split-range (timestamp &optional end) "Extract a timestamp object from a date or time range. diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index 0d34ba19f45..cd54d1ee8de 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -393,7 +393,8 @@ Universal Time, ignoring `org-icalendar-date-time-format'." ;; Convert timestamp into internal time in order to use ;; `format-time-string' and fix any mistake (i.e. MI >= 60). (encode-time 0 mi h d m y) - (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) + (not (not (or utc (and with-time-p + (org-icalendar-use-UTC-date-time-p))))))))) (defun org-icalendar-dtstamp () "Return DTSTAMP property, as a string." diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index 2734f90db06..db4075e6612 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -690,7 +690,7 @@ a list containing two strings: the name of the option, and the value. For example, (setq org-latex-listings-options - '((\"basicstyle\" \"\\\\small\") + \\='((\"basicstyle\" \"\\\\small\") (\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\"))) will typeset the code in a small size font with underlined, bold @@ -737,7 +737,7 @@ be a list containing two strings: the name of the option, and the value. For example, (setq org-latex-minted-options - '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) + \\='((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) will result in src blocks being exported with @@ -758,7 +758,7 @@ It is used during export of src blocks by the listings and minted latex packages. For example, (setq org-latex-custom-lang-environments - '((python \"pythoncode\"))) + \\='((python \"pythoncode\"))) would have the effect that if org encounters begin_src python during latex export it will output diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el index 4d9dae5f765..1408e1476d7 100644 --- a/lisp/org/ox-man.el +++ b/lisp/org/ox-man.el @@ -207,7 +207,7 @@ It is used during export of src blocks by the listings and man packages. For example, (setq org-man-custom-lang-environments - '((python \"pythoncode\"))) + \\='((python \"pythoncode\"))) would have the effect that if org encounters begin_src python during man export." diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index f2b0c9198b7..944437b56cf 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -852,7 +852,7 @@ ON-OR-OFF := t | nil For example, with the following configuration \(setq org-odt-table-styles - '((\"TableWithHeaderRowsAndColumns\" \"Custom\" + \\='((\"TableWithHeaderRowsAndColumns\" \"Custom\" ((use-first-row-styles . t) (use-first-column-styles . t))) (\"TableWithHeaderColumns\" \"Custom\" diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 6221c70b88a..aa1d197b533 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -25,7 +25,7 @@ ;;; Code: (require 'ox) -(declare-function htmlize-buffer "htmlize" (&optional buffer)) +(declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) (defgroup org-export-org nil "Options for exporting Org mode files to Org." diff --git a/lisp/outline.el b/lisp/outline.el index 2001cdf27b1..dca5f1a7de8 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -38,7 +38,7 @@ (defgroup outlines nil "Support for hierarchical outlining." :prefix "outline-" - :group 'wp) + :group 'text) (defvar outline-regexp "[*\^L]+" "Regular expression to match the beginning of a heading. @@ -388,9 +388,9 @@ at the end of the buffer." nil 'move)) (defsubst outline-invisible-p (&optional pos) - "Non-nil if the character after POS is invisible. + "Non-nil if the character after POS has outline invisible property. If POS is nil, use `point' instead." - (get-char-property (or pos (point)) 'invisible)) + (eq (get-char-property (or pos (point)) 'invisible) 'outline)) (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. @@ -788,7 +788,8 @@ Show the heading too, if it is currently invisible." 'show-entry 'outline-show-entry "25.1") (defun outline-hide-body () - "Hide all body lines in buffer, leaving all headings visible." + "Hide all body lines in buffer, leaving all headings visible. +Note that this does not hide the lines preceding the first heading line." (interactive) (outline-hide-region-body (point-min) (point-max))) @@ -868,7 +869,12 @@ Show the heading too, if it is currently invisible." nil)) (defun outline-hide-sublevels (levels) - "Hide everything but the top LEVELS levels of headers, in whole buffer." + "Hide everything but the top LEVELS levels of headers, in whole buffer. +This also unhides the top heading-less body, if any. + +Interactively, the prefix argument supplies the value of LEVELS. +When invoked without a prefix argument, LEVELS defaults to the level +of the current heading, or to 1 if the current line is not a heading." (interactive (list (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) @@ -909,7 +915,8 @@ Show the heading too, if it is currently invisible." 'hide-sublevels 'outline-hide-sublevels "25.1") (defun outline-hide-other () - "Hide everything except current body and parent and top-level headings." + "Hide everything except current body and parent and top-level headings. +This also unhides the top heading-less body, if any." (interactive) (outline-hide-sublevels 1) (let (outline-view-change-hook) diff --git a/lisp/paren.el b/lisp/paren.el index 53eb50077f2..e37cacef485 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -81,11 +81,6 @@ whitespace there." :type 'boolean :version "25.1") -(define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") - -(define-obsolete-face-alias 'show-paren-mismatch-face - 'show-paren-mismatch "22.1") - (defcustom show-paren-highlight-openparen t "Non-nil turns on openparen highlighting when matching forward. When nil, and point stands just before an open paren, the paren diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 66f3d10c5cb..cdcee626837 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -44,6 +44,11 @@ ;;; in the string when the whole string finally reaches its ;;; specified position. +(defgroup animate nil + "Make text dance." + :group 'games + :prefix "animate-") + (defun animate-initialize (string vpos hpos) (let ((characters nil)) (dotimes (i (length string)) @@ -88,8 +93,9 @@ (unless (eolp) (delete-char 1)) (insert-char char 1)) -(defvar animate-n-steps 10 -"*Number of steps `animate-string' will place a char before its last position.") +(defcustom animate-n-steps 10 + "Number of steps `animate-string' will place a char before its last position." + :type 'integer) (defvar animation-buffer-name nil "String naming the default buffer for animations. diff --git a/lisp/play/studly.el b/lisp/play/studly.el index f6aae4548b1..ff1bf03e118 100644 --- a/lisp/play/studly.el +++ b/lisp/play/studly.el @@ -25,10 +25,10 @@ (setq begin (point)) (while (and (<= (point) end) (not (looking-at "\\W*\\'"))) - (forward-word 1) - (backward-word 1) + (forward-word-strictly 1) + (backward-word-strictly 1) (setq begin (max (point) begin)) - (forward-word 1) + (forward-word-strictly 1) (let ((offset 0) (word-end (min (point) end)) c) @@ -55,7 +55,7 @@ "Studlify-case the current word, or COUNT words if given an argument." (interactive "*p") (let ((begin (point)) end rb re) - (forward-word count) + (forward-word-strictly count) (setq end (point)) (setq rb (min begin end) re (max begin end)) (studlify-region rb re))) diff --git a/lisp/plstore.el b/lisp/plstore.el index 62c50c0f4a1..01bdd144ac0 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -99,10 +99,12 @@ If neither t nor nil, doesn't ask user." (const :tag "Don't ask" silent)) :group 'plstore) -(defvar plstore-encrypt-to nil - "*Recipient(s) used for encrypting secret entries. +(defcustom plstore-encrypt-to nil + "Recipient(s) used for encrypting secret entries. May either be a string or a list of strings. If it is nil, -symmetric encryption will be used.") +symmetric encryption will be used." + :type '(choice (const nil) (repeat :tag "Recipient(s)" string)) + :group 'plstore) (put 'plstore-encrypt-to 'safe-local-variable (lambda (val) diff --git a/lisp/printing.el b/lisp/printing.el index 3bd5a67298d..7cf0afbf1fd 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1668,7 +1668,7 @@ separator; otherwise, ensure unix-style directory separator." :link '(emacs-library-link :tag "Source Lisp File" "printing.el") :prefix "pr-" :version "22.1" - :group 'wp + :group 'text :group 'postscript) @@ -2272,7 +2272,7 @@ Useful links: * gv 3.5, June 1997 `http://www.cs.wisc.edu/~ghost/gv/gv_doc/gv.html' -* MacGSView (MacOS) +* MacGSView (Mac OS) `http://www.cs.wisc.edu/~ghost/macos/index.htm' " :type '(string :tag "Ghostview Utility") @@ -5673,7 +5673,7 @@ If menu binding was not done, calls `pr-menu-bind'." (or (listp switches) (error "%S should have a list of strings" mess)) (lpr-flatten-list ; dynamic evaluation - (mapcar 'ps-eval-switch switches))) + (mapcar #'lpr-eval-switch switches))) (defun pr-ps-preview (kind n-up filename mess) diff --git a/lisp/proced.el b/lisp/proced.el index dee646ced4c..db45e202088 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -78,9 +78,6 @@ the external command (usually \"kill\")." ("KILL" . " (9. Kill - cannot be caught or ignored)") ("ALRM" . " (14. Alarm Clock)") ("TERM" . " (15. Termination)") - ;; POSIX 1003.1-2001 - ;; Which systems do not support these signals so that we can - ;; exclude them from `proced-signal-list'? ("CONT" . " (Continue executing)") ("STOP" . " (Stop executing / pause - cannot be caught or ignored)") ("TSTP" . " (Terminal stop / pause)")) diff --git a/lisp/profiler.el b/lisp/profiler.el index 401cae537e6..dac42fec0c7 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -534,6 +534,7 @@ RET: expand or collapse")) (define-key map "\r" 'profiler-report-toggle-entry) (define-key map "\t" 'profiler-report-toggle-entry) (define-key map "i" 'profiler-report-toggle-entry) + (define-key map [mouse-1] 'profiler-report-toggle-entry) (define-key map "f" 'profiler-report-find-entry) (define-key map "j" 'profiler-report-find-entry) (define-key map [mouse-2] 'profiler-report-find-entry) @@ -692,7 +693,8 @@ With a prefix argument, expand the whole subtree." (defun profiler-report-toggle-entry (&optional arg) "Expand entry at point if the tree is collapsed, -otherwise collapse." +otherwise collapse. With prefix argument, expand all subentries +below entry at point." (interactive "P") (or (profiler-report-expand-entry arg) (profiler-report-collapse-entry))) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 12ab5b01ab3..0c25d4d42ea 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -778,7 +778,7 @@ the 4 file locations can be clicked on and jumped to." (beginning-of-line) (looking-at ada-compile-goto-error-file-linenr-re)) (save-excursion - (if (looking-at "\\([0-9]+\\)") (backward-word 1)) + (if (looking-at "\\([0-9]+\\)") (backward-word-strictly 1)) (looking-at "line \\([0-9]+\\)")))) ) (let ((line (if (match-beginning 2) (match-string 2) (match-string 1))) @@ -1337,7 +1337,8 @@ the file name." (save-excursion (let ((aa-end (point))) (ada-adjust-case-region - (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point)) + (progn (goto-char (symbol-value 'beg)) (forward-word-strictly -1) + (point)) (goto-char aa-end))))) (defun ada-region-selected () @@ -1395,7 +1396,8 @@ The standard casing rules will no longer apply to this word." (save-excursion (skip-syntax-backward "w") (setq word (buffer-substring-no-properties - (point) (save-excursion (forward-word 1) (point))))))) + (point) (save-excursion (forward-word-strictly 1) + (point))))))) ;; Reread the exceptions file, in case it was modified by some other, (ada-case-read-exceptions-from-file file-name) @@ -1444,7 +1446,8 @@ word itself has a special casing." (skip-syntax-backward "w") (setq word (buffer-substring-no-properties (point) - (save-excursion (forward-word 1) (point)))))) + (save-excursion (forward-word-strictly 1) + (point)))))) (modify-syntax-entry ?_ (make-string 1 underscore-syntax) (syntax-table)))))) @@ -1477,7 +1480,8 @@ word itself has a special casing." ;; do not add it again. This way, the user can easily decide which ;; priority should be applied to each casing exception (let ((word (buffer-substring-no-properties - (point) (save-excursion (forward-word 1) (point))))) + (point) (save-excursion (forward-word-strictly 1) + (point))))) ;; Handling a substring ? (if (char-equal (string-to-char word) ?*) @@ -1567,7 +1571,7 @@ and the exceptions defined in `ada-case-exception-file'." (defun ada-after-keyword-p () "Return t if cursor is after a keyword that is not an attribute." (save-excursion - (forward-word -1) + (forward-word-strictly -1) (and (not (and (char-before) (or (= (char-before) ?_) (= (char-before) ?'))));; unless we have a _ or ' @@ -1868,7 +1872,7 @@ Return the equivalent internal parameter list." (goto-char apos) (ada-goto-next-non-ws) (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws)) ;; read type of parameter @@ -2472,7 +2476,7 @@ and the offset." (forward-comment -1000) (if (= (char-before) ?\)) (forward-sexp -1) - (forward-word -1)) + (forward-word-strictly -1)) ;; If there is a parameter list, and we have a function declaration ;; or a access to subprogram declaration @@ -2480,26 +2484,26 @@ and the offset." (if (and (= (following-char) ?\() (save-excursion (or (progn - (backward-word 1) + (backward-word-strictly 1) (looking-at "\\(function\\|procedure\\)\\>")) (progn - (backward-word 1) + (backward-word-strictly 1) (setq num-back 2) (looking-at "\\(function\\|procedure\\)\\>"))))) ;; The indentation depends of the value of ada-indent-return (if (<= (eval var) 0) (list (point) (list '- var)) - (list (progn (backward-word num-back) (point)) + (list (progn (backward-word-strictly num-back) (point)) var)) ;; Else there is no parameter list, but we have a function ;; Only do something special if the user want to indent ;; relative to the "function" keyword (if (and (> (eval var) 0) - (save-excursion (forward-word -1) + (save-excursion (forward-word-strictly -1) (looking-at "function\\>"))) - (list (progn (forward-word -1) (point)) var) + (list (progn (forward-word-strictly -1) (point)) var) ;; Else... (ada-indent-on-previous-lines nil orgpoint orgpoint))))))) @@ -2600,7 +2604,7 @@ and the offset." ;; avoid "with procedure"... in generic parts (save-excursion - (forward-word -1) + (forward-word-strictly -1) (setq found (not (looking-at "with")))))) (cond @@ -2759,7 +2763,7 @@ ORGPOINT is the limit position used in the calculation." ;; yes, look what's following 'end' (progn - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws) (cond ;; @@ -2776,7 +2780,7 @@ ORGPOINT is the limit position used in the calculation." (save-excursion (ada-check-matching-start (match-string 0)) ;; we are now looking at the matching "record" statement - (forward-word 1) + (forward-word-strictly 1) (ada-goto-stmt-start) ;; now on the matching type declaration, or use clause (unless (looking-at "\\(for\\|type\\)\\>") @@ -2891,7 +2895,7 @@ ORGPOINT is the limit position used in the calculation." (looking-at "\\<then\\>")) (setq cur-indent (save-excursion (back-to-indentation) (point)))) ;; skip 'then' - (forward-word 1) + (forward-word-strictly 1) (list cur-indent 'ada-indent)) (list cur-indent 'ada-broken-indent)))) @@ -2902,7 +2906,7 @@ ORGPOINT is the limit position used in the calculation." (let ((pos nil)) (cond ((save-excursion - (forward-word 1) + (forward-word-strictly 1) (setq pos (ada-goto-next-non-ws orgpoint))) (goto-char pos) (save-excursion @@ -3141,8 +3145,8 @@ ORGPOINT is the limit position used in the calculation." (and (goto-char (match-end 0)) (ada-goto-next-non-ws orgpoint) - (forward-word 1) - (if (= (char-after) ?') (forward-word 1) t) + (forward-word-strictly 1) + (if (= (char-after) ?') (forward-word-strictly 1) t) (ada-goto-next-non-ws orgpoint) (looking-at "\\<use\\>") ;; @@ -3224,7 +3228,7 @@ ORGPOINT is the limit position used in the calculation." "end" nil orgpoint nil 'word-search-forward)) (ada-goto-next-non-ws) (looking-at "\\<record\\>") - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws) (= (char-after) ?\;))) (goto-char (car match-dat)) @@ -3334,7 +3338,7 @@ is the end of the match." (save-excursion (ada-goto-previous-word) (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]"))) - (forward-word -1)) + (forward-word-strictly -1)) ((looking-at "is") (setq found @@ -3355,7 +3359,7 @@ is the end of the match." ((looking-at "private") (save-excursion - (backward-word 1) + (backward-word-strictly 1) (setq found (not (looking-at "is"))))) (t @@ -3459,18 +3463,18 @@ Moves point to the beginning of the declaration." (if (looking-at "\\<declare\\>") (progn (forward-comment -1) - (backward-word 1)) + (backward-word-strictly 1)) ;; ;; no, => 'procedure'/'function'/'task'/'protected' ;; (progn - (forward-word 2) - (backward-word 1) + (forward-word-strictly 2) + (backward-word-strictly 1) ;; ;; skip 'body' 'type' ;; (if (looking-at "\\<\\(body\\|type\\)\\>") - (forward-word 1)) + (forward-word-strictly 1)) (forward-sexp 1) (backward-sexp 1))) ;; @@ -3566,7 +3570,7 @@ otherwise throw error." ;; ((looking-at "if") (save-excursion - (forward-word -1) + (forward-word-strictly -1) (unless (looking-at "\\<end[ \t\n]*if\\>") (progn (setq nest-count (1- nest-count)) @@ -3636,7 +3640,7 @@ otherwise throw error." ;; ((looking-at "when") (save-excursion - (forward-word -1) + (forward-word-strictly -1) (unless (looking-at "\\<exit[ \t\n]*when\\>") (progn (if stop-at-when @@ -3687,7 +3691,7 @@ If GOTOTHEN is non-nil, point moves to the `then' following `if'." (unless (and (looking-at "\\<record\\>") (save-excursion - (forward-word -1) + (forward-word-strictly -1) (looking-at "\\<null\\>"))) (progn ;; calculate nest-depth @@ -3739,7 +3743,7 @@ If GOTOTHEN is non-nil, point moves to the `then' following `if'." (number-to-string (count-lines 1 (1+ current))))))) (unless (looking-at "renames") (progn - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws) ;; ignore it if it is only a declaration with 'new' ;; We could have package Foo is new .... @@ -3755,13 +3759,13 @@ If GOTOTHEN is non-nil, point moves to the `then' following `if'." ;; found task start => check if it has a body ((looking-at "task") (save-excursion - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws) (cond ((looking-at "\\<body\\>")) ((looking-at "\\<type\\>") ;; In that case, do nothing if there is a "is" - (forward-word 2);; skip "type" + (forward-word-strictly 2);; skip "type" (ada-goto-next-non-ws);; skip type name ;; Do nothing if we are simply looking at a simple @@ -3781,7 +3785,7 @@ If GOTOTHEN is non-nil, point moves to the `then' following `if'." (t ;; Check if that task declaration had a block attached to ;; it (i.e do nothing if we have just "task name;") - (unless (progn (forward-word 1) + (unless (progn (forward-word-strictly 1) (looking-at "[ \t]*;")) (setq nest-count (1- nest-count)))))) (setq last-was-begin (cdr last-was-begin)) @@ -3906,7 +3910,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found." ;; ;; calculate nest-depth ;; - (backward-word 1) + (backward-word-strictly 1) (cond ;; procedures and functions need to be processed recursively, in ;; case they are defined in a declare/begin block, as in: @@ -3925,7 +3929,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found." ((and (looking-at "\\<procedure\\|function\\>")) (if first - (forward-word 1) + (forward-word-strictly 1) (setq pos (point)) (ada-search-ignore-string-comment "is\\|;") @@ -3946,7 +3950,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found." (skip-chars-forward "end") (ada-goto-next-non-ws) (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>")) - (forward-word 1))) + (forward-word-strictly 1))) ;; found package start => check if it really starts a block, and is not ;; in fact a generic instantiation for instance @@ -3965,7 +3969,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found." (if (not first) (setq nest-count (1+ nest-count))) (setq found (<= nest-count 0)) - (forward-word 1))) ; end of 'cond' + (forward-word-strictly 1))) ; end of 'cond' (setq first nil)) @@ -4077,7 +4081,7 @@ Assumes point to be at the end of a statement." (save-excursion (and (looking-at "\\<or\\>") (progn - (forward-word 1) + (forward-word-strictly 1) (ada-goto-stmt-start) (looking-at "\\<or\\>"))))) @@ -4100,7 +4104,7 @@ Return nil if the private is part of the package name, as in (progn (forward-comment -1000) (and (not (bobp)) (or (= (char-before) ?\;) - (and (forward-word -3) + (and (forward-word-strictly -3) (looking-at "\\<package\\>")))))))) @@ -4120,11 +4124,11 @@ Return nil if the private is part of the package name, as in (skip-chars-backward " \t\n") (if (= (char-before) ?\") (backward-char 3) - (backward-word 1)) + (backward-word-strictly 1)) t) ;; and now over the second one - (backward-word 1) + (backward-word-strictly 1) ;; We should ignore the case when the reserved keyword is in a ;; comment (for instance, when we have: @@ -4150,7 +4154,7 @@ Return nil if the private is part of the package name, as in If BACKWARDP is non-nil, search backward; search forward otherwise." (let (result) (while (and (setq result (ada-search-ignore-string-comment regexp backwardp)) - (save-excursion (forward-word -1) + (save-excursion (forward-word-strictly -1) (looking-at "and then\\|or else")))) result)) @@ -4343,9 +4347,9 @@ of the region. Otherwise, operate only on the current line." (ada-in-string-or-comment-p) (and (progn (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) + (backward-word-strictly 1)) (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) + (backward-word-strictly 1)) (or (looking-at "[ \t]*\\<end\\>") (error "Not on end ...;"))) (ada-goto-matching-start 1) @@ -4399,7 +4403,7 @@ Moves to `begin' if in a declarative part." ((save-excursion (and (ada-goto-stmt-start) (looking-at "\\<task\\>" ) - (forward-word 1) + (forward-word-strictly 1) (ada-goto-next-non-ws) (looking-at "\\<body\\>"))) (ada-search-ignore-string-comment "begin" nil nil nil @@ -5020,7 +5024,7 @@ Since the search can be long, the results are cached." (skip-chars-forward " \t\n") (if (looking-at "return") (progn - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward " \t\n") (skip-chars-forward "a-zA-Z0-9_'"))) @@ -5271,8 +5275,8 @@ for `ada-procedure-start-regexp'." ((or (looking-at "^[ \t]*procedure") (setq func-found (looking-at "^[ \t]*function"))) ;; treat it as a proc/func - (forward-word 2) - (forward-word -1) + (forward-word-strictly 2) + (forward-word-strictly -1) (setq procname (buffer-substring (point) (cdr match))) ; store proc name ;; goto end of procname @@ -5285,7 +5289,7 @@ for `ada-procedure-start-regexp'." ;; if function, skip over 'return' and result type. (if func-found (progn - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward " \t\n") (setq functype (buffer-substring (point) (progn @@ -5327,7 +5331,7 @@ for `ada-procedure-start-regexp'." (if (looking-at "^[ \t]*task") (progn (message "Task conversion is not yet implemented") - (forward-word 2) + (forward-word-strictly 2) (if (looking-at "[ \t]*;") (forward-line) (ada-move-to-end)) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 8518163a1b7..b3248d3f13b 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -174,7 +174,7 @@ If GVD is not the debugger used, nothing happens." :type 'boolean :group 'ada) (defcustom ada-xref-search-with-egrep t - "If non-nil, use egrep to find the possible declarations for an entity. + "If non-nil, use grep -E to find the possible declarations for an entity. This alternate method is used when the exact location was not found in the information provided by GNAT. However, it might be expensive if you have a lot of sources, since it will search in all the files in your project." @@ -2013,7 +2013,7 @@ This function should be used when the standard algorithm that parses the exist. This function attempts to find the possible declarations for the identifier anywhere in the object path. -This command requires the external `egrep' program to be available. +This command requires the external `grep' program to be available. This works well when one is using an external library and wants to find the declaration and documentation of the subprograms one is using." diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index ee81add340c..3df7c1312ef 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -824,16 +824,11 @@ font-lock keywords according to `font-lock-defaults' used for the code in the grammar's actions and semantic predicates, see `antlr-font-lock-maximum-decoration'.") -(defvar antlr-default-face 'antlr-default) (defface antlr-default '((t nil)) "Face to prevent strings from language dependent highlighting. Do not change." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-default-face 'face-alias 'antlr-default) -(put 'antlr-font-lock-default-face 'obsolete-face "22.1") -(defvar antlr-keyword-face 'antlr-keyword) (defface antlr-keyword (cond-emacs-xemacs '((((class color) (background light)) @@ -841,11 +836,7 @@ Do not change." (t :inherit font-lock-keyword-face))) "ANTLR keywords." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword) -(put 'antlr-font-lock-keyword-face 'obsolete-face "22.1") -(defvar antlr-syntax-face 'antlr-keyword) (defface antlr-syntax (cond-emacs-xemacs '((((class color) (background light)) @@ -853,11 +844,7 @@ Do not change." (t :inherit font-lock-constant-face))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax) -(put 'antlr-font-lock-syntax-face 'obsolete-face "22.1") -(defvar antlr-ruledef-face 'antlr-ruledef) (defface antlr-ruledef (cond-emacs-xemacs '((((class color) (background light)) @@ -865,11 +852,7 @@ Do not change." (t :inherit font-lock-function-name-face))) "ANTLR rule references (definition)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef) -(put 'antlr-font-lock-ruledef-face 'obsolete-face "22.1") -(defvar antlr-tokendef-face 'antlr-tokendef) (defface antlr-tokendef (cond-emacs-xemacs '((((class color) (background light)) @@ -877,31 +860,19 @@ Do not change." (t :inherit font-lock-function-name-face))) "ANTLR token references (definition)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef) -(put 'antlr-font-lock-tokendef-face 'obsolete-face "22.1") -(defvar antlr-ruleref-face 'antlr-ruleref) (defface antlr-ruleref '((((class color) (background light)) (:foreground "blue4")) (t :inherit font-lock-type-face)) "ANTLR rule references (usage)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref) -(put 'antlr-font-lock-ruleref-face 'obsolete-face "22.1") -(defvar antlr-tokenref-face 'antlr-tokenref) (defface antlr-tokenref '((((class color) (background light)) (:foreground "orange4")) (t :inherit font-lock-type-face)) "ANTLR token references (usage)." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref) -(put 'antlr-font-lock-tokenref-face 'obsolete-face "22.1") -(defvar antlr-literal-face 'antlr-literal) (defface antlr-literal (cond-emacs-xemacs '((((class color) (background light)) @@ -911,9 +882,6 @@ Do not change." It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." :group 'antlr) -;; backward-compatibility alias -(put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal) -(put 'antlr-font-lock-literal-face 'obsolete-face "22.1") (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. @@ -932,56 +900,58 @@ group. The string matched by the first group is highlighted with (cond-emacs-xemacs `((antlr-invalidate-context-cache) ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 antlr-tokendef-face)) - ("\\$\\sw+" (0 antlr-keyword-face)) + (1 'antlr-tokendef)) + ("\\$\\sw+" (0 'antlr-keyword)) ;; the tokens are already fontified as string/docstrings: (,(lambda (limit) (if antlr-font-lock-literal-regexp (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 antlr-literal-face t) + (1 'antlr-literal t) :XEMACS (0 nil)) ; XEmacs bug workaround (,(lambda (limit) (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 antlr-keyword-face) - (2 antlr-ruledef-face) - (3 antlr-keyword-face) + (1 'antlr-keyword) + (2 'antlr-ruledef) + (3 'antlr-keyword) (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - antlr-keyword-face - font-lock-type-face))) + 'antlr-keyword + 'font-lock-type-face))) (,(lambda (limit) (antlr-re-search-forward "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" limit)) - (1 antlr-keyword-face)) + (1 'antlr-keyword)) (,(lambda (limit) (antlr-re-search-forward "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" limit)) - (1 font-lock-type-face) ; not XEmacs's java level-3 fruit salad + (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) - antlr-tokendef-face - antlr-ruledef-face) nil t) - (4 antlr-syntax-face nil t)) + 'antlr-tokendef + 'antlr-ruledef) + nil t) + (4 'antlr-syntax nil t)) (,(lambda (limit) (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) - antlr-tokendef-face - antlr-ruledef-face) nil t) - (2 antlr-syntax-face nil t)) + 'antlr-tokendef + 'antlr-ruledef) + nil t) + (2 'antlr-syntax nil t)) (,(lambda (limit) ;; v:ruleref and v:"literal" is allowed... (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) - antlr-default-face - font-lock-variable-name-face) + 'antlr-default + 'font-lock-variable-name-face) (if (antlr-upcase-p (char-after (match-beginning 1))) - antlr-tokenref-face - antlr-ruleref-face))) - (2 antlr-default-face nil t)) + 'antlr-tokenref + 'antlr-ruleref))) + (2 'antlr-default nil t)) (,(lambda (limit) (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 antlr-syntax-face)))) + (0 'antlr-syntax)))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.") diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index d59503be61a..a2077be24fc 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -449,7 +449,7 @@ class Foo class Foo Works with: inher-cont." (save-excursion (goto-char (c-langelem-pos langelem)) - (forward-word 1) + (forward-word-strictly 1) (if (looking-at "[ \t]*$") c-basic-offset (c-forward-syntactic-ws) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 6761de11700..cdca67c698d 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1501,15 +1501,24 @@ No indentation or other \"electric\" behavior is performed." (setq n (1- n)))) n) -(defun c-narrow-to-most-enclosing-decl-block (&optional inclusive) +(defun c-narrow-to-most-enclosing-decl-block (&optional inclusive level) ;; If we are inside a decl-block (in the sense of c-looking-at-decl-block), ;; i.e. something like namespace{} or extern{}, narrow to the insides of ;; that block (NOT including the enclosing braces) if INCLUSIVE is nil, - ;; otherwise include the braces. If the closing brace is missing, - ;; (point-max) is used instead. + ;; otherwise include the braces and the declaration which introduces them. + ;; If the closing brace is missing, (point-max) is used instead. LEVEL, if + ;; non-nil, says narrow to the LEVELth decl-block outward, default value + ;; being 1. (let ((paren-state (c-parse-state)) encl-decl) - (setq encl-decl (and paren-state (c-most-enclosing-decl-block paren-state))) + (setq level (or level 1)) + (while (> level 0) + (setq encl-decl (c-most-enclosing-decl-block paren-state)) + (if encl-decl + (progn + (while (> (c-pull-open-brace paren-state) encl-decl)) + (setq level (1- level))) + (setq level 0))) (if encl-decl (save-excursion (narrow-to-region @@ -1595,12 +1604,12 @@ defun." (push-mark)) (c-save-buffer-state - (beginning-of-defun-function end-of-defun-function + (beginning-of-defun-function + end-of-defun-function (start (point)) - (paren-state (copy-tree (c-parse-state))) ; This must not share list - ; structure with other users of c-state-cache. + (paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) - lim ; Position of { which has been widened to. + lim ; Position of { which has been widened to. where pos case-fold-search) (save-restriction @@ -1610,8 +1619,8 @@ defun." ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1719,10 +1728,10 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (push-mark)) (c-save-buffer-state - (beginning-of-defun-function end-of-defun-function + (beginning-of-defun-function + end-of-defun-function (start (point)) - (paren-state (copy-tree (c-parse-state))) ; This must not share list - ; structure with other users of c-state-cache. + (paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) lim where pos case-fold-search) @@ -1734,8 +1743,8 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1759,7 +1768,7 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." ;; Do we need to move forward from the brace to the semicolon? (when (eq arg 0) - (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc. + (if (c-in-function-trailer-p) ; after "}" of struct/enum, etc. (c-syntactic-re-search-forward ";")) (setq pos (point)) @@ -1793,8 +1802,8 @@ with a brace block." (save-excursion ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1875,114 +1884,133 @@ with a brace block." ;; This function might do hidden buffer changes. (save-excursion (save-restriction - (when (eq c-defun-tactic 'go-outward) - (c-narrow-to-most-enclosing-decl-block t) ; e.g. class, namespace - (or (save-restriction - (c-narrow-to-most-enclosing-decl-block nil) - - ;; Note: Some code duplication in `c-beginning-of-defun' and - ;; `c-end-of-defun'. - (catch 'exit (let ((start (point)) (paren-state (c-parse-state)) - lim pos end-pos) - (unless (c-safe - (goto-char (c-least-enclosing-brace paren-state)) - ;; If we moved to the outermost enclosing paren - ;; then we can use c-safe-position to set the - ;; limit. Can't do that otherwise since the - ;; earlier paren pair on paren-state might very - ;; well be part of the declaration we should go - ;; to. - (setq lim (c-safe-position (point) paren-state)) - t) - ;; At top level. Make sure we aren't inside a literal. - (setq pos (c-literal-limits - (c-safe-position (point) paren-state))) - (if pos (goto-char (car pos)))) - - (when (c-beginning-of-macro) - (throw 'exit - (cons (point) - (save-excursion - (c-end-of-macro) - (forward-line 1) - (point))))) + lim pos end-pos encl-decl-block where) + ;; Narrow enclosing brace blocks out, as required by the values of + ;; `c-defun-tactic', `near', and the position of point. + (when (eq c-defun-tactic 'go-outward) + (let ((bounds + (save-restriction + (if (and (not (save-excursion (c-beginning-of-macro))) + (save-restriction + (c-narrow-to-most-enclosing-decl-block) + (memq (c-where-wrt-brace-construct) + '(at-function-end outwith-function))) + (not near)) + (c-narrow-to-most-enclosing-decl-block nil 2) + (c-narrow-to-most-enclosing-decl-block)) + (cons (point-min) (point-max))))) + (narrow-to-region (car bounds) (cdr bounds)))) + (setq paren-state (c-parse-state)) + + (or + ;; Note: Some code duplication in `c-beginning-of-defun' and + ;; `c-end-of-defun'. + (catch 'exit + (unless (c-safe + (goto-char (c-least-enclosing-brace paren-state)) + ;; If we moved to the outermost enclosing paren + ;; then we can use c-safe-position to set the + ;; limit. Can't do that otherwise since the + ;; earlier paren pair on paren-state might very + ;; well be part of the declaration we should go + ;; to. + (setq lim (c-safe-position (point) paren-state)) + t) + ;; At top level. Make sure we aren't inside a literal. + (setq pos (c-literal-start + (c-safe-position (point) paren-state))) + (if pos (goto-char pos))) + + (when (c-beginning-of-macro) + (throw 'exit + (cons (point) + (save-excursion + (c-end-of-macro) + (forward-line 1) + (point))))) - (setq pos (point)) - (when (or (eq (car (c-beginning-of-decl-1 lim)) 'previous) - (= pos (point))) - ;; We moved back over the previous defun. Skip to the next - ;; one. Not using c-forward-syntactic-ws here since we - ;; should not skip a macro. We can also be directly after - ;; the block in a `c-opt-block-decls-with-vars-key' - ;; declaration, but then we won't move significantly far - ;; here. - (goto-char pos) - (c-forward-comments) - - (when (and near (c-beginning-of-macro)) - (throw 'exit - (cons (point) - (save-excursion - (c-end-of-macro) - (forward-line 1) - (point)))))) - - (if (eobp) (throw 'exit nil)) - - ;; Check if `c-beginning-of-decl-1' put us after the block in a - ;; declaration that doesn't end there. We're searching back and - ;; forth over the block here, which can be expensive. - (setq pos (point)) - (if (and c-opt-block-decls-with-vars-key - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?})) - (eq (car (c-beginning-of-decl-1)) - 'previous) - (save-excursion - (c-end-of-decl-1) - (and (> (point) pos) - (setq end-pos (point))))) - nil - (goto-char pos)) + (setq pos (point)) + (setq where (and (not (save-excursion (c-beginning-of-macro))) + (c-where-wrt-brace-construct))) + (when (and (not (eq where 'at-header)) + (or (and near + (memq where + '(at-function-end outwith-function))) + (eq (car (c-beginning-of-decl-1 lim)) 'previous) + (= pos (point)))) + ;; We moved back over the previous defun. Skip to the next + ;; one. Not using c-forward-syntactic-ws here since we + ;; should not skip a macro. We can also be directly after + ;; the block in a `c-opt-block-decls-with-vars-key' + ;; declaration, but then we won't move significantly far + ;; here. + (goto-char pos) + (c-forward-comments) + + (when (and near (c-beginning-of-macro)) + (throw 'exit + (cons (point) + (save-excursion + (c-end-of-macro) + (forward-line 1) + (point)))))) - (if (and (not near) (> (point) start)) - nil + (if (eobp) (throw 'exit nil)) - ;; Try to be line oriented; position the limits at the - ;; closest preceding boi, and after the next newline, that - ;; isn't inside a comment, but if we hit a neighboring - ;; declaration then we instead use the exact declaration - ;; limit in that direction. - (cons (progn - (setq pos (point)) - (while (and (/= (point) (c-point 'boi)) - (c-backward-single-comment))) - (if (/= (point) (c-point 'boi)) - pos - (point))) - (progn - (if end-pos - (goto-char end-pos) - (c-end-of-decl-1)) - (setq pos (point)) - (while (and (not (bolp)) - (not (looking-at "\\s *$")) - (c-forward-single-comment))) - (cond ((bolp) - (point)) - ((looking-at "\\s *$") - (forward-line 1) - (point)) - (t - pos)))))))) - (and (not near) - (goto-char (point-min)) - (c-forward-decl-or-cast-1 -1 nil nil) - (eq (char-after) ?\{) - (cons (point-min) (point-max)))))))) + ;; Check if `c-beginning-of-decl-1' put us after the block in a + ;; declaration that doesn't end there. We're searching back and + ;; forth over the block here, which can be expensive. + (setq pos (point)) + (if (and c-opt-block-decls-with-vars-key + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?})) + (eq (car (c-beginning-of-decl-1)) + 'previous) + (save-excursion + (c-end-of-decl-1) + (and (> (point) pos) + (setq end-pos (point))))) + nil + (goto-char pos)) + + (if (and (not near) (> (point) start)) + nil + + ;; Try to be line oriented; position the limits at the + ;; closest preceding boi, and after the next newline, that + ;; isn't inside a comment, but if we hit a neighboring + ;; declaration then we instead use the exact declaration + ;; limit in that direction. + (cons (progn + (setq pos (point)) + (while (and (/= (point) (c-point 'boi)) + (c-backward-single-comment))) + (if (/= (point) (c-point 'boi)) + pos + (point))) + (progn + (if end-pos + (goto-char end-pos) + (c-end-of-decl-1)) + (setq pos (point)) + (while (and (not (bolp)) + (not (looking-at "\\s *$")) + (c-forward-single-comment))) + (cond ((bolp) + (point)) + ((looking-at "\\s *$") + (forward-line 1) + (point)) + (t + pos)))))) + (and (not near) + (goto-char (point-min)) + (c-forward-decl-or-cast-1 -1 nil nil) + (eq (char-after) ?\{) + (cons (point-min) (point-max)))))))) (defun c-mark-function () "Put mark at end of the current top-level declaration or macro, point at beginning. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e110b0f6432..32b691f43bd 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -644,13 +644,14 @@ right side of it." `(c-safe (scan-lists ,from ,count ,depth))))) (if limit `(save-restriction - ,(if (numberp count) - (if (< count 0) - `(narrow-to-region ,limit (point-max)) - `(narrow-to-region (point-min) ,limit)) - `(if (< ,count 0) - (narrow-to-region ,limit (point-max)) - (narrow-to-region (point-min) ,limit))) + (when ,limit + ,(if (numberp count) + (if (< count 0) + `(narrow-to-region ,limit (point-max)) + `(narrow-to-region (point-min) ,limit)) + `(if (< ,count 0) + (narrow-to-region ,limit (point-max)) + (narrow-to-region (point-min) ,limit)))) ,res) res))) @@ -665,13 +666,8 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be before it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 0)) (point)))) - (if limit - `(save-restriction - (if ,limit - (narrow-to-region (point-min) ,limit)) - ,res) - res))) + `(let ((dest (c-safe-scan-lists ,(or pos `(point)) 1 0 ,limit))) + (when dest (goto-char dest) dest))) (defmacro c-go-list-backward (&optional pos limit) "Move backward across one balanced group of parentheses starting at POS or @@ -680,13 +676,8 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be after it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 0)) (point)))) - (if limit - `(save-restriction - (if ,limit - (narrow-to-region ,limit (point-max))) - ,res) - res))) + `(let ((dest (c-safe-scan-lists ,(or pos `(point)) -1 0 ,limit))) + (when dest (goto-char dest) dest))) (defmacro c-up-list-forward (&optional pos limit) "Return the first position after the list sexp containing POS, @@ -727,12 +718,8 @@ position exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be before it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t))) - (if limit - `(save-restriction - (narrow-to-region (point-min) ,limit) - ,res) - res))) + `(let ((dest (c-up-list-forward ,pos ,limit))) + (when dest (goto-char dest) t))) (defmacro c-go-up-list-backward (&optional pos limit) "Move the point to the position of the start of the list sexp containing POS, @@ -741,12 +728,8 @@ position exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be after it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t))) - (if limit - `(save-restriction - (narrow-to-region ,limit (point-max)) - ,res) - res))) + `(let ((dest (c-up-list-backward ,pos ,limit))) + (when dest (goto-char dest) t))) (defmacro c-go-down-list-forward (&optional pos limit) "Move the point to the first position inside the first list sexp after POS, @@ -755,12 +738,8 @@ exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be before it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t))) - (if limit - `(save-restriction - (narrow-to-region (point-min) ,limit) - ,res) - res))) + `(let ((dest (c-down-list-forward ,pos ,limit))) + (when dest (goto-char dest) t))) (defmacro c-go-down-list-backward (&optional pos limit) "Move the point to the last position inside the last list sexp before POS, @@ -769,13 +748,8 @@ exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be after it." - (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t))) - (if limit - `(save-restriction - (narrow-to-region ,limit (point-max)) - ,res) - res))) - + `(let ((dest (c-down-list-backward ,pos ,limit))) + (when dest (goto-char dest) t))) (defmacro c-beginning-of-defun-1 () ;; Wrapper around beginning-of-defun. @@ -1262,7 +1236,8 @@ been put there by c-put-char-property. POINT remains unchanged." (def-edebug-spec c-clear-char-property t) (def-edebug-spec c-clear-char-properties t) (def-edebug-spec c-put-overlay t) -(def-edebug-spec c-delete-overlay t) ;)) +(def-edebug-spec c-delete-overlay t) +(def-edebug-spec c-self-bind-state-cache t);)) ;;; Functions. @@ -1401,7 +1376,43 @@ been put there by c-put-char-property. POINT remains unchanged." (save-restriction (widen) (c-set-cpp-delimiters ,beg ,end))))) - + +(defmacro c-self-bind-state-cache (&rest forms) + ;; Bind the state cache to itself and execute the FORMS. Return the result + ;; of the last FORM executed. It is assumed that no buffer changes will + ;; happen in FORMS, and no hidden buffer changes which could affect the + ;; parsing will be made by FORMS. + `(let* ((c-state-cache (copy-tree c-state-cache)) + (c-state-cache-good-pos c-state-cache-good-pos) + ;(c-state-nonlit-pos-cache (copy-tree c-state-nonlit-pos-cache)) + ;(c-state-nonlit-pos-cache-limit c-state-nonlit-pos-cache-limit) + ;(c-state-semi-nonlit-pos-cache (copy-tree c-state-semi-nonlit-pos-cache)) + ;(c-state-semi-nonlit-pos-cache-limit c-state-semi-nonlit-pos-cache) + (c-state-brace-pair-desert (copy-tree c-state-brace-pair-desert)) + (c-state-point-min c-state-point-min) + (c-state-point-min-lit-type c-state-point-min-lit-type) + (c-state-point-min-lit-start c-state-point-min-lit-start) + (c-state-min-scan-pos c-state-min-scan-pos) + (c-state-old-cpp-beg-marker (if (markerp c-state-old-cpp-beg-marker) + (copy-marker c-state-old-cpp-beg-marker) + c-state-old-cpp-beg-marker)) + (c-state-old-cpp-beg (if (markerp c-state-old-cpp-beg) + c-state-old-cpp-beg-marker + c-state-old-cpp-beg)) + (c-state-old-cpp-end-marker (if (markerp c-state-old-cpp-end-marker) + (copy-marker c-state-old-cpp-end-marker) + c-state-old-cpp-end-marker)) + (c-state-old-cpp-end (if (markerp c-state-old-cpp-end) + c-state-old-cpp-end-marker + c-state-old-cpp-end)) + (c-parse-state-state c-parse-state-state)) + (prog1 + (progn ,@forms) + (if (markerp c-state-old-cpp-beg-marker) + (move-marker c-state-old-cpp-beg-marker nil)) + (if (markerp c-state-old-cpp-end-marker) + (move-marker c-state-old-cpp-end-marker nil))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The following macros are to be used only in `c-parse-state' and its ;; subroutines. Their main purpose is to simplify the handling of C++/Java diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 66b5369bbba..9a3cb020ff4 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -83,8 +83,9 @@ ;; ;; 'syntax-table ;; Used to modify the syntax of some characters. It is used to -;; mark the "<" and ">" of angle bracket parens with paren syntax, and -;; to "hide" obtrusive characters in preprocessor lines. +;; mark the "<" and ">" of angle bracket parens with paren syntax, to +;; "hide" obtrusive characters in preprocessor lines, and to mark C++ +;; raw strings to enable their fontification. ;; ;; This property is used on single characters and is therefore ;; always treated as front and rear nonsticky (or start and end open @@ -129,6 +130,10 @@ ;; 'c-decl-type-start is used when the declarators are types, ;; 'c-decl-id-start otherwise. ;; +;; 'c-not-decl +;; Put on the brace which introduces a brace list and on the commas +;; which separate the element within it. +;; ;; 'c-awk-NL-prop ;; Used in AWK mode to mark the various kinds of newlines. See ;; cc-awk.el. @@ -229,8 +234,12 @@ ;; The starting position from where we determined `c-macro-cache'. (defvar c-macro-cache-syntactic nil) (make-variable-buffer-local 'c-macro-cache-syntactic) -;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a -;; syntactic end of macro, not merely an apparent one. +;; Either nil, or the syntactic end of the macro currently represented by +;; `c-macro-cache'. +(defvar c-macro-cache-no-comment nil) +(make-variable-buffer-local 'c-macro-cache-no-comment) +;; Either nil, or the last character of the macro currently represented by +;; `c-macro-cache' which isn't in a comment. */ (defun c-invalidate-macro-cache (beg end) ;; Called from a before-change function. If the change region is before or @@ -242,12 +251,14 @@ ((< beg (car c-macro-cache)) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil)) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)) ((and (cdr c-macro-cache) (< beg (cdr c-macro-cache))) (setcdr c-macro-cache nil) (setq c-macro-cache-start-pos beg - c-macro-cache-syntactic nil)))) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)))) (defun c-macro-is-genuine-p () ;; Check that the ostensible CPP construct at point is a real one. In @@ -288,7 +299,8 @@ comment at the start of cc-engine.el for more info." t)) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil) (save-restriction (if lim (narrow-to-region lim (point-max))) @@ -297,7 +309,7 @@ comment at the start of cc-engine.el for more info." (forward-line -1)) (back-to-indentation) (if (and (<= (point) here) - (looking-at c-opt-cpp-start) + (save-match-data (looking-at c-opt-cpp-start)) (c-macro-is-genuine-p)) (progn (setq c-macro-cache (cons (point) nil) @@ -323,7 +335,8 @@ comment at the start of cc-engine.el for more info." (>= (point) (car c-macro-cache))) (setq c-macro-cache nil c-macro-cache-start-pos nil - c-macro-cache-syntactic nil)) + c-macro-cache-syntactic nil + c-macro-cache-no-comment nil)) (while (progn (end-of-line) (when (and (eq (char-before) ?\\) @@ -347,14 +360,38 @@ comment at the start of cc-engine.el for more info." (let* ((here (point)) (there (progn (c-end-of-macro) (point))) s) - (unless c-macro-cache-syntactic + (if c-macro-cache-syntactic + (goto-char c-macro-cache-syntactic) (setq s (parse-partial-sexp here there)) (while (and (or (nth 3 s) ; in a string (nth 4 s)) ; in a comment (maybe at end of line comment) (> there here)) ; No infinite loops, please. (setq there (1- (nth 8 s))) (setq s (parse-partial-sexp here there))) - (setq c-macro-cache-syntactic (car c-macro-cache))) + (setq c-macro-cache-syntactic (point))) + (point))) + +(defun c-no-comment-end-of-macro () + ;; Go to the end of a CPP directive, or a pos just before which isn't in a + ;; comment. For this purpose, open strings are ignored. + ;; + ;; This function must only be called from the beginning of a CPP construct. + ;; + ;; Note that this function might do hidden buffer changes. See the comment + ;; at the start of cc-engine.el for more info. + (let* ((here (point)) + (there (progn (c-end-of-macro) (point))) + s) + (if c-macro-cache-no-comment + (goto-char c-macro-cache-no-comment) + (setq s (parse-partial-sexp here there)) + (while (and (nth 3 s) ; in a string + (> there here)) ; No infinite loops, please. + (setq here (1+ (nth 8 s))) + (setq s (parse-partial-sexp here there))) + (when (nth 4 s) + (goto-char (1- (nth 8 s)))) + (setq c-macro-cache-no-comment (point))) (point))) (defun c-forward-over-cpp-define-id () @@ -385,6 +422,25 @@ comment at the start of cc-engine.el for more info." ;;; Basic utility functions. +(defun c-delq-from-dotted-list (elt dlist) + ;; If ELT is a member of the (possibly dotted) list DLIST, remove all + ;; occurrences of it (except for any in the last cdr of DLIST). + ;; + ;; Call this as (setq DLIST (c-delq-from-dotted-list ELT DLIST)), as + ;; sometimes the original structure is changed, sometimes it's not. + ;; + ;; This function is needed in Emacs < 24.5, and possibly XEmacs, because + ;; `delq' throws an error in these versions when given a dotted list. + (let ((tail dlist) prev) + (while (consp tail) + (if (eq (car tail) elt) + (if prev + (setcdr prev (cdr tail)) + (setq dlist (cdr dlist))) + (setq prev tail)) + (setq tail (cdr tail))) + dlist)) + (defun c-syntactic-content (from to paren-level) ;; Return the given region as a string where all syntactic ;; whitespace is removed or, where necessary, replaced with a single @@ -1248,7 +1304,7 @@ comment at the start of cc-engine.el for more info." c-stmt-delim-chars)) (non-skip-list (append (substring skip-chars 1) nil)) ; e.g. (?# ?\; ?{ ?} ?? ?:) - lit-range vsemi-pos) + lit-range lit-start vsemi-pos) (save-restriction (widen) (save-excursion @@ -1263,8 +1319,8 @@ comment at the start of cc-engine.el for more info." ((and (bolp) (save-excursion (progn - (if (setq lit-range (c-literal-limits from)) ; Have we landed in a string/comment? - (goto-char (car lit-range))) + (if (setq lit-start (c-literal-start from)) ; Have we landed in a string/comment? + (goto-char lit-start)) (c-backward-syntactic-ws) ; ? put a limit here, maybe? (setq vsemi-pos (point)) (c-at-vsemi-p)))) @@ -2227,22 +2283,128 @@ comment at the start of cc-engine.el for more info." (defvar c-state-semi-nonlit-pos-cache nil) (make-variable-buffer-local 'c-state-semi-nonlit-pos-cache) -;; A list of buffer positions which are known not to be in a literal. This is -;; ordered with higher positions at the front of the list. Only those which -;; are less than `c-state-semi-nonlit-pos-cache-limit' are valid. +;; A list of elements which are either buffer positions (when such positions +;; are not in literals) or lists of the form (POS TYPE START), where POS is +;; a buffer position inside a literal, TYPE is the type of the literal +;; ('string, 'c, or 'c++) and START is the start of the literal. (defvar c-state-semi-nonlit-pos-cache-limit 1) (make-variable-buffer-local 'c-state-semi-nonlit-pos-cache-limit) -;; An upper limit on valid entries in `c-state-semi-nonlit-pos-cache'. This is -;; reduced by buffer changes, and increased by invocations of -;; `c-state-literal-at'. FIXME!!! +;; An upper limit on valid entries in `c-state-semi-nonlit-pos-cache'. This +;; is reduced by buffer changes, and increased by invocations of +;; `c-parse-ps-state-below'. + +(defsubst c-truncate-semi-nonlit-pos-cache (pos) + ;; Truncate the upper bound of the cache `c-state-semi-nonlit-pos-cache' to + ;; POS, if it is higher than that position. + (setq c-state-semi-nonlit-pos-cache-limit + (min c-state-semi-nonlit-pos-cache-limit pos))) + +(defun c-state-semi-pp-to-literal (here &optional not-in-delimiter) + ;; Do a parse-partial-sexp from a position in the buffer before HERE which + ;; isn't in a literal, and return information about HERE, either: + ;; (STATE TYPE BEG) if HERE is in a literal; or + ;; (STATE) otherwise, + ;; where STATE is the parsing state at HERE, TYPE is the type of the literal + ;; enclosing HERE, (one of 'string, 'c, 'c++) and BEG is the starting + ;; position of that literal (including the delimiter). + ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; + ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), 7 + ;; (comment type), and 8 (start of comment/string), and possibly 10 (in + ;; newer Emacsen only, the syntax of a position after a potential first char + ;; of a two char construct) of STATE are valid. + (save-excursion + (save-restriction + (widen) + (save-match-data + (let* ((base-and-state (c-parse-ps-state-below here)) + (base (car base-and-state)) + (s (cdr base-and-state)) + (s (parse-partial-sexp base here nil nil s)) + ty) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((nth 7 s) 'c++) + (t 'c))) + (list s ty (nth 8 s))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++)) + (list s ty (point))) + + (t (list s)))))))) + +(defun c-state-full-pp-to-literal (here &optional not-in-delimiter) + ;; This function will supersede c-state-pp-to-literal. + ;; + ;; Do a parse-partial-sexp from a position in the buffer before HERE which + ;; isn't in a literal, and return information about HERE, either: + ;; (STATE TYPE (BEG . END)) if HERE is in a literal; or + ;; (STATE) otherwise, + ;; where STATE is the parsing state at HERE, TYPE is the type of the literal + ;; enclosing HERE, (one of 'string, 'c, 'c++) and (BEG . END) is the + ;; boundaries of that literal (including the delimiters). + ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; + ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), 7 + ;; (comment type), and 8 (start of comment/string), and possibly 10 (in + ;; newer Emacsen only, the syntax of a position after a potential first char + ;; of a two char construct) of STATE are valid. + (save-excursion + (save-restriction + (widen) + (save-match-data + (let* ((base-and-state (c-parse-ps-state-below here)) + (base (car base-and-state)) + (s (cdr base-and-state)) + (s (parse-partial-sexp base here nil nil s)) + ty start) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((nth 7 s) 'c++) + (t 'c))) + (setq start (nth 8 s)) + (parse-partial-sexp here (point-max) + nil ; TARGETDEPTH + nil ; STOPBEFORE + s ; OLDSTATE + 'syntax-table) ; stop at end of literal + (list s ty (cons start (point)))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) + start (point)) + (forward-comment 1) + (list s ty (cons start (point)))) + + (t (list s)))))))) (defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either ;; (STATE TYPE (BEG . END)) if TO is in a literal; or ;; (STATE) otherwise, ;; where STATE is the parsing state at TO, TYPE is the type of the literal - ;; (one of 'c, 'c++, 'string) and (BEG . END) is the boundaries of the literal. + ;; (one of 'c, 'c++, 'string) and (BEG . END) is the boundaries of the literal, + ;; including the delimiters. ;; ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character ;; comment opener, this is recognized as being in a comment literal. @@ -2251,32 +2413,130 @@ comment at the start of cc-engine.el for more info." ;; 7 (comment type) and 8 (start of comment/string) (and possibly 9) of ;; STATE are valid. (save-excursion - (let ((s (parse-partial-sexp from to)) - ty co-st) - (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment - (setq ty (cond - ((nth 3 s) 'string) - ((nth 7 s) 'c++) - (t 'c))) - (parse-partial-sexp (point) (point-max) - nil ; TARGETDEPTH - nil ; STOPBEFORE - s ; OLDSTATE - 'syntax-table) ; stop at end of literal - `(,s ,ty (,(nth 8 s) . ,(point)))) - - ((and (not not-in-delimiter) ; inside a comment starter - (not (bobp)) - (progn (backward-char) - (and (not (looking-at "\\s!")) - (looking-at c-comment-start-regexp)))) - (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) - co-st (point)) - (forward-comment 1) - `(,s ,ty (,co-st . ,(point)))) - - (t `(,s)))))) + (save-match-data + (let ((s (parse-partial-sexp from to)) + ty co-st) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((nth 7 s) 'c++) + (t 'c))) + (parse-partial-sexp (point) (point-max) + nil ; TARGETDEPTH + nil ; STOPBEFORE + s ; OLDSTATE + 'syntax-table) ; stop at end of literal + `(,s ,ty (,(nth 8 s) . ,(point)))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (looking-at "\\s!")) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) + co-st (point)) + (forward-comment 1) + `(,s ,ty (,co-st . ,(point)))) + + (t `(,s))))))) + +(defun c-cache-to-parse-ps-state (elt) + ;; Create a list suitable to use as the old-state parameter to + ;; `parse-partial-sexp', out of ELT. ELT is either just a number, a buffer + ;; position, or it is a list (POS TYPE STARTING-POS). Here POS is the + ;; buffer position the other elements are pertinent for, TYPE is either 'c + ;; or 'c++ (for a comment) or a character (for a string delimiter) or t + ;; (meaning a string fence opened the string), STARTING-POS is the starting + ;; position of the comment or string. + (if (consp elt) + (let ((depth 0) (containing nil) (last nil) + in-string in-comment (after-quote nil) + (min-depth 0) com-style com-str-start (intermediate nil) + (between-syntax nil) + (type (cadr elt))) + (setq com-str-start (car (cddr elt))) + (cond + ((or (numberp type) (eq type t)) ; A string + (setq in-string type)) + ((memq type '(c c++)) ; A comment + (setq in-comment t + com-style (if (eq type 'c++) 1 nil))) + (t (c-benign-error "Invalid type %s in c-cache-to-parse-ps-state" + elt))) + (list depth containing last + in-string in-comment after-quote + min-depth com-style com-str-start + intermediate nil)) + (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + +(defun c-parse-ps-state-to-cache (state) + ;; Convert STATE, a `parse-partial-sexp' state valid at POINT, to an element + ;; for the `c-state-semi-nonlit-pos-cache' cache. This is either POINT + ;; (when point is not in a literal) or a list (POINT TYPE STARTING-POS), + ;; where TYPE is the type of the literal, either 'string, 'c, or 'c++, and + ;; STARTING-POS is the starting position of the comment or string. + (cond + ((nth 3 state) ; A string + (list (point) (nth 3 state) (nth 8 state))) + ((nth 4 state) ; A comment + (list (point) + (if (eq (nth 7 state) 1) 'c++ 'c) + (nth 8 state))) + (t ; Neither string nor comment. + (point)))) + +(defsubst c-ps-state-cache-pos (elt) + ;; Get the buffer position from ELT, an element from the cache + ;; `c-state-semi-nonlit-pos-cache'. + (if (atom elt) + elt + (car elt))) + +(defun c-parse-ps-state-below (here) + ;; Given a buffer position HERE, Return a cons (CACHE-POS . STATE), where + ;; CACHE-POS is a position not very far before HERE for which the + ;; parse-partial-sexp STATE is valid. Note that the only valid elements of + ;; STATE are those concerning comments and strings; STATE is the state of a + ;; null `parse-partial-sexp' scan when CACHE-POS is not in a comment or + ;; string. + (save-excursion + (save-restriction + (widen) + (let ((c c-state-semi-nonlit-pos-cache) + elt state pos npos high-elt) + ;; Trim the cache to take account of buffer changes. + (while (and c (> (c-ps-state-cache-pos (car c)) + c-state-semi-nonlit-pos-cache-limit)) + (setq c (cdr c))) + (setq c-state-semi-nonlit-pos-cache c) + + (while (and c (> (c-ps-state-cache-pos (car c)) here)) + (setq high-elt (car c)) + (setq c (cdr c))) + (setq pos (or (and c (c-ps-state-cache-pos (car c))) + (point-min))) + + (if high-elt + (setq state (c-cache-to-parse-ps-state (car c))) + (setq elt (if c (car c) (point-min))) + (setq state + (if c + (c-cache-to-parse-ps-state (car c)) + (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + (while + ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. + (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) + (setq state (parse-partial-sexp pos npos nil nil state)) + (setq elt (c-parse-ps-state-to-cache state)) + (setq c-state-semi-nonlit-pos-cache + (cons elt c-state-semi-nonlit-pos-cache)) + (setq pos npos))) + + (if (> pos c-state-semi-nonlit-pos-cache-limit) + (setq c-state-semi-nonlit-pos-cache-limit pos)) + + (cons pos state))))) (defun c-state-safe-place (here) ;; Return a buffer position before HERE which is "safe", i.e. outside any @@ -2343,45 +2603,6 @@ comment at the start of cc-engine.el for more info." (setq c-state-nonlit-pos-cache-limit pos)) pos)))) -(defun c-state-semi-safe-place (here) - ;; Return a buffer position before HERE which is "safe", i.e. outside any - ;; string or comment. It may be in a macro. - (save-restriction - (widen) - (save-excursion - (let ((c c-state-semi-nonlit-pos-cache) - pos npos high-pos lit macro-beg macro-end) - ;; Trim the cache to take account of buffer changes. - (while (and c (> (car c) c-state-semi-nonlit-pos-cache-limit)) - (setq c (cdr c))) - (setq c-state-semi-nonlit-pos-cache c) - - (while (and c (> (car c) here)) - (setq high-pos (car c)) - (setq c (cdr c))) - (setq pos (or (car c) (point-min))) - - (unless high-pos - (while - ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. - (and - (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) - - ;; Test for being in a literal. If so, go to after it. - (progn - (setq lit (car (cddr (c-state-pp-to-literal pos npos)))) - (or (null lit) - (prog1 (<= (cdr lit) here) - (setq npos (cdr lit)))))) - - (setq pos npos) - (setq c-state-semi-nonlit-pos-cache - (cons pos c-state-semi-nonlit-pos-cache)))) - - (if (> pos c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit pos)) - pos)))) - (defun c-state-literal-at (here) ;; If position HERE is inside a literal, return (START . END), the ;; boundaries of the literal (which may be outside the accessible bit of the @@ -2699,7 +2920,11 @@ comment at the start of cc-engine.el for more info." (setq ptr (cdr ptr))) (when (consp ptr) - (if (eq (cdr ptr) c-state-cache) + (if (or (eq (cdr ptr) c-state-cache) + (and (consp (cadr ptr)) + (> (cdr (cadr ptr)) (point-min)))) ; Our new point-min is + ; inside a recorded + ; brace pair. (setq c-state-cache nil c-state-cache-good-pos c-state-min-scan-pos) (setcdr ptr nil) @@ -3278,8 +3503,7 @@ comment at the start of cc-engine.el for more info." ;; HERE. (if (<= here c-state-nonlit-pos-cache-limit) (setq c-state-nonlit-pos-cache-limit (1- here))) - (if (<= here c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit (1- here))) + (c-truncate-semi-nonlit-pos-cache here) ;; `c-state-cache': ;; Case 1: if `here' is in a literal containing point-min, everything @@ -3440,7 +3664,7 @@ comment at the start of cc-engine.el for more info." (< c-state-old-cpp-beg here)) (c-with-all-but-one-cpps-commented-out c-state-old-cpp-beg - (min c-state-old-cpp-end here) + c-state-old-cpp-end (c-invalidate-state-cache-1 here)) (c-with-cpps-commented-out (c-invalidate-state-cache-1 here)))) @@ -3501,6 +3725,9 @@ comment at the start of cc-engine.el for more info." (make-variable-buffer-local 'c-parse-state-state) (defun c-record-parse-state-state () (setq c-parse-state-point (point)) + (when (markerp (cdr (assq 'c-state-old-cpp-beg c-parse-state-state))) + (move-marker (cdr (assq 'c-state-old-cpp-beg c-parse-state-state)) nil) + (move-marker (cdr (assq 'c-state-old-cpp-end c-parse-state-state)) nil)) (setq c-parse-state-state (mapcar (lambda (arg) @@ -3524,7 +3751,7 @@ comment at the start of cc-engine.el for more info." c-state-old-cpp-end c-parse-state-point)))) (defun c-replay-parse-state-state () - (message + (message "%s" (concat "(setq " (mapconcat (lambda (arg) @@ -3547,7 +3774,7 @@ comment at the start of cc-engine.el for more info." conses-not-ok)) (defun c-debug-parse-state () - (let ((here (point)) (res1 (c-real-parse-state)) res2) + (let ((here (point)) (min-point (point-min)) (res1 (c-real-parse-state)) res2) (let ((c-state-cache nil) (c-state-cache-good-pos 1) (c-state-nonlit-pos-cache nil) @@ -3574,8 +3801,8 @@ comment at the start of cc-engine.el for more info." ;; "using cache: %s, from scratch: %s") ;; here res1 res2))) (message (concat "c-parse-state inconsistency at %s: " - "using cache: %s, from scratch: %s") - here res1 res2) + "using cache: %s, from scratch: %s. POINT-MIN: %s") + here res1 res2 min-point) (message "Old state:") (c-replay-parse-state-state)) @@ -4051,6 +4278,15 @@ or string literals are ignored. The start point is assumed to be outside any comment, macro or string literal, or else the content of that region is taken as syntactically significant text. +NOERROR, in addition to the values nil, t, and <anything else> +used in `re-search-forward' can also take the values +'before-literal and 'after-literal. In these cases, when BOUND +is also given and is inside a literal, and a search fails, point +will be left, respectively before or after the literal. Be aware +that with 'after-literal, if a string or comment is unclosed at +the end of the buffer, point may be left there, even though it is +inside a literal there. + If PAREN-LEVEL is non-nil, an additional restriction is added to ignore matches in nested paren sexps. The search will also not go outside the current list sexp, which has the effect that if the point @@ -4114,7 +4350,19 @@ comment at the start of cc-engine.el for more info." (and (progn (setq search-pos (point)) - (re-search-forward regexp bound noerror)) + (if (re-search-forward regexp bound noerror) + t + ;; Without the following, when PAREN-LEVEL is non-nil, and + ;; NOERROR is not nil or t, and the very first search above + ;; has just failed, point would end up at BOUND rather than + ;; just before the next close paren. + (when (and (eq search-pos start) + paren-level + (not (memq noerror '(nil t)))) + (setq state (parse-partial-sexp start bound -1)) + (if (eq (car state) -1) + (setq bound (1- (point))))) + nil)) (progn (setq state (parse-partial-sexp @@ -4262,9 +4510,19 @@ comment at the start of cc-engine.el for more info." (match-end 0)) ;; Search failed. Set point as appropriate. - (if (eq noerror t) - (goto-char start) + (cond + ((eq noerror t) + (goto-char start)) + ((not (memq noerror '(before-literal after-literal))) (goto-char bound)) + (t (setq state (parse-partial-sexp state-pos bound nil nil state)) + (if (or (elt state 3) (elt state 4)) + (if (eq noerror 'before-literal) + (goto-char (elt state 8)) + (parse-partial-sexp bound (point-max) nil nil + state 'syntax-table)) + (goto-char bound)))) + nil))) (defvar safe-pos-list) ; bound in c-syntactic-skip-backward @@ -4288,8 +4546,7 @@ comment at the start of cc-engine.el for more info." (setq safe-pos-list (cdr safe-pos-list))) (unless (setq safe-pos (car-safe safe-pos-list)) (setq safe-pos (max (or (c-safe-position - (point) (or c-state-cache - (c-parse-state))) + (point) (c-parse-state)) 0) (point-min)) safe-pos-list (list safe-pos))) @@ -4337,107 +4594,108 @@ Non-nil is returned if the point moved, nil otherwise. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." - (let ((start (point)) - state-2 - ;; A list of syntactically relevant positions in descending - ;; order. It's used to avoid scanning repeatedly over - ;; potentially large regions with `parse-partial-sexp' to verify - ;; each position. Used in `c-ssb-lit-begin' - safe-pos-list - ;; The result from `c-beginning-of-macro' at the start position or the - ;; start position itself if it isn't within a macro. Evaluated on - ;; demand. - start-macro-beg - ;; The earliest position after the current one with the same paren - ;; level. Used only when `paren-level' is set. - lit-beg - (paren-level-pos (point))) - - (while - (progn - ;; The next loop "tries" to find the end point each time round, - ;; loops when it hasn't succeeded. - (while - (and - (let ((pos (point))) - (while (and - (< (skip-chars-backward skip-chars limit) 0) - ;; Don't stop inside a literal. - (when (setq lit-beg (c-ssb-lit-begin)) - (goto-char lit-beg) - t))) - (< (point) pos)) + (c-self-bind-state-cache + (let ((start (point)) + state-2 + ;; A list of syntactically relevant positions in descending + ;; order. It's used to avoid scanning repeatedly over + ;; potentially large regions with `parse-partial-sexp' to verify + ;; each position. Used in `c-ssb-lit-begin' + safe-pos-list + ;; The result from `c-beginning-of-macro' at the start position or the + ;; start position itself if it isn't within a macro. Evaluated on + ;; demand. + start-macro-beg + ;; The earliest position after the current one with the same paren + ;; level. Used only when `paren-level' is set. + lit-beg + (paren-level-pos (point))) + + (while + (progn + ;; The next loop "tries" to find the end point each time round, + ;; loops when it hasn't succeeded. + (while + (and + (let ((pos (point))) + (while (and + (< (skip-chars-backward skip-chars limit) 0) + ;; Don't stop inside a literal. + (when (setq lit-beg (c-ssb-lit-begin)) + (goto-char lit-beg) + t))) + (< (point) pos)) + + (let ((pos (point)) state-2 pps-end-pos) - (let ((pos (point)) state-2 pps-end-pos) + (cond + ((and paren-level + (save-excursion + (setq state-2 (parse-partial-sexp + pos paren-level-pos -1) + pps-end-pos (point)) + (/= (car state-2) 0))) + ;; Not at the right level. + + (if (and (< (car state-2) 0) + ;; We stop above if we go out of a paren. + ;; Now check whether it precedes or is + ;; nested in the starting sexp. + (save-excursion + (setq state-2 + (parse-partial-sexp + pps-end-pos paren-level-pos + nil nil state-2)) + (< (car state-2) 0))) + + ;; We've stopped short of the starting position + ;; so the hit was inside a nested list. Go up + ;; until we are at the right level. + (condition-case nil + (progn + (goto-char (scan-lists pos -1 + (- (car state-2)))) + (setq paren-level-pos (point)) + (if (and limit (>= limit paren-level-pos)) + (progn + (goto-char limit) + nil) + t)) + (error + (goto-char (or limit (point-min))) + nil)) + + ;; The hit was outside the list at the start + ;; position. Go to the start of the list and exit. + (goto-char (1+ (elt state-2 1))) + nil)) + + ((c-beginning-of-macro limit) + ;; Inside a macro. + (if (< (point) + (or start-macro-beg + (setq start-macro-beg + (save-excursion + (goto-char start) + (c-beginning-of-macro limit) + (point))))) + t + + ;; It's inside the same macro we started in so it's + ;; a relevant match. + (goto-char pos) + nil)))))) - (cond - ((and paren-level - (save-excursion - (setq state-2 (parse-partial-sexp - pos paren-level-pos -1) - pps-end-pos (point)) - (/= (car state-2) 0))) - ;; Not at the right level. - - (if (and (< (car state-2) 0) - ;; We stop above if we go out of a paren. - ;; Now check whether it precedes or is - ;; nested in the starting sexp. - (save-excursion - (setq state-2 - (parse-partial-sexp - pps-end-pos paren-level-pos - nil nil state-2)) - (< (car state-2) 0))) - - ;; We've stopped short of the starting position - ;; so the hit was inside a nested list. Go up - ;; until we are at the right level. - (condition-case nil - (progn - (goto-char (scan-lists pos -1 - (- (car state-2)))) - (setq paren-level-pos (point)) - (if (and limit (>= limit paren-level-pos)) - (progn - (goto-char limit) - nil) - t)) - (error - (goto-char (or limit (point-min))) - nil)) - - ;; The hit was outside the list at the start - ;; position. Go to the start of the list and exit. - (goto-char (1+ (elt state-2 1))) - nil)) - - ((c-beginning-of-macro limit) - ;; Inside a macro. - (if (< (point) - (or start-macro-beg - (setq start-macro-beg - (save-excursion - (goto-char start) - (c-beginning-of-macro limit) - (point))))) - t - - ;; It's inside the same macro we started in so it's - ;; a relevant match. - (goto-char pos) - nil)))))) - - (> (point) - (progn - ;; Skip syntactic ws afterwards so that we don't stop at the - ;; end of a comment if `skip-chars' is something like "^/". - (c-backward-syntactic-ws) - (point))))) + (> (point) + (progn + ;; Skip syntactic ws afterwards so that we don't stop at the + ;; end of a comment if `skip-chars' is something like "^/". + (c-backward-syntactic-ws) + (point))))) - ;; We might want to extend this with more useful return values in - ;; the future. - (/= (point) start))) + ;; We might want to extend this with more useful return values in + ;; the future. + (/= (point) start)))) ;; The following is an alternative implementation of ;; `c-syntactic-skip-backward' that uses backward movement to keep @@ -4572,8 +4830,7 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-restriction (widen) - (let* ((safe-place (c-state-semi-safe-place (point))) - (lit (c-state-pp-to-literal safe-place (point)))) + (let ((lit (c-state-semi-pp-to-literal (point)))) (or (cadr lit) (and detect-cpp (save-excursion (c-beginning-of-macro)) @@ -4595,14 +4852,20 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion - (let* ((pos (point)) - (lim (or lim (c-state-semi-safe-place pos))) - (pp-to-lit (save-restriction - (widen) - (c-state-pp-to-literal lim pos not-in-delimiter))) - (state (car pp-to-lit)) - (lit-limits (car (cddr pp-to-lit)))) - + (let* + ((pos (point)) + (lit-limits + (if lim + (let ((s (parse-partial-sexp lim (point)))) + (when (or (nth 3 s) (nth 4 s)) + (cons (nth 8 s) + (progn (parse-partial-sexp (point) (point-max) + nil nil + s + 'syntax-table) + (point))))) + (let ((pp-to-lit (c-state-full-pp-to-literal pos not-in-delimiter))) + (car (cddr pp-to-lit)))))) (cond (lit-limits) @@ -4641,6 +4904,16 @@ comment at the start of cc-engine.el for more info." (if beg (cons beg end)))))) )))) +(defun c-literal-start (&optional safe-pos) + "Return the start of the string or comment surrounding point, or nil if +point isn't in one. SAFE-POS, if non-nil, is a position before point which is +a known \"safe position\", i.e. outside of any string or comment." + (if safe-pos + (let ((s (parse-partial-sexp safe-pos (point)))) + (and (or (nth 3 s) (nth 4 s)) + (nth 8 s))) + (car (cddr (c-state-semi-pp-to-literal (point)))))) + ;; In case external callers use this; it did have a docstring. (defalias 'c-literal-limits-fast 'c-literal-limits) @@ -4705,13 +4978,10 @@ comment at the start of cc-engine.el for more info." (defsubst c-determine-limit-get-base (start try-size) ;; Get a "safe place" approximately TRY-SIZE characters before START. - ;; This doesn't preserve point. + ;; This defsubst doesn't preserve point. (let* ((pos (max (- start try-size) (point-min))) - (base (c-state-semi-safe-place pos)) - (s (parse-partial-sexp base pos))) - (if (or (nth 4 s) (nth 3 s)) ; comment or string - (nth 8 s) - (point)))) + (s (c-state-semi-pp-to-literal pos))) + (or (car (cddr s)) pos))) (defun c-determine-limit (how-far-back &optional start try-size) ;; Return a buffer position HOW-FAR-BACK non-literal characters from START @@ -4858,6 +5128,211 @@ comment at the start of cc-engine.el for more info." (c-debug-remove-face ,beg ,end 'c-debug-decl-spot-face) (c-debug-remove-face ,beg ,end 'c-debug-decl-sws-face)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Machinery for determining when we're at top level (this including being +;; directly inside a class or namespace, etc.) +;; +;; We maintain a stack of brace depths in structures like classes and +;; namespaces. The car of this structure, when non-nil, indicates that the +;; associated position is within a template (etc.) structure, and the value is +;; the position where the (outermost) template ends. The other elements in +;; the structure are stacked elements, one each for each enclosing "top level" +;; structure. +;; +;; At the very outermost level, the value of the stack would be (nil 1), the +;; "1" indicating an enclosure in a notional all-enclosing block. After +;; passing a keyword such as "namespace", the value would become (nil 0 1). +;; At this point, passing a semicolon would cause the 0 to be dropped from the +;; stack (at any other time, a semicolon is ignored). Alternatively, on +;; passing an opening brace, the stack would become (nil 1 1). Each opening +;; brace passed causes the cadr to be incremented, and passing closing braces +;; causes it to be decremented until it reaches 1. On passing a closing brace +;; when the cadr of the stack is at 1, this causes it to be removed from the +;; stack, the corresponding namespace (etc.) structure having been closed. +;; +;; There is a special stack value -1 which means the C++ colon operator +;; introducing a list of inherited classes has just been parsed. The value +;; persists on the stack until the next open brace or semicolon. +;; +;; When the car of the stack is non-nil, i.e. when we're in a template (etc.) +;; structure, braces are not counted. The counting resumes only after passing +;; the template's closing position, which is recorded in the car of the stack. +;; +;; The test for being at top level consists of the cadr being 0 or 1. +;; +;; The values of this stack throughout a buffer are cached in a simple linear +;; cache, every 5000 characters. +;; +;; Note to maintainers: This cache mechanism is MUCH faster than recalculating +;; the stack at every entry to `c-find-decl-spots' using `c-at-toplevel-p' or +;; the like. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The approximate interval at which we cache the value of the brace stack. +(defconst c-bs-interval 5000) +;; The list of cached values of the brace stack. Each value in the list is a +;; cons of the position it is valid for and the value of the stack as +;; described above. +(defvar c-bs-cache nil) +(make-variable-buffer-local 'c-bs-cache) +;; The position of the buffer at and below which entries in `c-bs-cache' are +;; valid. +(defvar c-bs-cache-limit 1) +(make-variable-buffer-local 'c-bs-cache-limit) +;; The previous buffer position for which the brace stack value was +;; determined. +(defvar c-bs-prev-pos most-positive-fixnum) +(make-variable-buffer-local 'c-bs-prev-pos) +;; The value of the brace stack at `c-bs-prev-pos'. +(defvar c-bs-prev-stack nil) +(make-variable-buffer-local 'c-bs-prev-stack) + +(defun c-init-bs-cache () + ;; Initialize the cache in `c-bs-cache' and related variables. + (setq c-bs-cache nil + c-bs-cache-limit 1 + c-bs-prev-pos most-positive-fixnum + c-bs-prev-stack nil)) + +(defun c-truncate-bs-cache (pos &rest _ignore) + ;; Truncate the upper bound of the cache `c-bs-cache' to POS, if it is + ;; higher than that position. This is called as either a before- or + ;; after-change-function. + (setq c-bs-cache-limit + (min c-bs-cache-limit pos))) + +(defun c-update-brace-stack (stack from to) + ;; Give a brace-stack which has the value STACK at position FROM, update it + ;; to it's value at position TO, where TO is after (or equal to) FROM. + ;; Return a cons of either TO (if it is outside a literal) and this new + ;; value, or of the next position after TO outside a literal and the new + ;; value. + (let (match kwd-sym (prev-match-pos 1) + (s (cdr stack)) + (bound-<> (car stack)) + ) + (save-excursion + (cond + ((and bound-<> (<= to bound-<>)) + (goto-char to)) ; Nothing to do. + (bound-<> + (goto-char bound-<>) + (setq bound-<> nil)) + (t (goto-char from))) + (while (and (< (point) to) + (c-syntactic-re-search-forward + (if (<= (car s) 0) + c-brace-stack-thing-key + c-brace-stack-no-semi-key) + to 'after-literal) + (> (point) prev-match-pos)) ; prevent infinite loop. + (setq prev-match-pos (point)) + (setq match (match-string-no-properties 1) + kwd-sym (c-keyword-sym match)) + (cond + ((and (equal match "{") + (progn (backward-char) + (prog1 (looking-at "\\s(") + (forward-char)))) + (setq s (if s + (cons (if (<= (car s) 0) + 1 + (1+ (car s))) + (cdr s)) + (list 1)))) + ((and (equal match "}") + (progn (backward-char) + (prog1 (looking-at "\\s)") + (forward-char)))) + (setq s + (cond + ((and s (> (car s) 1)) + (cons (1- (car s)) (cdr s))) + ((and (cdr s) (eq (car s) 1)) + (cdr s)) + (t s)))) + ((and (equal match "<") + (progn (backward-char) + (prog1 (looking-at "\\s(") + (forward-char)))) + (backward-char) + (if (c-forward-<>-arglist nil) ; Should always work. + (when (> (point) to) + (setq bound-<> (point))) + (forward-char))) + ((and (equal match ":") + s + (eq (car s) 0)) + (setq s (cons -1 (cdr s)))) + ((and (equal match ",") + (eq (car s) -1))) ; at "," in "class foo : bar, ..." + ((member match '(";" "," ")")) + (when (and s (cdr s) (<= (car s) 0)) + (setq s (cdr s)))) + ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds) + (push 0 s)))) + (cons (point) + (cons bound-<> s))))) + +(defun c-brace-stack-at (here) + ;; Given a buffer position HERE, Return the value of the brace stack there. + (save-excursion + (save-restriction + (widen) + (let ((c c-bs-cache) + (can-use-prev (<= c-bs-prev-pos c-bs-cache-limit)) + elt stack pos npos high-elt) + ;; Trim the cache to take account of buffer changes. + (while (and c + (> (caar c) c-bs-cache-limit)) + (setq c (cdr c))) + (setq c-bs-cache c) + + (while (and c + (> (caar c) here)) + (setq high-elt (car c)) + (setq c (cdr c))) + (setq pos (or (and c (caar c)) + (point-min))) + + (setq elt (if c + (car c) + (cons (point-min) + (cons nil (list 1))))) + (when (not high-elt) + (setq stack (cdr elt)) + (while + ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. + (<= (setq npos (+ pos c-bs-interval)) here) + (setq elt (c-update-brace-stack stack pos npos)) + (setq npos (car elt)) + (setq stack (cdr elt)) + (unless (eq npos (point-max)) ; NPOS could be in a literal at EOB. + (setq c-bs-cache (cons elt c-bs-cache))) + (setq pos npos))) + + (if (> pos c-bs-cache-limit) + (setq c-bs-cache-limit pos)) + + ;; Can we just use the previous value? + (if (and can-use-prev + (<= c-bs-prev-pos here) + (> c-bs-prev-pos (car elt))) + (setq pos c-bs-prev-pos + stack c-bs-prev-stack) + (setq pos (car elt) + stack (cdr elt))) + (if (> here c-bs-cache-limit) + (setq c-bs-cache-limit here)) + (setq elt (c-update-brace-stack stack pos here) + c-bs-prev-pos (car elt) + c-bs-prev-stack (cdr elt)))))) + +(defun c-bs-at-toplevel-p (here) + ;; Is position HERE at the top level, as indicated by the brace stack? + (let ((stack (c-brace-stack-at here))) + (or (null stack) ; Probably unnecessary. + (<= (cadr stack) 1)))) + (defmacro c-find-decl-prefix-search () ;; Macro used inside `c-find-decl-spots'. It ought to be a defun, ;; but it contains lots of free variables that refer to things @@ -4921,6 +5396,14 @@ comment at the start of cc-engine.el for more info." (and (< (point) cfd-limit) (c-got-face-at (point) c-literal-faces)))) t) ; Continue the loop over pseudo matches. + ((and c-opt-identifier-concat-key + (match-string 1) + (save-excursion + (goto-char (match-beginning 1)) + (save-match-data + (looking-at c-opt-identifier-concat-key)))) + ;; Found, e.g., "::" in C++ + t) ((and (match-string 1) (string= (match-string 1) ":") (save-excursion @@ -4943,6 +5426,7 @@ comment at the start of cc-engine.el for more info." cfd-re-match nil) (setq cfd-match-pos cfd-prop-match cfd-prop-match nil)) + (setq cfd-top-level (c-bs-at-toplevel-p cfd-match-pos)) (goto-char cfd-match-pos) @@ -5041,7 +5525,11 @@ comment at the start of cc-engine.el for more info." ;; comments. (cfd-token-pos 0) ;; The end position of the last entered macro. - (cfd-macro-end 0)) + (cfd-macro-end 0) + ;; Whether the last position returned from `c-find-decl-prefix-search' + ;; is at the top-level (including directly in a class or namespace, + ;; etc.). + cfd-top-level) ;; Initialize by finding a syntactically relevant start position ;; before the point, and do the first `c-decl-prefix-or-start-re' @@ -5091,8 +5579,9 @@ comment at the start of cc-engine.el for more info." ;; arrived at something that looks like a start or else ;; resort to `c-literal-limits'. (unless (looking-at c-literal-start-regexp) - (let ((range (c-literal-limits))) - (if range (goto-char (car range))))) + (let ((lit-start (c-literal-start))) + (if lit-start (goto-char lit-start))) + ) (setq start-in-literal (point))) ; end of `and' arm. @@ -5348,7 +5837,7 @@ comment at the start of cc-engine.el for more info." nil)))) ; end of when condition (c-debug-put-decl-spot-faces cfd-match-pos (point)) - (if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0)) + (if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0) cfd-top-level) (setq cfd-prop-match nil)) (when (/= cfd-macro-end 0) @@ -5603,6 +6092,9 @@ comment at the start of cc-engine.el for more info." ;; Set by c-common-init in cc-mode.el. (defvar c-new-BEG) (defvar c-new-END) +;; Set by c-after-change in cc-mode.el. +(defvar c-old-BEG) +(defvar c-old-END) (defun c-before-change-check-<>-operators (beg end) ;; Unmark certain pairs of "< .... >" which are currently marked as @@ -5626,12 +6118,12 @@ comment at the start of cc-engine.el for more info." ;; 2010-01-29. (save-excursion (c-save-buffer-state - ((beg-lit-limits (progn (goto-char beg) (c-literal-limits))) + ((beg-lit-start (progn (goto-char beg) (c-literal-start))) (end-lit-limits (progn (goto-char end) (c-literal-limits))) new-beg new-end beg-limit end-limit) ;; Locate the earliest < after the barrier before the changed region, ;; which isn't already marked as a paren. - (goto-char (if beg-lit-limits (car beg-lit-limits) beg)) + (goto-char (or beg-lit-start beg)) (setq beg-limit (c-determine-limit 512)) ;; Remove the syntax-table/category properties from each pertinent <...> @@ -5723,6 +6215,350 @@ comment at the start of cc-engine.el for more info." 'c-decl-arg-start))))))) (or (c-forward-<>-arglist nil) (forward-char))))) + + +;; Functions to handle C++ raw strings. +;; +;; A valid C++ raw string looks like +;; R"<id>(<contents>)<id>" +;; , where <id> is an identifier from 0 to 16 characters long, not containing +;; spaces, control characters, double quote or left/right paren. <contents> +;; can include anything which isn't the terminating )<id>", including new +;; lines, "s, parentheses, etc. +;; +;; CC Mode handles C++ raw strings by the use of `syntax-table' text +;; properties as follows: +;; +;; (i) On a validly terminated raw string, no `syntax-table' text properties +;; are applied to the opening and closing delimiters, but any " in the +;; contents is given the property value "punctuation" (`(1)') to prevent it +;; interacting with the "s in the delimiters. +;; +;; The font locking routine `c-font-lock-c++-raw-strings' (in cc-fonts.el) +;; recognizes valid raw strings, and fontifies the delimiters (apart from +;; the parentheses) with the default face and the parentheses and the +;; <contents> with font-lock-string-face. +;; +;; (ii) A valid, but unterminated, raw string opening delimiter gets the +;; "punctuation" value (`(1)') of the `syntax-table' text property, and the +;; open parenthesis gets the "string fence" value (`(15)'). +;; +;; `c-font-lock-c++-raw-strings' puts c-font-lock-warning-face on the entire +;; unmatched opening delimiter (from the R up to the open paren), and allows +;; the rest of the buffer to get font-lock-string-face, caused by the +;; unmatched "string fence" `syntax-table' text property value. +;; +;; (iii) Inside a macro, a valid raw string is handled as in (i). An +;; unmatched opening delimiter is handled slightly differently. In addition +;; to the "punctuation" and "string fence" properties on the delimiter, +;; another "string fence" `syntax-table' property is applied to the last +;; possible character of the macro before the terminating linefeed (if there +;; is such a character after the "("). This "last possible" character is +;; never a backslash escaping the end of line. If the character preceding +;; this "last possible" character is itself a backslash, this preceding +;; character gets a "punctuation" `syntax-table' value. If the "(" is +;; already at the end of the macro, it gets the "punctuation" value, and no +;; "string fence"s are used. +;; +;; The effect on the fontification of either of these tactics is that rest of +;; the macro (if any) after the "(" gets font-lock-string-face, but the rest +;; of the file is fontified normally. + + +(defun c-raw-string-pos () + ;; Get POINT's relationship to any containing raw string. + ;; If point isn't in a raw string, return nil. + ;; Otherwise, return the following list: + ;; + ;; (POS B\" B\( E\) E\") + ;; + ;; , where POS is the symbol `open-delim' if point is in the opening + ;; delimiter, the symbol `close-delim' if it's in the closing delimiter, and + ;; nil if it's in the string body. B\", B\(, E\), E\" are the positions of + ;; the opening and closing quotes and parentheses of a correctly terminated + ;; raw string. (N.B.: E\) and E\" are NOT on the "outside" of these + ;; characters.) If the raw string is not terminated, E\) and E\" are set to + ;; nil. + ;; + ;; Note: this routine is dependant upon the correct syntax-table text + ;; properties being set. + (let ((state (c-state-semi-pp-to-literal (point))) + open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) + (save-excursion + (when + (and + (cond + ((null (cadr state)) + (or (eq (char-after) ?\") + (search-backward "\"" (max (- (point) 17) (point-min)) t))) + ((and (eq (cadr state) 'string) + (goto-char (nth 2 state)) + (or (eq (char-after) ?\") + (search-backward "\"" (max (- (point) 17) (point-min)) t)) + (not (bobp))))) + (eq (char-before) ?R) + (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) + (setq open-quote-pos (point) + open-paren-pos (match-end 1) + id (match-string-no-properties 1)) + (goto-char (1+ open-paren-pos)) + (when (and (not (c-get-char-property open-paren-pos 'syntax-table)) + (search-forward (concat ")" id "\"") nil t)) + (setq close-paren-pos (match-beginning 0) + close-quote-pos (1- (point)))))) + (and open-quote-pos + (list + (cond + ((<= (point) open-paren-pos) + 'open-delim) + ((and close-paren-pos + (> (point) close-paren-pos)) + 'close-delim) + (t nil)) + open-quote-pos open-paren-pos close-paren-pos close-quote-pos)))) + +(defun c-depropertize-raw-string (id open-quote open-paren bound) + ;; Point is immediately after a raw string opening delimiter. Remove any + ;; `syntax-table' text properties associated with the delimiter (if it's + ;; unmatched) or the raw string. + ;; + ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN + ;; are the buffer positions of the delimiter's components. BOUND is the + ;; bound for searching for a matching closing delimiter; it is usually nil, + ;; but if we're inside a macro, it's the end of the macro. + ;; + ;; Point is moved to after the (terminated) raw string, or left after the + ;; unmatched opening delimiter, as the case may be. The return value is of + ;; no significance. + (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table))) + (cond + ((null open-paren-prop) + ;; A terminated raw string + (when (search-forward (concat ")" id "\"") nil t) + (let* ((closing-paren (match-beginning 0)) + (first-punctuation + (save-match-data + (goto-char (1+ open-paren)) + (and (c-search-forward-char-property 'syntax-table '(1) + closing-paren) + (1- (point))))) + ) + (when first-punctuation + (c-clear-char-property-with-value + first-punctuation (match-beginning 0) 'syntax-table '(1)) + (c-truncate-semi-nonlit-pos-cache first-punctuation) + )))) + ((or (and (equal open-paren-prop '(15)) (null bound)) + (equal open-paren-prop '(1))) + ;; An unterminated raw string either not in a macro, or in a macro with + ;; the open parenthesis right up against the end of macro + (c-clear-char-property open-quote 'syntax-table) + (c-truncate-semi-nonlit-pos-cache open-quote) + (c-clear-char-property open-paren 'syntax-table)) + (t + ;; An unterminated string in a macro, with at least one char after the + ;; open paren + (c-clear-char-property open-quote 'syntax-table) + (c-truncate-semi-nonlit-pos-cache open-quote) + (c-clear-char-property open-paren 'syntax-table) + (let ((after-string-fence-pos + (save-excursion + (goto-char (1+ open-paren)) + (c-search-forward-char-property 'syntax-table '(15) bound)))) + (when after-string-fence-pos + (c-clear-char-property (1- after-string-fence-pos) 'syntax-table))) + )))) + +(defun c-depropertize-raw-strings-in-region (start finish) + ;; Remove any `syntax-table' text properties associated with C++ raw strings + ;; contained in the region (START FINISH). Point is undefined at entry and + ;; exit, and the return value has no significance. + (goto-char start) + (while (and (< (point) finish) + (re-search-forward + (concat "\\(" ; 1 + c-anchored-cpp-prefix ; 2 + "\\)\\|\\(" ; 3 + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" ; 4 + "\\)") + finish t)) + (when (save-excursion + (goto-char (match-beginning 0)) (not (c-in-literal))) + (if (match-beginning 4) ; the id + ;; We've found a raw string + (c-depropertize-raw-string + (match-string-no-properties 4) ; id + (1+ (match-beginning 3)) ; open quote + (match-end 4) ; open paren + nil) ; bound + ;; We've found a CPP construct. Search for raw strings within it. + (goto-char (match-beginning 2)) ; the "#" + (c-end-of-macro) + (let ((eom (point))) + (goto-char (match-end 2)) ; after the "#". + (while (and (< (point) eom) + (c-syntactic-re-search-forward + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" eom t)) + (c-depropertize-raw-string + (match-string-no-properties 1) ; id + (1+ (match-beginning 0)) ; open quote + (match-end 1) ; open paren + eom))))))) ; bound. + +(defun c-before-change-check-raw-strings (beg end) + ;; This function clears `syntax-table' text properties from C++ raw strings + ;; in the region (c-new-BEG c-new-END). BEG and END are the standard + ;; arguments supplied to any before-change function. + ;; + ;; Point is undefined on both entry and exit, and the return value has no + ;; significance. + ;; + ;; This function is called as a before-change function solely due to its + ;; membership of the C++ value of `c-get-state-before-change-functions'. + (c-save-buffer-state + ((beg-rs (progn (goto-char beg) (c-raw-string-pos))) + (beg-plus (if (null beg-rs) + beg + (max beg + (1+ (or (nth 4 beg-rs) (nth 2 beg-rs)))))) + (end-rs (progn (goto-char end) (c-raw-string-pos))) ; FIXME!!! + ; Optimize this so that we don't call + ; `c-raw-string-pos' twice when once + ; will do. (2016-06-02). + (end-minus (if (null end-rs) + end + (min end (cadr end-rs)))) + ) + (when beg-rs + (setq c-new-BEG (min c-new-BEG (1- (cadr beg-rs))))) + (c-depropertize-raw-strings-in-region c-new-BEG beg-plus) + + (when end-rs + (setq c-new-END (max c-new-END + (1+ (or (nth 4 end-rs) + (nth 2 end-rs)))))) + (c-depropertize-raw-strings-in-region end-minus c-new-END))) + +(defun c-propertize-raw-string-opener (id open-quote open-paren bound) + ;; Point is immediately after a raw string opening delimiter. Apply any + ;; pertinent `syntax-table' text properties to the delimiter and also the + ;; raw string, should there be a valid matching closing delimiter. + ;; + ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN + ;; are the buffer positions of the delimiter's components. BOUND is the + ;; bound for searching for a matching closing delimiter; it is usually nil, + ;; but if we're inside a macro, it's the end of the macro. + ;; + ;; Point is moved to after the (terminated) raw string, or left after the + ;; unmatched opening delimiter, as the case may be. The return value is of + ;; no significance. + (if (search-forward (concat ")" id "\"") bound t) + (let ((end-string (match-beginning 0)) + (after-quote (match-end 0))) + (goto-char open-paren) + (while (progn (skip-syntax-forward "^\"" end-string) + (< (point) end-string)) + (c-put-char-property (point) 'syntax-table '(1)) ; punctuation + (c-truncate-semi-nonlit-pos-cache (point)) + (forward-char)) + (goto-char after-quote)) + (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation + (c-truncate-semi-nonlit-pos-cache open-quote) + (c-put-char-property open-paren 'syntax-table '(15)) ; generic string + (when bound + ;; In a CPP construct, we try to apply a generic-string `syntax-table' + ;; text property to the last possible character in the string, so that + ;; only characters within the macro get "stringed out". + (goto-char bound) + (if (save-restriction + (narrow-to-region (1+ open-paren) (point-max)) + (re-search-backward + (eval-when-compile + ;; This regular expression matches either an escape pair (which + ;; isn't an escaped NL) (submatch 5) or a non-escaped character + ;; (which isn't itself a backslash) (submatch 10). The long + ;; preambles to these (respectively submatches 2-4 and 6-9) + ;; ensure that we have the correct parity for sequences of + ;; backslashes, etc.. + (concat "\\(" ; 1 + "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4 + "\\(\\\\.\\)" ; 5 + "\\|" + "\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9 + "\\([^\\]\\)" ; 10 + "\\)" + "\\(\\\\\n\\)*\\=")) ; 11 + (1+ open-paren) t)) + (if (match-beginning 10) + (progn + (c-put-char-property (match-beginning 10) 'syntax-table '(15)) + (c-truncate-semi-nonlit-pos-cache (match-beginning 10))) + (c-put-char-property (match-beginning 5) 'syntax-table '(1)) + (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15)) + (c-truncate-semi-nonlit-pos-cache (1+ (match-beginning 5)))) + (c-put-char-property open-paren 'syntax-table '(1))) + (goto-char bound)))) + +(defun c-after-change-re-mark-raw-strings (beg end old-len) + ;; This function applies `syntax-table' text properties to C++ raw strings + ;; beginning in the region (c-new-BEG c-new-END). BEG, END, and OLD-LEN are + ;; the standard arguments supplied to any after-change function. + ;; + ;; Point is undefined on both entry and exit, and the return value has no + ;; significance. + ;; + ;; This function is called as an after-change function solely due to its + ;; membership of the C++ value of `c-before-font-lock-functions'. + (c-save-buffer-state () + ;; If the region (c-new-BEG c-new-END) has expanded, remove + ;; `syntax-table' text-properties from the new piece(s). + (when (< c-new-BEG c-old-BEG) + (let ((beg-rs (progn (goto-char c-old-BEG) (c-raw-string-pos)))) + (c-depropertize-raw-strings-in-region + c-new-BEG + (if beg-rs + (1+ (or (nth 4 beg-rs) (nth 2 beg-rs))) + c-old-BEG)))) + (when (> c-new-END c-old-END) + (let ((end-rs (progn (goto-char c-old-END) (c-raw-string-pos)))) + (c-depropertize-raw-strings-in-region + (if end-rs + (cadr end-rs) + c-old-END) + c-new-END))) + + (goto-char c-new-BEG) + (while (and (< (point) c-new-END) + (re-search-forward + (concat "\\(" ; 1 + c-anchored-cpp-prefix ; 2 + "\\)\\|\\(" ; 3 + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" ; 4 + "\\)") + c-new-END t)) + (when (save-excursion + (goto-char (match-beginning 0)) (not (c-in-literal))) + (if (match-beginning 4) ; the id + ;; We've found a raw string. + (c-propertize-raw-string-opener + (match-string-no-properties 4) ; id + (1+ (match-beginning 3)) ; open quote + (match-end 4) ; open paren + nil) ; bound + ;; We've found a CPP construct. Search for raw strings within it. + (goto-char (match-beginning 2)) ; the "#" + (c-end-of-macro) + (let ((eom (point))) + (goto-char (match-end 2)) ; after the "#". + (while (and (< (point) eom) + (c-syntactic-re-search-forward + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" eom t)) + (c-propertize-raw-string-opener + (match-string-no-properties 1) ; id + (1+ (match-beginning 0)) ; open quote + (match-end 1) ; open paren + eom)))))))) ; bound + ;; Handling of small scale constructs like types and names. @@ -5832,18 +6668,21 @@ comment at the start of cc-engine.el for more info." ;; ;; This macro might do hidden buffer changes. `(let (res) + (setq c-last-identifier-range nil) (while (if (setq res ,(if (eq type 'type) `(c-forward-type) `(c-forward-name))) nil (cond ((looking-at c-keywords-regexp) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause))))) - (when (memq res '(t known found prefix)) - ,(when (eq type 'ref) - `(when c-record-type-identifiers - (c-record-ref-id c-last-identifier-range))) + (when (memq res '(t known found prefix maybe)) + (when c-record-type-identifiers + ,(if (eq type 'type) + `(c-record-type-id c-last-identifier-range) + `(c-record-ref-id c-last-identifier-range))) t))) (defmacro c-forward-id-comma-list (type update-safe-pos) @@ -6021,7 +6860,6 @@ comment at the start of cc-engine.el for more info." ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. (nconc c-record-found-types c-record-type-identifiers))) - (if (c-major-mode-is 'java-mode) (c-fontify-recorded-types-and-refs)) t) (goto-char start) @@ -6067,28 +6905,31 @@ comment at the start of cc-engine.el for more info." (progn (c-forward-syntactic-ws) (when (or (and c-record-type-identifiers all-types) - (c-major-mode-is 'java-mode)) - ;; All encountered identifiers are types, so set the - ;; promote flag and parse the type. - (progn - (c-forward-syntactic-ws) - (if (looking-at "\\?") - (forward-char) - (when (looking-at c-identifier-start) + (not (equal c-inside-<>-type-key "\\(\\<\\>\\)"))) + (c-forward-syntactic-ws) + (cond + ((eq (char-after) ??) + (forward-char)) + ((and (looking-at c-identifier-start) + (not (looking-at c-keywords-regexp))) + (if (or (and all-types c-record-type-identifiers) + (c-major-mode-is 'java-mode)) + ;; All encountered identifiers are types, so set the + ;; promote flag and parse the type. (let ((c-promote-possible-types t) (c-record-found-types t)) - (c-forward-type)))) + (c-forward-type)) + (c-forward-token-2)))) - (c-forward-syntactic-ws) + (c-forward-syntactic-ws) - (when (or (looking-at "extends") - (looking-at "super")) - (forward-word) - (c-forward-syntactic-ws) - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-type) - (c-forward-syntactic-ws))))) + (when (looking-at c-inside-<>-type-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type)) + (c-forward-syntactic-ws))) (setq pos (point)) ; e.g. first token inside the '<' @@ -6409,14 +7250,14 @@ comment at the start of cc-engine.el for more info." ((and c-recognize-<>-arglists (eq (char-after) ?<)) ;; Maybe an angle bracket arglist. - (when (let ((c-record-type-identifiers t) - (c-record-found-types t)) + (when (let (c-last-identifier-range) (c-forward-<>-arglist nil)) - (c-add-type start (1+ pos)) (c-forward-syntactic-ws) - (setq pos (point) - c-last-identifier-range nil) + (unless (eq (char-after) ?\() + (setq c-last-identifier-range nil) + (c-add-type start (1+ pos))) + (setq pos (point)) (if (and c-opt-identifier-concat-key (looking-at c-opt-identifier-concat-key)) @@ -6430,7 +7271,8 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) t) - (when (and c-record-type-identifiers id-start) + (when (and c-record-type-identifiers id-start + (not (eq (char-after) ?\())) (c-record-type-id (cons id-start id-end))) (setq res 'template) nil))) @@ -6506,7 +7348,11 @@ comment at the start of cc-engine.el for more info." (while (cond ((looking-at c-decl-hangon-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((looking-at c-pack-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) (setq pos (point)) @@ -6611,9 +7457,18 @@ comment at the start of cc-engine.el for more info." ;; It's an identifier that might be a type. 'maybe)))) ((eq name-res 'template) - ;; A template is a type. + ;; A template is sometimes a type. (goto-char id-end) - (setq res t)) + (c-forward-syntactic-ws) + (setq res + (if (eq (char-after) ?\() + (if (c-check-type id-start id-end) + ;; It's an identifier that has been used as + ;; a type somewhere else. + 'found + ;; It's an identifier that might be a type. + 'maybe) + t))) (t ;; Otherwise it's an operator identifier, which is not a type. (goto-char start) @@ -6637,6 +7492,12 @@ comment at the start of cc-engine.el for more info." (goto-char (match-end 1)) (c-forward-syntactic-ws))) + ;; Skip any "WS" identifiers (e.g. "final" or "override" in C++) + (while (looking-at c-type-decl-suffix-ws-ids-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (setq res t)) + (when c-opt-type-concat-key ; Only/mainly for pike. ;; Look for a trailing operator that concatenates the type ;; with a following one, and if so step past that one through @@ -6726,6 +7587,31 @@ comment at the start of cc-engine.el for more info." (prog1 (car ,ps) (setq ,ps (cdr ,ps))))) +(defun c-back-over-compound-identifier () + ;; Point is putatively just after a "compound identifier", i.e. something + ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of + ;; this construct and return t. If the parsing fails, return nil, leaving + ;; point unchanged. + (let ((here (point)) + end) + (if (not (c-on-identifier)) + nil + (c-simple-skip-symbol-backward) + (while + (progn + (setq end (point)) + (c-backward-syntactic-ws) + (c-backward-token-2) + (and + c-opt-identifier-concat-key + (looking-at c-opt-identifier-concat-key) + (progn + (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward)))) + (setq end (point))) + (goto-char end) + t))) + (defun c-back-over-member-initializer-braces () ;; Point is just after a closing brace/parenthesis. Try to parse this as a ;; C++ member initializer list, going back to just after the introducing ":" @@ -6736,7 +7622,7 @@ comment at the start of cc-engine.el for more info." (when (not (c-go-list-backward)) (throw 'done nil)) (c-backward-syntactic-ws) - (when (not (c-simple-skip-symbol-backward)) + (when (not (c-back-over-compound-identifier)) (throw 'done nil)) (c-backward-syntactic-ws) @@ -6748,7 +7634,7 @@ comment at the start of cc-engine.el for more info." (when (not (c-go-list-backward)) (throw 'done nil)) (c-backward-syntactic-ws) - (when (not (c-simple-skip-symbol-backward)) + (when (not (c-back-over-compound-identifier)) (throw 'done nil)) (c-backward-syntactic-ws)) @@ -6759,7 +7645,8 @@ comment at the start of cc-engine.el for more info." (defmacro c-back-over-list-of-member-inits () ;; Go back over a list of elements, each looking like: ;; <symbol> (<expression>) , - ;; or <symbol> {<expression>} , + ;; or <symbol> {<expression>} , (with possibly a <....> expressions + ;; following the <symbol>). ;; when we are putatively immediately after a comma. Stop when we don't see ;; a comma. If either of <symbol> or bracketed <expression> is missing, ;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil @@ -6772,7 +7659,11 @@ comment at the start of cc-engine.el for more info." (when (not (c-go-list-backward)) (throw 'done nil)) (c-backward-syntactic-ws) - (when (not (c-simple-skip-symbol-backward)) + (while (eq (char-before) ?>) + (when (not (c-backward-<>-arglist nil)) + (throw 'done nil)) + (c-backward-syntactic-ws)) + (when (not (c-back-over-compound-identifier)) (throw 'level nil)) (c-backward-syntactic-ws))) @@ -6794,10 +7685,13 @@ comment at the start of cc-engine.el for more info." (when (not (c-go-list-backward)) (throw 'done nil)) (c-backward-syntactic-ws)) - (when (c-simple-skip-symbol-backward) + (when (c-back-over-compound-identifier) (c-backward-syntactic-ws)) (c-back-over-list-of-member-inits) (and (eq (char-before) ?:) + (save-excursion + (c-backward-token-2) + (not (looking-at c-:$-multichar-token-regexp))) (c-just-after-func-arglist-p)))) (while (and (not (and level-plausible @@ -6807,11 +7701,14 @@ comment at the start of cc-engine.el for more info." (catch 'level (goto-char pos) (c-backward-syntactic-ws) - (when (not (c-simple-skip-symbol-backward)) + (when (not (c-back-over-compound-identifier)) (throw 'level nil)) (c-backward-syntactic-ws) (c-back-over-list-of-member-inits) (and (eq (char-before) ?:) + (save-excursion + (c-backward-token-2) + (not (looking-at c-:$-multichar-token-regexp))) (c-just-after-func-arglist-p))))) (and at-top-level level-plausible))) @@ -6865,10 +7762,12 @@ comment at the start of cc-engine.el for more info." ;; Assuming point is at the start of a declarator, move forward over it, ;; leaving point at the next token after it (e.g. a ) or a ; or a ,). ;; - ;; Return a list (ID-START ID-END BRACKETS-AFTER-ID GOT-INIT), where ID-START and - ;; ID-END are the bounds of the declarator's identifier, and - ;; BRACKETS-AFTER-ID is non-nil if a [...] pair is present after the id. - ;; GOT-INIT is non-nil when the declarator is followed by "=" or "(". + ;; Return a list (ID-START ID-END BRACKETS-AFTER-ID GOT-INIT DECORATED), + ;; where ID-START and ID-END are the bounds of the declarator's identifier, + ;; and BRACKETS-AFTER-ID is non-nil if a [...] pair is present after the id. + ;; GOT-INIT is non-nil when the declarator is followed by "=" or "(", + ;; DECORATED is non-nil when the identifier is embellished by an operator, + ;; like "*x", or "(*x)". ;; ;; If ACCEPT-ANON is non-nil, move forward over any "anonymous declarator", ;; i.e. something like the (*) in int (*), such as might be found in a @@ -6887,7 +7786,7 @@ comment at the start of cc-engine.el for more info." ;; array/struct initialization) or "=" or terminating delimiter ;; (e.g. "," or ";" or "}"). (let ((here (point)) - id-start id-end brackets-after-id paren-depth) + id-start id-end brackets-after-id paren-depth decorated) (or limit (setq limit (point-max))) (if (and (< (point) limit) @@ -6905,7 +7804,8 @@ comment at the start of cc-engine.el for more info." (cond ((looking-at c-decl-hangon-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)) ((and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) @@ -6926,6 +7826,8 @@ comment at the start of cc-engine.el for more info." (setq got-identifier t) nil)) t)) + (if (looking-at c-type-decl-operator-prefix-key) + (setq decorated t)) (if (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) @@ -6960,7 +7862,8 @@ comment at the start of cc-engine.el for more info." (while (cond ((looking-at c-decl-hangon-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) (<= (point) limit)) @@ -6979,7 +7882,7 @@ comment at the start of cc-engine.el for more info." (setq brackets-after-id t)) (backward-char) found)) - (list id-start id-end brackets-after-id (match-beginning 1)) + (list id-start id-end brackets-after-id (match-beginning 1) decorated) (goto-char here) nil))) @@ -6993,9 +7896,9 @@ comment at the start of cc-engine.el for more info." ;; If a declaration is parsed: ;; ;; The point is left at the first token after the first complete - ;; declarator, if there is one. The return value is a cons where - ;; the car is the position of the first token in the declarator. (See - ;; below for the cdr.) + ;; declarator, if there is one. The return value is a list of 4 elements, + ;; where the first is the position of the first token in the declarator. + ;; (See below for the other three.) ;; Some examples: ;; ;; void foo (int a, char *b) stuff ... @@ -7026,7 +7929,7 @@ comment at the start of cc-engine.el for more info." ;; ;; ;; - ;; The cdr of the return value is non-nil when a + ;; The second element of the return value is non-nil when a ;; `c-typedef-decl-kwds' specifier is found in the declaration. ;; Specifically it is a dotted pair (A . B) where B is t when a ;; `c-typedef-kwds' ("typedef") is present, and A is t when some @@ -7034,6 +7937,10 @@ comment at the start of cc-engine.el for more info." ;; specifier is present. I.e., (some of) the declared ;; identifier(s) are types. ;; + ;; The third element of the return value is non-nil when the declaration + ;; parsed might be an expression. The fourth element is the position of + ;; the start of the type identifier. + ;; ;; If a cast is parsed: ;; ;; The point is left at the first token after the closing paren of @@ -7051,8 +7958,13 @@ comment at the start of cc-engine.el for more info." ;; inside a function declaration arglist). ;; '<> In an angle bracket arglist. ;; 'arglist Some other type of arglist. + ;; 'top Some other context and point is at the top-level (either + ;; outside any braces or directly inside a class or namespace, + ;; etc.) ;; nil Some other context or unknown context. Includes ;; within the parens of an if, for, ... construct. + ;; 'not-decl This value is never supplied to this function. It + ;; would mean we're definitely not in a declaration. ;; ;; LAST-CAST-END is the first token after the closing paren of a ;; preceding cast, or nil if none is known. If @@ -7126,12 +8038,27 @@ comment at the start of cc-engine.el for more info." cast-end ;; Have we got a new-style C++11 "auto"? new-style-auto + ;; Set when the symbol before `preceding-token-end' is known to + ;; terminate the previous construct, or when we're at point-min. + at-decl-start ;; Save `c-record-type-identifiers' and ;; `c-record-ref-identifiers' since ranges are recorded ;; speculatively and should be thrown away if it turns out ;; that it isn't a declaration or cast. (save-rec-type-ids c-record-type-identifiers) - (save-rec-ref-ids c-record-ref-identifiers)) + (save-rec-ref-ids c-record-ref-identifiers) + ;; Set when we parse a declaration which might also be an expression, + ;; such as "a *b". See CASE 16 and CASE 17. + maybe-expression) + + (save-excursion + (goto-char preceding-token-end) + (setq at-decl-start + (or (bobp) + (let ((tok-end (point))) + (c-backward-token-2) + (member (buffer-substring-no-properties (point) tok-end) + c-pre-start-tokens))))) (while (c-forward-annotation) (c-forward-syntactic-ws)) @@ -7155,7 +8082,8 @@ comment at the start of cc-engine.el for more info." (save-excursion (c-forward-keyword-clause 1) (setq kwd-clause-end (point)))) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (setq noise-start (point)) (c-forward-noise-clause) (setq kwd-clause-end (point)))) @@ -7261,7 +8189,8 @@ comment at the start of cc-engine.el for more info." (while (cond ((looking-at c-decl-hangon-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) (setq id-start (point))) @@ -7343,7 +8272,10 @@ comment at the start of cc-engine.el for more info." ;; arglist paren that gets entered. c-parse-and-markup-<>-arglists ;; Start of the identifier for which `got-identifier' was set. - name-start) + name-start + ;; Position after (innermost) open parenthesis encountered in the + ;; prefix operators. + after-paren-pos) (goto-char id-start) @@ -7354,7 +8286,8 @@ comment at the start of cc-engine.el for more info." (when (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) - (forward-char))) + (forward-char) + (setq after-paren-pos (point)))) (while (and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) (match-beginning 3)) @@ -7377,7 +8310,8 @@ comment at the start of cc-engine.el for more info." (if (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) - (forward-char)) + (forward-char) + (setq after-paren-pos (point))) (unless got-prefix-before-parens (setq got-prefix-before-parens (= paren-depth 0))) (setq got-prefix t) @@ -7386,55 +8320,69 @@ comment at the start of cc-engine.el for more info." (setq got-parens (> paren-depth 0)) - ;; Skip over an identifier. + ;; Try to skip over an identifier. (or got-identifier (and (looking-at c-identifier-start) (setq pos (point)) (setq got-identifier (c-forward-name)) (setq name-start pos))) - ;; Skip over type decl suffix operators. - (while (if (looking-at c-type-decl-suffix-key) + ;; Skip over type decl suffix operators and trailing noise macros. + (while + (cond + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)) + + ((looking-at c-type-decl-suffix-key) + (if (eq (char-after) ?\)) + (when (> paren-depth 0) + (setq paren-depth (1- paren-depth)) + (forward-char) + t) + (when (if (save-match-data (looking-at "\\s(")) + (c-safe (c-forward-sexp 1) t) + (goto-char (match-end 1)) + t) + (when (and (not got-suffix-after-parens) + (= paren-depth 0)) + (setq got-suffix-after-parens (match-beginning 0))) + (setq got-suffix t)))) - (if (eq (char-after) ?\)) - (when (> paren-depth 0) - (setq paren-depth (1- paren-depth)) - (forward-char) - t) - (when (if (save-match-data (looking-at "\\s(")) - (c-safe (c-forward-sexp 1) t) - (goto-char (match-end 1)) - t) - (when (and (not got-suffix-after-parens) - (= paren-depth 0)) - (setq got-suffix-after-parens (match-beginning 0))) - (setq got-suffix t))) - - ;; No suffix matched. We might have matched the - ;; identifier as a type and the open paren of a - ;; function arglist as a type decl prefix. In that - ;; case we should "backtrack": Reinterpret the last - ;; type as the identifier, move out of the arglist and - ;; continue searching for suffix operators. - ;; - ;; Do this even if there's no preceding type, to cope - ;; with old style function declarations in K&R C, - ;; (con|de)structors in C++ and `c-typeless-decl-kwds' - ;; style declarations. That isn't applicable in an - ;; arglist context, though. - (when (and (= paren-depth 1) + (t + ;; No suffix matched. We might have matched the + ;; identifier as a type and the open paren of a + ;; function arglist as a type decl prefix. In that + ;; case we should "backtrack": Reinterpret the last + ;; type as the identifier, move out of the arglist and + ;; continue searching for suffix operators. + ;; + ;; Do this even if there's no preceding type, to cope + ;; with old style function declarations in K&R C, + ;; (con|de)structors in C++ and `c-typeless-decl-kwds' + ;; style declarations. That isn't applicable in an + ;; arglist context, though. + (when (and (= paren-depth 1) (not got-prefix-before-parens) (not (eq at-type t)) (or backup-at-type maybe-typeless backup-maybe-typeless (when c-recognize-typeless-decls - (not context))) + (and (memq context '(nil top)) + ;; Deal with C++11's "copy-initialization" + ;; where we have <type>(<constant>), by + ;; contrasting with a typeless + ;; <name>(<type><parameter>, ...). + (save-excursion + (goto-char after-paren-pos) + (c-forward-syntactic-ws) + (c-forward-type))))) (setq pos (c-up-list-forward (point))) (eq (char-before pos) ?\))) (c-fdoc-shift-type-backward) (goto-char pos) - t)) + t))) (c-forward-syntactic-ws)) @@ -7458,6 +8406,11 @@ comment at the start of cc-engine.el for more info." (setq type-start (point)) (setq at-type (c-forward-type)))) + ;; Move forward over any "WS" ids (like "final" or "override" in C++) + (while (looking-at c-type-decl-suffix-ws-ids-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) + (setq at-decl-or-cast (catch 'at-decl-or-cast @@ -7467,15 +8420,19 @@ comment at the start of cc-engine.el for more info." ;; Encountered something inside parens that isn't matched by ;; the `c-type-decl-*' regexps, so it's not a type decl ;; expression. Try to skip out to the same paren depth to - ;; not confuse the cast check below. - (c-safe (goto-char (scan-lists (point) 1 paren-depth))) + ;; not confuse the cast check below. If we don't manage this and + ;; `at-decl-or-cast' is 'ids we might have an expression like + ;; "foo bar ({ ..." which is a valid C++11 initialization. + (if (and (not (c-safe (goto-char (scan-lists (point) 1 paren-depth)))) + (eq at-decl-or-cast 'ids)) + (c-fdoc-shift-type-backward)) ;; If we've found a specifier keyword then it's a ;; declaration regardless. - (throw 'at-decl-or-cast (eq at-decl-or-cast t))) + (throw 'at-decl-or-cast (memq at-decl-or-cast '(t ids)))) (setq at-decl-end (looking-at (cond ((eq context '<>) "[,>]") - (context "[,)]") + ((not (memq context '(nil top))) "[,\)]") (t "[,;]")))) ;; Now we've collected info about various characteristics of @@ -7500,16 +8457,32 @@ comment at the start of cc-engine.el for more info." maybe-typeless backup-maybe-typeless (eq at-decl-or-cast t) + ;; Check whether we have "bar (gnu);" where we + ;; are directly inside a class (etc.) called "bar". (save-excursion - (goto-char name-start) - (not (memq (c-forward-type) '(nil maybe)))))) + (and + (progn + (goto-char name-start) + (not (memq (c-forward-type) '(nil maybe)))) + (progn + (goto-char id-start) + (c-directly-in-class-called-p + (buffer-substring + type-start + (progn + (goto-char type-start) + (c-forward-type) + (c-backward-syntactic-ws) + (point))))))))) ;; Got a declaration of the form "foo bar (gnu);" or "bar ;; (gnu);" where we've recognized "bar" as the type and "gnu" - ;; as the declarator. In this case it's however more likely - ;; that "bar" is the declarator and "gnu" a function argument - ;; or initializer (if `c-recognize-paren-inits' is set), - ;; since the parens around "gnu" would be superfluous if it's - ;; a declarator. Shift the type one step backward. + ;; as the declarator, and in the latter case, checked that + ;; "bar (gnu)" appears directly inside the class "bar". In + ;; this case it's however more likely that "bar" is the + ;; declarator and "gnu" a function argument or initializer + ;; (if `c-recognize-paren-inits' is set), since the parens + ;; around "gnu" would be superfluous if it's a declarator. + ;; Shift the type one step backward. (c-fdoc-shift-type-backward))) ;; Found no identifier. @@ -7588,7 +8561,7 @@ comment at the start of cc-engine.el for more info." (if (and got-parens (not got-prefix) - (not context) + (memq context '(nil top)) (not (eq at-type t)) (or backup-at-type maybe-typeless @@ -7638,6 +8611,18 @@ comment at the start of cc-engine.el for more info." ;; instantiation expression). (throw 'at-decl-or-cast nil)))) + ;; CASE 9.5 + (when (and (not context) ; i.e. not at top level. + (c-major-mode-is 'c++-mode) + (eq at-decl-or-cast 'ids) + after-paren-pos) + ;; We've got something like "foo bar (...)" in C++ which isn't at + ;; the top level. This is probably a uniform initialization of bar + ;; to the contents of the parens. In this case the declarator ends + ;; at the open paren. + (goto-char (1- after-paren-pos)) + (throw 'at-decl-or-cast t)) + ;; CASE 10 (when at-decl-or-cast ;; By now we've located the type in the declaration that we know @@ -7646,8 +8631,10 @@ comment at the start of cc-engine.el for more info." ;; CASE 11 (when (and got-identifier - (not context) (looking-at c-after-suffixed-type-decl-key) + (or (eq context 'top) + (and (eq context nil) + (match-beginning 1))) (if (and got-parens (not got-prefix) (not got-suffix) @@ -7742,13 +8729,17 @@ comment at the start of cc-engine.el for more info." (when (and got-prefix-before-parens at-type (or at-decl-end (looking-at "=[^=]")) - (not context) - (not got-suffix)) - ;; Got something like "foo * bar;". Since we're not inside an - ;; arglist it would be a meaningless expression because the - ;; result isn't used. We therefore choose to recognize it as - ;; a declaration. Do not allow a suffix since it could then - ;; be a function call. + (memq context '(nil top)) + (or (not got-suffix) + at-decl-start)) + ;; Got something like "foo * bar;". Since we're not inside + ;; an arglist it would be a meaningless expression because + ;; the result isn't used. We therefore choose to recognize + ;; it as a declaration. We only allow a suffix (which makes + ;; the construct look like a function call) when + ;; `at-decl-start' provides additional evidence that we do + ;; have a declaration. + (setq maybe-expression t) (throw 'at-decl-or-cast t)) ;; CASE 17 @@ -7760,10 +8751,11 @@ comment at the start of cc-engine.el for more info." ;; be an odd expression or it could be a declaration. Treat ;; it as a declaration if "a" has been used as a type ;; somewhere else (if it's a known type we won't get here). + (setq maybe-expression t) (throw 'at-decl-or-cast t))) ;; CASE 18 - (when (and context + (when (and (not (memq context '(nil top))) (or got-prefix (and (eq context 'decl) (not c-recognize-paren-inits) @@ -7883,9 +8875,11 @@ comment at the start of cc-engine.el for more info." (goto-char type-start) (c-forward-type)))) - (cons id-start + (list id-start (and (or at-type-decl at-typedef) - (cons at-type-decl at-typedef)))) + (cons at-type-decl at-typedef)) + maybe-expression + type-start)) (t ;; False alarm. Restore the recorded ranges. @@ -8318,7 +9312,7 @@ comment at the start of cc-engine.el for more info." (c-forward-objc-directive))) (setq id-start - (car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) nil nil))) + (car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))) (< id-start beg) ;; There should not be a '=' or ',' between beg and the @@ -8644,7 +9638,8 @@ comment at the start of cc-engine.el for more info." (/= last-stmt-start (point)) (progn (c-backward-syntactic-ws lim) - (not (memq (char-before) '(?\; ?} ?: nil)))) + (not (or (memq (char-before) '(?\; ?} ?: nil)) + (c-at-vsemi-p)))) (save-excursion (backward-char) (not (looking-at "\\s("))) @@ -8819,6 +9814,22 @@ comment at the start of cc-engine.el for more info." (c-syntactic-skip-backward c-block-prefix-charset limit t) (eq (char-before) ?>)))))) + ;; Skip back over noise clauses. + (while (and + c-opt-cpp-prefix + (eq (char-before) ?\)) + (let ((after-paren (point))) + (if (and (c-go-list-backward) + (progn (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward)) + (or (looking-at c-paren-nontype-key) + (looking-at c-noise-macro-with-parens-name-re))) + (progn + (c-syntactic-skip-backward c-block-prefix-charset limit t) + t) + (goto-char after-paren) + nil)))) + ;; Note: Can't get bogus hits inside template arglists below since they ;; have gotten paren syntax above. (when (and @@ -8925,6 +9936,26 @@ comment at the start of cc-engine.el for more info." kwd-start))) +(defun c-directly-in-class-called-p (name) + ;; Check whether point is directly inside a brace block which is the brace + ;; block of a class, struct, or union which is called NAME, a string. + (let* ((paren-state (c-parse-state)) + (brace-pos (c-pull-open-brace paren-state)) + ) + (when (eq (char-after brace-pos) ?{) + (goto-char brace-pos) + (save-excursion + ; *c-looking-at-decl-block + ; containing-sexp goto-start &optional + ; limit) + (when (and (c-looking-at-decl-block + (c-pull-open-brace paren-state) + nil) + (looking-at c-class-key)) + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (looking-at name)))))) + (defun c-search-uplist-for-classkey (paren-state) ;; Check if the closest containing paren sexp is a declaration ;; block, returning a 2 element vector in that case. Aref 0 @@ -8975,11 +10006,11 @@ comment at the start of cc-engine.el for more info." (not (looking-at "="))))) b-pos))) -(defun c-backward-colon-prefixed-type () - ;; We're at the token after what might be a type prefixed with a colon. Try - ;; moving backward over this type and the colon. On success, return t and - ;; leave point before colon; on failure, leave point unchanged. Will clobber - ;; match data. +(defun c-backward-typed-enum-colon () + ;; We're at a "{" which might be the opening brace of a enum which is + ;; strongly typed (by a ":" followed by a type). If this is the case, leave + ;; point before the colon and return t. Otherwise leave point unchanged and return nil. + ;; Match data will be clobbered. (let ((here (point)) (colon-pos nil)) (save-excursion @@ -8988,7 +10019,13 @@ comment at the start of cc-engine.el for more info." (or (not (looking-at "\\s)")) (c-go-up-list-backward)) (cond - ((eql (char-after) ?:) + ((and (eql (char-after) ?:) + (save-excursion + (c-backward-syntactic-ws) + (or (c-on-identifier) + (progn + (c-backward-token-2) + (looking-at c-brace-list-key))))) (setq colon-pos (point)) (forward-char) (c-forward-syntactic-ws) @@ -9012,7 +10049,7 @@ comment at the start of cc-engine.el for more info." (let ((here (point)) up-sexp-pos before-identifier) (when c-recognize-post-brace-list-type-p - (c-backward-colon-prefixed-type)) + (c-backward-typed-enum-colon)) (while (and (eq (c-backward-token-2) 0) @@ -9032,7 +10069,8 @@ comment at the start of cc-engine.el for more info." ((eq (char-after) ?\() (and (eq (c-backward-token-2) 0) (or (looking-at c-decl-hangon-key) - (looking-at c-noise-macro-with-parens-name-re)))) + (and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re))))) ((and c-recognize-<>-arglists (eq (char-after) ?<) @@ -9042,6 +10080,186 @@ comment at the start of cc-engine.el for more info." (or (looking-at c-brace-list-key) (progn (goto-char here) nil)))) +(defun c-looking-at-or-maybe-in-bracelist (&optional containing-sexp lim) + ;; Point is at an open brace. If this starts a brace list, return a list + ;; whose car is the buffer position of the start of the construct which + ;; introduces the list, and whose cdr is t if we have parsed a keyword + ;; matching `c-opt-inexpr-brace-list-key' (e.g. Java's "new"), nil + ;; otherwise. Otherwise, if point might be inside an enclosing brace list, + ;; return t. If point is definitely neither at nor in a brace list, return + ;; nil. + ;; + ;; CONTAINING-SEXP is the position of the brace/paren/bracket enclosing + ;; POINT, or nil if there is no such position, or we do not know it. LIM is + ;; a backward search limit. + ;; + ;; Here, "brace list" does not include the body of an enum. + (save-excursion + (let ((start (point)) + (class-key + ;; Pike can have class definitions anywhere, so we must + ;; check for the class key here. + (and (c-major-mode-is 'pike-mode) + c-decl-block-key)) + (braceassignp 'dontknow) + inexpr-brace-list bufpos macro-start res pos after-type-id-pos) + + (setq res (c-backward-token-2 1 t lim)) + ;; Checks to do only on the first sexp before the brace. + ;; Have we a C++ initialization, without an "="? + (if (and (c-major-mode-is 'c++-mode) + (cond + ((and (not (eq res 0)) + (c-go-up-list-backward nil lim) ; FIXME!!! Check ; `lim' 2016-07-12. + (eq (char-after) ?\()) + (setq braceassignp 'c++-noassign)) + ((looking-at c-pre-id-bracelist-key)) + ((looking-at c-return-key)) + ((and (looking-at c-symbol-start) + (not (looking-at c-keywords-regexp))) + (setq after-type-id-pos (point))) + (t nil)) + (save-excursion + (cond + ((not (eq res 0)) + (and (c-go-up-list-backward nil lim) ; FIXME!!! Check `lim' 2016-07-12. + (eq (char-after) ?\())) + ((looking-at c-pre-id-bracelist-key)) + ((looking-at c-return-key)) + (t (setq after-type-id-pos (point)) + nil)))) + (setq braceassignp 'c++-noassign)) + + (when (and c-opt-inexpr-brace-list-key + (eq (char-after) ?\[)) + ;; In Java, an initialization brace list may follow + ;; directly after "new Foo[]", so check for a "new" + ;; earlier. + (while (eq braceassignp 'dontknow) + (setq braceassignp + (cond ((/= (c-backward-token-2 1 t lim) 0) nil) + ((looking-at c-opt-inexpr-brace-list-key) + (setq inexpr-brace-list t) + t) + ((looking-at "\\sw\\|\\s_\\|[.[]") + ;; Carry on looking if this is an + ;; identifier (may contain "." in Java) + ;; or another "[]" sexp. + 'dontknow) + (t nil))))) + + (setq pos (point)) + (if (and after-type-id-pos + (goto-char after-type-id-pos) + (setq res (c-back-over-member-initializers)) + (goto-char res) + (eq (car (c-beginning-of-decl-1 lim)) 'same)) + (cons (point) nil) ; Return value. + + (goto-char pos) + ;; Checks to do on all sexps before the brace, up to the + ;; beginning of the statement. + (while (eq braceassignp 'dontknow) + (cond ((eq (char-after) ?\;) + (setq braceassignp nil)) + ((and class-key + (looking-at class-key)) + (setq braceassignp nil)) + ((eq (char-after) ?=) + ;; We've seen a =, but must check earlier tokens so + ;; that it isn't something that should be ignored. + (setq braceassignp 'maybe) + (while (and (eq braceassignp 'maybe) + (zerop (c-backward-token-2 1 t lim))) + (setq braceassignp + (cond + ;; Check for operator = + ((and c-opt-op-identifier-prefix + (looking-at c-opt-op-identifier-prefix)) + nil) + ;; Check for `<opchar>= in Pike. + ((and (c-major-mode-is 'pike-mode) + (or (eq (char-after) ?`) + ;; Special case for Pikes + ;; `[]=, since '[' is not in + ;; the punctuation class. + (and (eq (char-after) ?\[) + (eq (char-before) ?`)))) + nil) + ((looking-at "\\s.") 'maybe) + ;; make sure we're not in a C++ template + ;; argument assignment + ((and + (c-major-mode-is 'c++-mode) + (save-excursion + (let ((here (point)) + (pos< (progn + (skip-chars-backward "^<>") + (point)))) + (and (eq (char-before) ?<) + (not (c-crosses-statement-barrier-p + pos< here)) + (not (c-in-literal)) + )))) + nil) + (t t)))))) + (if (and (eq braceassignp 'dontknow) + (/= (c-backward-token-2 1 t lim) 0)) + (setq braceassignp nil))) + + (cond + (braceassignp + ;; We've hit the beginning of the aggregate list. + (c-beginning-of-statement-1 containing-sexp) + (cons (point) inexpr-brace-list)) + ((and after-type-id-pos + (save-excursion + (when (eq (char-after) ?\;) + (c-forward-token-2 1 t)) + (setq bufpos (point)) + (when (looking-at c-opt-<>-sexp-key) + (c-forward-token-2) + (when (and (eq (char-after) ?<) + (c-get-char-property (point) 'syntax-table)) + (c-go-list-forward nil after-type-id-pos) + (c-forward-syntactic-ws))) + (and + (or (not (looking-at c-class-key)) + (save-excursion + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (not (eq (point) after-type-id-pos)))) + (progn + (setq res + (c-forward-decl-or-cast-1 + (save-excursion (c-backward-syntactic-ws) (point)) + nil nil)) + (and (consp res) + (eq (car res) after-type-id-pos)))))) + (cons bufpos inexpr-brace-list)) + ((eq (char-after) ?\;) + ;; Brace lists can't contain a semicolon, so we're done. + ;; (setq containing-sexp nil) + nil) + ((and (setq macro-start (point)) + (c-forward-to-cpp-define-body) + (eq (point) start)) + ;; We've a macro whose expansion starts with the '{'. + ;; Heuristically, if we have a ';' in it we've not got a + ;; brace list, otherwise we have. + (let ((macro-end (progn (c-end-of-macro) (point)))) + (goto-char start) + (forward-char) + (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t) + (eq (char-before) ?\;)) + nil + (cons macro-start nil)))) ; (2016-08-30): Lazy! We have no + ; languages where + ; `c-opt-inexpr-brace-list-key' is + ; non-nil and we have macros. + (t t))) ;; The caller can go up one level. + ))) + (defun c-inside-bracelist-p (containing-sexp paren-state) ;; return the buffer position of the beginning of the brace list ;; statement if we're inside a brace list, otherwise return nil. @@ -9061,13 +10279,9 @@ comment at the start of cc-engine.el for more info." (c-backward-over-enum-header)) ;; this will pick up array/aggregate init lists, even if they are nested. (save-excursion - (let ((class-key - ;; Pike can have class definitions anywhere, so we must - ;; check for the class key here. - (and (c-major-mode-is 'pike-mode) - c-decl-block-key)) - bufpos braceassignp lim next-containing macro-start) - (while (and (not bufpos) + (let ((bufpos t) + lim next-containing) + (while (and (eq bufpos t) containing-sexp) (when paren-state (if (consp (car paren-state)) @@ -9077,113 +10291,22 @@ comment at the start of cc-engine.el for more info." (when paren-state (setq next-containing (car paren-state) paren-state (cdr paren-state)))) + (goto-char containing-sexp) (if (c-looking-at-inexpr-block next-containing next-containing) ;; We're in an in-expression block of some kind. Do not ;; check nesting. We deliberately set the limit to the ;; containing sexp, so that c-looking-at-inexpr-block ;; doesn't check for an identifier before it. - (setq containing-sexp nil) - ;; see if the open brace is preceded by = or [...] in - ;; this statement, but watch out for operator= - (setq braceassignp 'dontknow) - (c-backward-token-2 1 t lim) - ;; Checks to do only on the first sexp before the brace. - (when (and c-opt-inexpr-brace-list-key - (eq (char-after) ?\[)) - ;; In Java, an initialization brace list may follow - ;; directly after "new Foo[]", so check for a "new" - ;; earlier. - (while (eq braceassignp 'dontknow) - (setq braceassignp - (cond ((/= (c-backward-token-2 1 t lim) 0) nil) - ((looking-at c-opt-inexpr-brace-list-key) t) - ((looking-at "\\sw\\|\\s_\\|[.[]") - ;; Carry on looking if this is an - ;; identifier (may contain "." in Java) - ;; or another "[]" sexp. - 'dontknow) - (t nil))))) - ;; Checks to do on all sexps before the brace, up to the - ;; beginning of the statement. - (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) - (setq braceassignp nil)) - ((and class-key - (looking-at class-key)) - (setq braceassignp nil)) - ((eq (char-after) ?=) - ;; We've seen a =, but must check earlier tokens so - ;; that it isn't something that should be ignored. - (setq braceassignp 'maybe) - (while (and (eq braceassignp 'maybe) - (zerop (c-backward-token-2 1 t lim))) - (setq braceassignp - (cond - ;; Check for operator = - ((and c-opt-op-identifier-prefix - (looking-at c-opt-op-identifier-prefix)) - nil) - ;; Check for `<opchar>= in Pike. - ((and (c-major-mode-is 'pike-mode) - (or (eq (char-after) ?`) - ;; Special case for Pikes - ;; `[]=, since '[' is not in - ;; the punctuation class. - (and (eq (char-after) ?\[) - (eq (char-before) ?`)))) - nil) - ((looking-at "\\s.") 'maybe) - ;; make sure we're not in a C++ template - ;; argument assignment - ((and - (c-major-mode-is 'c++-mode) - (save-excursion - (let ((here (point)) - (pos< (progn - (skip-chars-backward "^<>") - (point)))) - (and (eq (char-before) ?<) - (not (c-crosses-statement-barrier-p - pos< here)) - (not (c-in-literal)) - )))) - nil) - (t t)))))) - (if (and (eq braceassignp 'dontknow) - (/= (c-backward-token-2 1 t lim) 0)) - (setq braceassignp nil))) - (cond - (braceassignp - ;; We've hit the beginning of the aggregate list. - (c-beginning-of-statement-1 - (c-most-enclosing-brace paren-state)) - (setq bufpos (point))) - ((eq (char-after) ?\;) - ;; Brace lists can't contain a semicolon, so we're done. - (setq containing-sexp nil)) - ((and (setq macro-start (point)) - (c-forward-to-cpp-define-body) - (eq (point) containing-sexp)) - ;; We've a macro whose expansion starts with the '{'. - ;; Heuristically, if we have a ';' in it we've not got a - ;; brace list, otherwise we have. - (let ((macro-end (progn (c-end-of-macro) (point)))) - (goto-char containing-sexp) - (forward-char) - (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t) - (eq (char-before) ?\;)) - (setq bufpos nil - containing-sexp nil) - (setq bufpos macro-start)))) - (t - ;; Go up one level + (setq bufpos nil) + (when (or (not (eq (char-after) ?{)) + (eq (setq bufpos (c-looking-at-or-maybe-in-bracelist + next-containing lim)) + t)) (setq containing-sexp next-containing lim nil - next-containing nil))))) - - bufpos)) - )) + next-containing nil)))) + (and (consp bufpos) (car bufpos)))))) (defun c-looking-at-special-brace-list (&optional lim) ;; If we're looking at the start of a pike-style list, i.e., `({ })', @@ -9279,12 +10402,27 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (save-excursion - (let ((res 'maybe) passed-paren + (let ((res 'maybe) (passed-bracket-pairs 0) bracket-pos passed-paren + haskell-op-pos (closest-lim (or containing-sexp lim (point-min))) ;; Look at the character after point only as a last resort ;; when we can't disambiguate. (block-follows (and (eq (char-after) ?{) (point)))) + ;; Search for a C++11 "->" which suggests a lambda declaration. + (when (and (c-major-mode-is 'c++-mode) + (setq haskell-op-pos + (save-excursion + (while + (progn + (c-syntactic-skip-backward "^;=}>" closest-lim t) + (and (eq (char-before) ?>) + (c-backward-token-2) + (not (looking-at c-haskell-op-re))))) + (and (looking-at c-haskell-op-re) + (point))))) + (goto-char haskell-op-pos)) + (while (and (eq res 'maybe) (progn (c-backward-syntactic-ws) (> (point) closest-lim)) @@ -9322,6 +10460,11 @@ comment at the start of cc-engine.el for more info." (zerop (c-forward-token-2 1 t))) (eq (char-after) ?\()))) (cons 'inexpr-class (point)))) + ((c-keyword-member kw-sym 'c-paren-any-kwds) ; e.g. C++11 "throw" or "noexcept" + (setq passed-paren nil) + (setq passed-bracket-pairs 0) + (setq bracket-pos nil) + 'maybe) ((c-keyword-member kw-sym 'c-inexpr-block-kwds) (when (not passed-paren) (cons 'inexpr-statement (point)))) @@ -9336,20 +10479,49 @@ comment at the start of cc-engine.el for more info." (if (looking-at "\\s(") (if passed-paren - (if (and (eq passed-paren ?\[) - (eq (char-after) ?\[)) - ;; Accept several square bracket sexps for - ;; Java array initializations. - 'maybe) - (setq passed-paren (char-after)) + (cond + ((and (eq passed-paren ?\[) + (eq (char-after) ?\[) + (not (eq (char-after (1+ (point))) ?\[))) ; C++ attribute. + ;; Accept several square bracket sexps for + ;; Java array initializations. + (setq passed-bracket-pairs (1+ passed-bracket-pairs)) + 'maybe) + ((and (eq passed-paren ?\() + (eq (char-after) ?\[) + (not (eq (char-after (1+ (point))) ?\[)) + (eq passed-bracket-pairs 0)) + ;; C++11 lambda function declaration + (setq passed-bracket-pairs 1) + (setq bracket-pos (point)) + 'maybe) + (t nil)) + (when (not (looking-at "\\[\\[")) + (setq passed-paren (char-after)) + (when (eq passed-paren ?\[) + (setq passed-bracket-pairs 1) + (setq bracket-pos (point)))) 'maybe) 'maybe)))) (if (eq res 'maybe) - (when (and c-recognize-paren-inexpr-blocks - block-follows - containing-sexp - (eq (char-after containing-sexp) ?\()) + (cond + ((and (c-major-mode-is 'c++-mode) + block-follows + (eq passed-bracket-pairs 1) + (save-excursion + (goto-char bracket-pos) + (or (<= (point) (or lim (point-min))) + (progn + (c-backward-token-2 1 nil lim) + (and + (not (c-on-identifier)) + (not (looking-at c-opt-op-identifier-prefix))))))) + (cons 'inlambda bracket-pos)) + ((and c-recognize-paren-inexpr-blocks + block-follows + containing-sexp + (eq (char-after containing-sexp) ?\()) (goto-char containing-sexp) (if (or (save-excursion (c-backward-syntactic-ws lim) @@ -9361,9 +10533,21 @@ comment at the start of cc-engine.el for more info." (and (> (point) (or lim (point-min))) (c-on-identifier))) (and c-special-brace-lists - (c-looking-at-special-brace-list))) + (c-looking-at-special-brace-list)) + (and (c-major-mode-is 'c++-mode) + (save-excursion + (goto-char block-follows) + (if (c-go-list-forward) + (progn + (backward-char) + (c-syntactic-skip-backward + "^;," block-follows t) + (not (eq (char-before) ?\;))) + (or (not (c-syntactic-re-search-forward + "[;,]" nil t t)) + (not (eq (char-before) ?\;))))))) nil - (cons 'inexpr-statement (point)))) + (cons 'inexpr-statement (point))))) res)))) @@ -9389,6 +10573,18 @@ comment at the start of cc-engine.el for more info." paren-state) containing-sexp))))) +(defun c-looking-at-c++-lambda-capture-list () + ;; Return non-nil if we're at the opening "[" of the capture list of a C++ + ;; lambda function, nil otherwise. + (and + (eq (char-after) ?\[) + (not (eq (char-before) ?\[)) + (not (eq (char-after (1+ (point))) ?\[)) + (save-excursion + (or (eq (c-backward-token-2 1) 1) + (looking-at c-pre-lambda-tokens-re))) + (not (c-in-literal)))) + (defun c-at-macro-vsemi-p (&optional pos) ;; Is there a "virtual semicolon" at POS or point? ;; (See cc-defs.el for full details of "virtual semicolons".) @@ -9758,10 +10954,10 @@ comment at the start of cc-engine.el for more info." ;; CASE B.2: brace-list-open ((or (consp special-brace-list) - (save-excursion - (goto-char beg-of-same-or-containing-stmt) - (c-syntactic-re-search-forward "=\\([^=]\\|$\\)" - indent-point t t t))) + (consp + (c-looking-at-or-maybe-in-bracelist + containing-sexp beg-of-same-or-containing-stmt)) + ) ;; The most semantically accurate symbol here is ;; brace-list-open, but we normally report it simply as a ;; statement-cont. The reason is that one normally adjusts @@ -9794,6 +10990,14 @@ comment at the start of cc-engine.el for more info." (c-add-stmt-syntax 'defun-open nil t containing-sexp paren-state)) + ;; CASE B.5: We have a C++11 "return \n { ..... }" Note that we're + ;; not at the "{", currently. + ((progn (goto-char indent-point) + (backward-sexp) + (looking-at c-return-key)) + (c-add-stmt-syntax 'statement-cont nil t + containing-sexp paren-state)) + ;; CASE B.4: Continued statement with block open. The most ;; accurate analysis is perhaps `statement-cont' together with ;; `block-open' but we play DWIM and use `substatement-open' @@ -10021,8 +11225,8 @@ comment at the start of cc-engine.el for more info." ;; versions, which results in that we get nil from ;; `c-literal-limits' even when `c-in-literal' claims ;; we're inside a comment. - (setq placeholder (c-literal-limits lim))) - (c-add-syntax literal (car placeholder))) + (setq placeholder (c-literal-start lim))) + (c-add-syntax literal placeholder)) ;; CASE 3: in a cpp preprocessor macro continuation. ((and (save-excursion @@ -10293,34 +11497,18 @@ comment at the start of cc-engine.el for more info." ;; CASE 5A.3: brace list open ((save-excursion - (c-beginning-of-decl-1 lim) - (while (cond - ((looking-at c-specifier-key) - (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) - (c-forward-noise-clause)))) - (setq placeholder (c-point 'boi)) - (or (consp special-brace-list) - (and (or (save-excursion - (goto-char indent-point) - (setq tmpsymbol nil) - (while (and (> (point) placeholder) - (zerop (c-backward-token-2 1 t)) - (not (looking-at "=\\([^=]\\|$\\)"))) - (and c-opt-inexpr-brace-list-key - (not tmpsymbol) - (looking-at c-opt-inexpr-brace-list-key) - (setq tmpsymbol 'topmost-intro-cont))) - (looking-at "=\\([^=]\\|$\\)")) - (looking-at c-brace-list-key)) - (save-excursion - (while (and (< (point) indent-point) - (zerop (c-forward-token-2 1 t)) - (not (memq (char-after) '(?\; ?\())))) - (not (memq (char-after) '(?\; ?\())) - )))) + (goto-char indent-point) + (skip-chars-forward " \t") + (cond + ((c-backward-over-enum-header) + (setq placeholder (c-point 'boi))) + ((consp (setq placeholder + (c-looking-at-or-maybe-in-bracelist + containing-sexp lim))) + (setq tmpsymbol (and (cdr placeholder) 'topmost-intro-cont)) + (setq placeholder (c-point 'boi (car placeholder)))))) (if (and (not c-auto-newline-analysis) - (c-major-mode-is 'java-mode) + ;(c-major-mode-is 'java-mode) ; Not needed anymore (2016-08-30). (eq tmpsymbol 'topmost-intro-cont)) ;; We're in Java and have found that the open brace ;; belongs to a "new Foo[]" initialization list, @@ -10353,7 +11541,8 @@ comment at the start of cc-engine.el for more info." (while (cond ((looking-at c-specifier-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) (c-add-syntax 'defun-open (c-point 'boi)) ;; Bogus to use bol here, but it's the legacy. (Resolved, @@ -10988,7 +12177,8 @@ comment at the start of cc-engine.el for more info." (while (cond ((looking-at c-specifier-key) (c-forward-keyword-clause 1)) - ((looking-at c-noise-macro-with-parens-name-re) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)))) (c-add-syntax 'brace-list-open (c-point 'boi)))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index a7097b98c9d..26a002ac8a1 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -723,6 +723,10 @@ casts and declarations are fontified. Used on level 2 and higher." (concat ".\\(" c-string-limit-regexp "\\)") '((c-font-lock-invalid-string))) + ;; Fontify C++ raw strings. + ,@(when (c-major-mode-is 'c++-mode) + '(c-font-lock-raw-strings)) + ;; Fontify keyword constants. ,@(when (c-lang-const c-constant-kwds) (let ((re (c-make-keywords-re nil (c-lang-const c-constant-kwds)))) @@ -895,7 +899,8 @@ casts and declarations are fontified. Used on level 2 and higher." (c-get-char-property (1- (point)) 'c-type))))) (when (memq prop '(c-decl-id-start c-decl-type-start)) (c-forward-syntactic-ws limit) - (c-font-lock-declarators limit t (eq prop 'c-decl-type-start)))) + (c-font-lock-declarators limit t (eq prop 'c-decl-type-start) + (c-bs-at-toplevel-p (point))))) (setq c-font-lock-context ;; (c-guess-font-lock-context) (save-excursion @@ -914,7 +919,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; ;; Fontify types and references in names containing angle bracket ;; arglists from the point to LIMIT. Note that - ;; `c-font-lock-declarations' already has handled many of them. + ;; `c-font-lock-declarations' has already handled many of them. ;; ;; This function might do hidden buffer changes. @@ -976,17 +981,18 @@ casts and declarations are fontified. Used on level 2 and higher." (when (and c-opt-identifier-concat-key (not (get-text-property id-start 'face))) (c-forward-syntactic-ws) - (if (looking-at c-opt-identifier-concat-key) - (c-put-font-lock-face id-start id-end - c-reference-face-name) - (c-put-font-lock-face id-start id-end - 'font-lock-type-face))))) + (cond ((looking-at c-opt-identifier-concat-key) + (c-put-font-lock-face id-start id-end + c-reference-face-name)) + ((eq (char-after) ?\()) + (t (c-put-font-lock-face id-start id-end + 'font-lock-type-face)))))) (goto-char pos))) (goto-char pos))))) nil) -(defun c-font-lock-declarators (limit list types) +(defun c-font-lock-declarators (limit list types not-top) ;; Assuming the point is at the start of a declarator in a declaration, ;; fontify the identifier it declares. (If TYPES is set, it does this via ;; the macro `c-fontify-types-and-refs'.) @@ -996,7 +1002,9 @@ casts and declarations are fontified. Used on level 2 and higher." ;; additionally, mark the commas with c-type property 'c-decl-id-start or ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; - ;; If TYPES is non-nil, fontify all identifiers as types. + ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is + ;; non-nil, we are not at the top-level ("top-level" includes being directly + ;; inside a class or namespace, etc.). ;; ;; Nil is always returned. The function leaves point at the delimiter after ;; the last declarator it processes. @@ -1020,6 +1028,14 @@ casts and declarations are fontified. Used on level 2 and higher." (setq next-pos (point) id-start (car decl-res) id-face (if (and (eq (char-after) ?\() + (or (not (c-major-mode-is 'c++-mode)) + (not not-top) + (car (cddr (cddr decl-res))) ; Id is in + ; parens, etc. + (save-excursion + (forward-char) + (c-forward-syntactic-ws) + (looking-at "[*&]"))) (not (car (cddr decl-res))) ; brackets-after-id (or (not (c-major-mode-is 'c++-mode)) (save-excursion @@ -1161,7 +1177,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; `parse-sexp-lookup-properties' (when it exists). (parse-sexp-lookup-properties (cc-eval-when-compile - (boundp 'parse-sexp-lookup-properties)))) + (boundp 'parse-sexp-lookup-properties)) + )) ;; Below we fontify a whole declaration even when it crosses the limit, ;; to avoid gaps when jit/lazy-lock fontifies the file a block at a @@ -1193,13 +1210,14 @@ casts and declarations are fontified. Used on level 2 and higher." c-decl-start-re (eval c-maybe-decl-faces) - (lambda (match-pos inside-macro) + (lambda (match-pos inside-macro &optional toplev) ;; Note to maintainers: don't use `limit' inside this lambda form; ;; c-find-decl-spots sometimes narrows to less than `limit'. (setq start-pos (point)) (when ;; The result of the form below is true when we don't recognize a - ;; declaration or cast. + ;; declaration or cast, and we don't recognize a "non-decl", + ;; typically a brace list. (if (or (and (eq (get-text-property (point) 'face) 'font-lock-keyword-face) (looking-at c-not-decl-init-keywords)) @@ -1215,8 +1233,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; (e.g. "for ("). (let ((type (and (> match-pos (point-min)) (c-get-char-property (1- match-pos) 'c-type)))) - (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?<))) - (setq context nil + (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{))) + (setq context (and toplev 'top) c-restricted-<>-arglists nil)) ;; A control flow expression or a decltype ((and (eq (char-before match-pos) ?\() @@ -1237,6 +1255,37 @@ casts and declarations are fontified. Used on level 2 and higher." ((eq type 'c-decl-arg-start) (setq context 'decl c-restricted-<>-arglists nil)) + ;; We're inside (probably) a brace list. + ((eq type 'c-not-decl) + (setq context 'not-decl + c-restricted-<>-arglists nil)) + ;; Inside a C++11 lambda function arglist. + ((and (c-major-mode-is 'c++-mode) + (eq (char-before match-pos) ?\() + (save-excursion + (goto-char match-pos) + (c-backward-token-2) + (and + (c-safe (goto-char (scan-sexps (point) -1))) + (c-looking-at-c++-lambda-capture-list)))) + (setq context 'decl + c-restricted-<>-arglists nil) + (c-put-char-property (1- match-pos) 'c-type + 'c-decl-arg-start)) + ;; We're inside a brace list. + ((and (eq (char-before match-pos) ?{) + (save-excursion + (goto-char (1- match-pos)) + (consp + (c-looking-at-or-maybe-in-bracelist)))) + (setq context 'not-decl + c-restricted-<>-arglists nil) + (c-put-char-property (1- match-pos) 'c-type + 'c-not-decl)) + ;; We're inside an "ordinary" open brace. + ((eq (char-before match-pos) ?{) + (setq context (and toplev 'top) + c-restricted-<>-arglists nil)) ;; Inside an angle bracket arglist. ((or (eq type 'c-<>-arg-sep) (eq (char-before match-pos) ?<)) @@ -1282,182 +1331,132 @@ casts and declarations are fontified. Used on level 2 and higher." (c-forward-syntactic-ws)) ;; Now analyze the construct. - (setq decl-or-cast (c-forward-decl-or-cast-1 - match-pos context last-cast-end)) - - ;; Ensure that c-<>-arg-sep c-type properties are in place on the - ;; commas separating the arguments inside template/generic <..>s. - (when (and (eq (char-before match-pos) ?<) - (> match-pos max-<>-end)) - (save-excursion - (goto-char match-pos) - (c-backward-token-2) - (if (and - (eq (char-after) ?<) - (let ((c-restricted-<>-arglists - (save-excursion - (c-backward-token-2) - (and - (not (looking-at c-opt-<>-sexp-key)) - (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\( ?,))) - (not (eq (c-get-char-property (1- (point)) - 'c-type) - 'c-decl-arg-start)))))) - (c-forward-<>-arglist nil))) - (setq max-<>-end (point))))) - - (cond - ((eq decl-or-cast 'cast) - ;; Save the position after the previous cast so we can feed - ;; it to `c-forward-decl-or-cast-1' in the next round. That - ;; helps it discover cast chains like "(a) (b) c". - (setq last-cast-end (point)) - (c-fontify-recorded-types-and-refs) - nil) - - (decl-or-cast - ;; We've found a declaration. - - ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' - ;; under the assumption that we're after the first type decl - ;; expression in the declaration now. That's not really true; - ;; we could also be after a parenthesized initializer - ;; expression in C++, but this is only used as a last resort - ;; to slant ambiguous expression/declarations, and overall - ;; it's worth the risk to occasionally fontify an expression - ;; as a declaration in an initializer expression compared to - ;; getting ambiguous things in normal function prototypes - ;; fontified as expressions. - (if inside-macro - (when (> (point) max-type-decl-end-before-token) - (setq max-type-decl-end-before-token (point))) - (when (> (point) max-type-decl-end) - (setq max-type-decl-end (point)))) - - ;; Back up to the type to fontify the declarator(s). - (goto-char (car decl-or-cast)) - - (let ((decl-list - (if context - ;; Should normally not fontify a list of - ;; declarators inside an arglist, but the first - ;; argument in the ';' separated list of a "for" - ;; statement is an exception. - (when (eq (char-before match-pos) ?\() - (save-excursion - (goto-char (1- match-pos)) - (c-backward-syntactic-ws) - (and (c-simple-skip-symbol-backward) - (looking-at c-paren-stmt-key)))) - t))) - - ;; Fix the `c-decl-id-start' or `c-decl-type-start' property - ;; before the first declarator if it's a list. - ;; `c-font-lock-declarators' handles the rest. - (when decl-list - (save-excursion - (c-backward-syntactic-ws) - (unless (bobp) - (c-put-char-property (1- (point)) 'c-type - (if (cdr decl-or-cast) - 'c-decl-type-start - 'c-decl-id-start))))) - - (c-font-lock-declarators - (point-max) decl-list (cdr decl-or-cast))) - - ;; A declaration has been successfully identified, so do all the - ;; fontification of types and refs that've been recorded. - (c-fontify-recorded-types-and-refs) - nil) - - ;; Restore point, since at this point in the code it has been - ;; left undefined by c-forward-decl-or-cast-1 above. - ((progn (goto-char start-pos) nil)) - - ;; If point is inside a bracelist, there's no point checking it - ;; being at a declarator. - ((let ((paren-state (c-parse-state))) - (setq lbrace (c-cheap-inside-bracelist-p paren-state))) - ;; Move past this bracelist to prevent an endless loop. - (goto-char lbrace) - (unless (c-safe (progn (forward-list) t)) - (goto-char start-pos) - (c-forward-token-2)) - nil) - - ;; If point is just after a ")" which is followed by an - ;; identifier which isn't a label, or at the matching "(", we're - ;; at either a macro invocation, a cast, or a - ;; for/while/etc. statement. The cast case is handled above. - ;; None of these cases can contain a declarator. - ((or (and (eq (char-before match-pos) ?\)) - (c-on-identifier) - (save-excursion (not (c-forward-label)))) - (and (eq (char-after) ?\() - (save-excursion - (and - (progn (c-backward-token-2) (c-on-identifier)) - (save-excursion (not (c-forward-label))) - (progn (c-backward-token-2) - (eq (char-after) ?\()))))) - (c-forward-token-2) ; Must prevent looping. - nil) - - ((and (not c-enums-contain-decls) - ;; An optimization quickly to eliminate scans of long enum - ;; declarations in the next cond arm. - (let ((paren-state (c-parse-state))) - (and - (numberp (car paren-state)) + (if (eq context 'not-decl) + (progn + (setq decl-or-cast nil) + (if (c-syntactic-re-search-forward + "," (min limit (point-max)) 'at-limit t) + (c-put-char-property (1- (point)) 'c-type 'c-not-decl)) + nil) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + ;; Ensure that c-<>-arg-sep c-type properties are in place on the + ;; commas separating the arguments inside template/generic <..>s. + (when (and (eq (char-before match-pos) ?<) + (> match-pos max-<>-end)) + (save-excursion + (goto-char match-pos) + (c-backward-token-2) + (if (and + (eq (char-after) ?<) + (let ((c-restricted-<>-arglists + (save-excursion + (c-backward-token-2) + (and + (not (looking-at c-opt-<>-sexp-key)) + (progn (c-backward-syntactic-ws) + (memq (char-before) '(?\( ?,))) + (not (eq (c-get-char-property (1- (point)) + 'c-type) + 'c-decl-arg-start)))))) + (c-forward-<>-arglist nil))) + (setq max-<>-end (point))))) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + (c-fontify-recorded-types-and-refs) + nil) + + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point)))) + + ;; Do we have an expression as the second or third clause of + ;; a "for" paren expression? + (if (save-excursion + (and + (car (cddr decl-or-cast)) ; maybe-expression flag. + (goto-char start-pos) + (c-go-up-list-backward) + (eq (char-after) ?\() + (progn (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward)) + (looking-at c-paren-stmt-key) + (progn (goto-char match-pos) + (while (and (eq (char-before) ?\)) + (c-go-list-backward)) + (c-backward-syntactic-ws)) + (eq (char-before) ?\;)))) + ;; We've got an expression in "for" parens. Remove the + ;; "type" that would spuriously get fontified. + (let ((elt (and (consp c-record-type-identifiers) + (assq (cadr (cddr decl-or-cast)) + c-record-type-identifiers)))) + (when elt + (setq c-record-type-identifiers + (c-delq-from-dotted-list + elt c-record-type-identifiers))) + t) + ;; Back up to the type to fontify the declarator(s). + (goto-char (car decl-or-cast)) + + (let ((decl-list + (if (not (memq context '(nil top))) + ;; Should normally not fontify a list of + ;; declarators inside an arglist, but the first + ;; argument in the ';' separated list of a "for" + ;; statement is an exception. + (when (eq (char-before match-pos) ?\() + (save-excursion + (goto-char (1- match-pos)) + (c-backward-syntactic-ws) + (and (c-simple-skip-symbol-backward) + (looking-at c-paren-stmt-key)))) + t))) + + ;; Fix the `c-decl-id-start' or `c-decl-type-start' property + ;; before the first declarator if it's a list. + ;; `c-font-lock-declarators' handles the rest. + (when decl-list (save-excursion - (goto-char (car paren-state)) - (c-backward-over-enum-header))))) - (c-forward-token-2) - nil) + (c-backward-syntactic-ws) + (unless (bobp) + (c-put-char-property (1- (point)) 'c-type + (if (cadr decl-or-cast) + 'c-decl-type-start + 'c-decl-id-start))))) + + (c-font-lock-declarators + (min limit (point-max)) decl-list + (cadr decl-or-cast) (not toplev))) + + ;; A declaration has been successfully identified, so do all the + ;; fontification of types and refs that've been recorded. + (c-fontify-recorded-types-and-refs) + nil)) - (t - ;; Are we at a declarator? Try to go back to the declaration - ;; to check this. If we get there, check whether a "typedef" - ;; is there, then fontify the declarators accordingly. - (let ((decl-search-lim (c-determine-limit 1000)) - paren-state bod-res encl-pos is-typedef - c-recognize-knr-p) ; Strictly speaking, bogus, but it - ; speeds up lisp.h tremendously. - (save-excursion - (if (c-back-over-member-initializers) - t ; Can't be at a declarator - (unless (or (eobp) - (looking-at "\\s(\\|\\s)")) - (forward-char)) - (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim))) - (if (and (eq bod-res 'same) - (save-excursion - (c-backward-syntactic-ws) - (eq (char-before) ?\}))) - (c-beginning-of-decl-1 decl-search-lim)) - - ;; We're now putatively at the declaration. - (setq paren-state (c-parse-state)) - ;; At top level or inside a "{"? - (if (or (not (setq encl-pos - (c-most-enclosing-brace paren-state))) - (eq (char-after encl-pos) ?\{)) - (progn - (when (looking-at c-typedef-key) ; "typedef" - (setq is-typedef t) - (goto-char (match-end 0)) - (c-forward-syntactic-ws)) - ;; At a real declaration? - (if (memq (c-forward-type t) '(t known found decltype)) - (progn - (c-font-lock-declarators (point-max) t is-typedef) - nil) - ;; False alarm. Return t to go on to the next check. - (goto-char start-pos) - t)) - t))))))) + (t t)))) ;; It was a false alarm. Check if we're in a label (or other ;; construct with `:' except bitfield) instead. @@ -1511,9 +1510,52 @@ casts and declarations are fontified. Used on level 2 and higher." (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) (c-forward-syntactic-ws) - (c-font-lock-declarators limit t nil))) + (c-font-lock-declarators limit t nil t))) nil) +(defun c-font-lock-cut-off-declarators (limit) + ;; Fontify any declarators "cut off" from their declaring type at the start + ;; of the region being fontified. + ;; + ;; This function will be called from font-lock- for a region bounded by + ;; POINT and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; fontification". + (let ((decl-search-lim (c-determine-limit 1000)) + paren-state bod-res is-typedef encl-pos + (here (point)) + c-recognize-knr-p) ; Strictly speaking, bogus, but it + ; speeds up lisp.h tremendously. + (save-excursion + (when (not (c-back-over-member-initializers)) + (unless (or (eobp) + (looking-at "\\s(\\|\\s)")) + (forward-char)) + (c-syntactic-skip-backward "^;{}" decl-search-lim t) + (when (eq (char-before) ?}) + (c-go-list-backward) ; brace block of struct, etc.? + (c-syntactic-skip-backward "^;{}" decl-search-lim t)) + (when (or (bobp) + (memq (char-before) '(?\; ?{ ?}))) + (c-forward-syntactic-ws) + ;; We're now putatively at the declaration. + (setq paren-state (c-parse-state)) + ;; At top level or inside a "{"? + (if (or (not (setq encl-pos + (c-most-enclosing-brace paren-state))) + (eq (char-after encl-pos) ?\{)) + (progn + (when (looking-at c-typedef-key) ; "typedef" + (setq is-typedef t) + (goto-char (match-end 0)) + (c-forward-syntactic-ws)) + ;; At a real declaration? + (if (memq (c-forward-type t) '(t known found decltype)) + (c-font-lock-declarators + limit t is-typedef (not (c-bs-at-toplevel-p here))))))))) + nil)) + (defun c-font-lock-enclosing-decls (limit) ;; Fontify the declarators of (nested) declarations we're in the middle of. ;; This is mainly for when a jit-lock etc. chunk starts inside the brace @@ -1526,7 +1568,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Fontification". (let* ((paren-state (c-parse-state)) (decl-search-lim (c-determine-limit 1000)) - decl-context in-typedef ps-elt) + in-typedef ps-elt) ;; Are we in any nested struct/union/class/etc. braces? (while paren-state (setq ps-elt (car paren-state) @@ -1534,15 +1576,158 @@ casts and declarations are fontified. Used on level 2 and higher." (when (and (atom ps-elt) (eq (char-after ps-elt) ?\{)) (goto-char ps-elt) - (setq decl-context (c-beginning-of-decl-1 decl-search-lim) - in-typedef (looking-at c-typedef-key)) - (if in-typedef (c-forward-token-2)) - (when (and c-opt-block-decls-with-vars-key - (looking-at c-opt-block-decls-with-vars-key)) - (goto-char ps-elt) - (when (c-safe (c-forward-sexp)) - (c-forward-syntactic-ws) - (c-font-lock-declarators limit t in-typedef))))))) + (c-syntactic-skip-backward "^;{}" decl-search-lim) + (when (or (bobp) + (memq (char-before) '(?\; ?}))) + (c-forward-syntactic-ws) + (setq in-typedef (looking-at c-typedef-key)) + (if in-typedef (c-forward-token-2)) + (when (and c-opt-block-decls-with-vars-key + (looking-at c-opt-block-decls-with-vars-key)) + (goto-char ps-elt) + (when (c-safe (c-forward-sexp)) + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t in-typedef + (not (c-bs-at-toplevel-p (point))))))))))) + +(defun c-font-lock-raw-strings (limit) + ;; Fontify C++ raw strings. + ;; + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + (let* ((state (c-state-semi-pp-to-literal (point))) + (string-start (and (eq (cadr state) 'string) + (car (cddr state)))) + (raw-id (and string-start + (save-excursion + (goto-char string-start) + (and (eq (char-before) ?R) + (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(") + (match-string-no-properties 1)))))) + (while (< (point) limit) + (if raw-id + (progn + (if (search-forward-regexp (concat ")\\(" (regexp-quote raw-id) "\\)\"") + limit 'limit) + (c-put-font-lock-face (match-beginning 1) (point) 'default)) + (setq raw-id nil)) + + (when (search-forward-regexp + "R\\(\"\\)\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" limit 'limit) + (when + (or (and (eobp) + (eq (c-get-char-property (1- (point)) 'face) + 'font-lock-warning-face)) + (eq (c-get-char-property (point) 'face) 'font-lock-string-face) + (and (equal (c-get-char-property (match-end 2) 'syntax-table) '(1)) + (equal (c-get-char-property (match-beginning 1) 'syntax-table) + '(1)))) + (let ((paren-prop (c-get-char-property (1- (point)) 'syntax-table))) + (if paren-prop + (progn + (c-put-font-lock-face (match-beginning 0) (match-end 0) + 'font-lock-warning-face) + (when + (and + (equal paren-prop '(15)) + (not (c-search-forward-char-property 'syntax-table '(15) limit))) + (goto-char limit))) + (c-put-font-lock-face (match-beginning 1) (match-end 2) 'default) + (setq raw-id (match-string-no-properties 2))))))))) + nil) + +(defun c-font-lock-c++-lambda-captures (limit) + ;; Fontify the lambda capture component of C++ lambda declarations. + ;; + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + (let (mode capture-default id-start id-end declaration sub-begin sub-end) + (while (and (< (point) limit) + (search-forward "[" limit t)) + (when (progn (backward-char) + (prog1 + (c-looking-at-c++-lambda-capture-list) + (forward-char))) + (c-forward-syntactic-ws) + (setq mode (and (memq (char-after) '(?= ?&)) + (char-after))) + ;; Is the first element of the list a bare "=" or "&"? + (when mode + (forward-char) + (c-forward-syntactic-ws) + (if (memq (char-after) '(?, ?\])) + (progn + (setq capture-default mode) + (when (eq (char-after) ?,) + (forward-char) + (c-forward-syntactic-ws))) + (c-backward-token-2))) + + ;; Go round the following loop once per captured item. We use "\\s)" + ;; rather than "\\]" here to avoid infinite looping in this situation: + ;; "unsigned items [] { [ }". The second "[" triggers this function, + ;; but if we don't match the "}" with an "\\s)", the + ;; `c-syntactic-re-search-forward' at the end of the loop fails to + ;; move forward over it, leaving point stuck at the "}". + (while (and (not (looking-at "\\s)")) + (< (point) limit)) + (if (eq (char-after) ?&) + (progn (setq mode ?&) + (forward-char) + (c-forward-syntactic-ws)) + (setq mode ?=)) + (if (c-on-identifier) + (progn + (setq id-start (point)) + (forward-char) + (c-end-of-current-token) + (setq id-end (point)) + (c-forward-syntactic-ws) + + (setq declaration (eq (char-after) ?=)) + (when declaration + (forward-char) ; over "=" + (c-forward-syntactic-ws) + (setq sub-begin (point))) + (if (or (and (< (point) limit) + (c-syntactic-re-search-forward "," limit t t)) + (and (c-go-up-list-forward nil limit) + (eq (char-before) ?\]))) + (backward-char) + (goto-char limit)) + (when declaration + (save-excursion + (setq sub-end (point)) + (goto-char sub-begin) + (c-font-lock-c++-lambda-captures sub-end))) + + (c-put-font-lock-face id-start id-end + (cond + (declaration + 'font-lock-variable-name-face) + ((and capture-default + (eq mode capture-default)) + 'font-lock-warning-face) + ((eq mode ?=) font-lock-constant-face) + (t 'font-lock-variable-name-face)))) + (c-syntactic-re-search-forward "," limit 'bound t)) + + (c-forward-syntactic-ws) + (when (eq (char-after) ?,) + (forward-char) + (c-forward-syntactic-ws))) + + (setq capture-default nil) + (if (< (point) limit) + (forward-char))))) ; over the terminating "]" or other close paren. + nil) + (c-lang-defconst c-simple-decl-matchers "Simple font lock matchers for types and declarations. These are used @@ -1571,7 +1756,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (eval . (list ,(c-make-font-lock-search-function 'c-known-type-key '(1 'font-lock-type-face t) - '((c-font-lock-declarators limit t nil) + '((c-font-lock-declarators limit t nil nil) (save-match-data (goto-char (match-end 1)) (c-forward-syntactic-ws)) @@ -1593,7 +1778,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." "\\)")) `(,type-match 'font-lock-type-face t) - `((c-font-lock-declarators limit t nil) + `((c-font-lock-declarators limit t nil nil) (save-match-data (goto-char (match-end ,type-match)) (c-forward-syntactic-ws)) @@ -1605,7 +1790,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (concat "\\<\\(" (regexp-opt (c-lang-const c-typeless-decl-kwds)) "\\)\\>") - '((c-font-lock-declarators limit t nil) + '((c-font-lock-declarators limit t nil nil) (save-match-data (goto-char (match-end 1)) (c-forward-syntactic-ws)) @@ -1647,6 +1832,10 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." 'c-type 'c-decl-end))) c-font-lock-objc-methods)) + ;; Fontify declarators which have been cut off from their declaring + ;; types at the start of the region. + c-font-lock-cut-off-declarators + ;; Fontify all declarations, casts and normal labels. c-font-lock-declarations @@ -1657,6 +1846,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." ,@(when (c-lang-const c-recognize-<>-arglists) `(c-font-lock-<>-arglists)) + ,@(when (c-major-mode-is 'c++-mode) + `(c-font-lock-c++-lambda-captures)) + ;; The first two rules here mostly find occurrences that ;; `c-font-lock-declarations' has found already, but not ;; declarations containing blocks in the type (see note below). @@ -1705,7 +1897,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (looking-at "@[A-Za-z0-9]+"))) (c-forward-keyword-clause 1) t) - (when (looking-at c-noise-macro-with-parens-name-re) + (when (and c-opt-cpp-prefix + (looking-at + c-noise-macro-with-parens-name-re)) (c-forward-noise-clause) t))) ,(if (c-major-mode-is 'c++-mode) @@ -1835,7 +2029,7 @@ higher." ;; before the '{' of the enum list, to avoid searching too far. "[^][{};/#=]*" "{") - '((c-font-lock-declarators limit t nil) + '((c-font-lock-declarators limit t nil t) (save-match-data (goto-char (match-end 0)) (c-put-char-property (1- (point)) 'c-type @@ -2234,7 +2428,7 @@ need for `c++-font-lock-extra-types'.") limit "[-+]" nil - (lambda (match-pos inside-macro) + (lambda (match-pos inside-macro &optional top-level) (forward-char) (c-font-lock-objc-method)))) nil) @@ -2406,10 +2600,10 @@ need for `pike-font-lock-extra-types'.") 'font-lock-comment-face) ;; Handle the case when the fontified region starts inside a ;; comment. - (let ((range (c-literal-limits))) + (let ((start (c-literal-start))) (setq region-beg (point)) - (when range - (goto-char (car range))) + (when start + (goto-char start)) (when (looking-at prefix) (setq comment-beg (point))))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d212482790d..3c328489ec1 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -474,9 +474,17 @@ so that all identifiers are recognized as words.") ;; The value here may be a list of functions or a single function. t nil c++ '(c-extend-region-for-CPP +; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. + c-before-change-check-raw-strings c-before-change-check-<>-operators - c-invalidate-macro-cache) - (c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache) + c-depropertize-CPP + c-before-after-change-digit-quote + c-invalidate-macro-cache + c-truncate-bs-cache) + (c objc) '(c-extend-region-for-CPP + c-depropertize-CPP + c-invalidate-macro-cache + c-truncate-bs-cache) ;; java 'c-before-change-check-<>-operators awk 'c-awk-record-region-clear-NL) (c-lang-defvar c-get-state-before-change-functions @@ -504,15 +512,25 @@ parameters \(point-min) and \(point-max).") (c-lang-defconst c-before-font-lock-functions ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. - t 'c-change-expand-fl-region - (c objc) '(c-neutralize-syntax-in-and-mark-CPP + t '(c-depropertize-new-text + c-change-expand-fl-region) + (c objc) '(c-depropertize-new-text + c-extend-font-lock-region-for-macros + c-neutralize-syntax-in-and-mark-CPP c-change-expand-fl-region) - c++ '(c-neutralize-syntax-in-and-mark-CPP + c++ '(c-depropertize-new-text + c-extend-font-lock-region-for-macros +; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. + c-before-after-change-digit-quote + c-after-change-re-mark-raw-strings + c-neutralize-syntax-in-and-mark-CPP c-restore-<>-properties c-change-expand-fl-region) - java '(c-restore-<>-properties + java '(c-depropertize-new-text + c-restore-<>-properties c-change-expand-fl-region) - awk 'c-awk-extend-and-syntax-tablify-region) + awk '(c-depropertize-new-text + c-awk-extend-and-syntax-tablify-region)) (c-lang-defvar c-before-font-lock-functions (let ((fs (c-lang-const c-before-font-lock-functions))) (if (listp fs) @@ -1230,6 +1248,14 @@ operators." (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) +(c-lang-defconst c-:$-multichar-token-regexp + ;; Regexp matching all tokens ending in ":" which are longer than one char. + ;; Currently (2016-01-07) only used in C++ Mode. + t (c-make-keywords-re nil + (c-filter-ops (c-lang-const c-operators) t ".+:$"))) +(c-lang-defvar c-:$-multichar-token-regexp + (c-lang-const c-:$-multichar-token-regexp)) + (c-lang-defconst c-<>-multichar-token-regexp ;; Regexp matching all tokens containing "<" or ">" which are longer ;; than one char. @@ -1307,6 +1333,14 @@ operators." (c-lang-defvar c-stmt-delim-chars-with-comma (c-lang-const c-stmt-delim-chars-with-comma)) +(c-lang-defconst c-pack-ops + "Ops which signal C++11's \"parameter pack\"" + t nil + c++ '("...")) +(c-lang-defconst c-pack-key + t (c-make-keywords-re 'appendable (c-lang-const c-pack-ops))) +(c-lang-defvar c-pack-key (c-lang-const c-pack-key)) + (c-lang-defconst c-auto-ops ;; Ops which signal C++11's new auto uses. t nil @@ -1322,6 +1356,33 @@ operators." (c-lang-defconst c-haskell-op-re t (c-make-keywords-re nil (c-lang-const c-haskell-op))) (c-lang-defvar c-haskell-op-re (c-lang-const c-haskell-op-re)) + +(c-lang-defconst c-pre-start-tokens + "List of operators following which an apparent declaration \(e.g. +\"t1 *fn (t2 *b);\") is most likely to be an actual declaration +\(as opposed to an arithmetic expression)." + t '(";" "{" "}")) +(c-lang-defvar c-pre-start-tokens (c-lang-const c-pre-start-tokens)) + +(c-lang-defconst c-pre-lambda-tokens + "List of tokens which may precede a lambda declaration. +In C++ this is something like \"[a,b] (foo, bar) -> int { ... };\". +Currently (2016-08) only used in C++ mode." + t (c--set-difference + (c--delete-duplicates + (append (c-lang-const c-operator-list) + (c-lang-const c-other-op-syntax-tokens))) + (append + '("#" "%:" "??=" "##" "%:%:" "??=??=" "::" "." "->" + "]" "<:" ":>" "??(" "??)" "??-" "new" "delete" + ")" ".*" "->*" "??'" "??!" "??!??!" "??!=" "??'=") + '("<%" "%>" "<:" ":>" "%:" "%:%:" "#" "##" "::" "...")) + :test #'string-equal)) + +(c-lang-defconst c-pre-lambda-tokens-re + ;; Regexp matching any token in the list `c-pre-lambda-tokens'. + t (regexp-opt (c-lang-const c-pre-lambda-tokens))) +(c-lang-defvar c-pre-lambda-tokens-re (c-lang-const c-pre-lambda-tokens-re)) ;;; Syntactic whitespace. @@ -1713,6 +1774,16 @@ the appropriate place for that." "array" "float" "function" "int" "mapping" "mixed" "multiset" "object" "program" "string" "this_program" "void")) +(c-lang-defconst c-return-kwds + "Keywords which return a value to the calling function." + t '("return") + idl nil) + +(c-lang-defconst c-return-key + ;; Adorned regexp matching `c-return-kwds'. + t (c-make-keywords-re t (c-lang-const c-return-kwds))) +(c-lang-defvar c-return-key (c-lang-const c-return-key)) + (c-lang-defconst c-primitive-type-key ;; An adorned regexp that matches `c-primitive-type-kwds'. t (c-make-keywords-re t (c-lang-const c-primitive-type-kwds))) @@ -1775,7 +1846,7 @@ but they don't build a type of themselves. Unlike the keywords on not the type face." t nil c '("const" "restrict" "volatile") - c++ '("const" "constexpr" "noexcept" "volatile" "throw" "final" "override") + c++ '("const" "noexcept" "volatile" "throw") objc '("const" "volatile")) (c-lang-defconst c-opt-type-modifier-key @@ -1804,6 +1875,18 @@ not the type face." (c-lang-const c-type-modifier-kwds)) :test 'string-equal)) +(c-lang-defconst c-type-decl-suffix-ws-ids-kwds + "\"Identifiers\" that when immediately following a declarator have semantic +effect in the declaration, but are syntactically like whitespace." + t nil + c++ '("final" "override")) + +(c-lang-defconst c-type-decl-suffix-ws-ids-key + ;; An adorned regexp matching `c-type-decl-suffix-ws-ids-kwds'. + t (c-make-keywords-re t (c-lang-const c-type-decl-suffix-ws-ids-kwds))) +(c-lang-defvar c-type-decl-suffix-ws-ids-key + (c-lang-const c-type-decl-suffix-ws-ids-key)) + (c-lang-defconst c-class-decl-kwds "Keywords introducing declarations where the following block (if any) contains another declaration level that should be considered a class. @@ -1977,8 +2060,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', will be handled." t nil (c c++) '("auto" "extern" "inline" "register" "static") - c++ (append '("explicit" "friend" "mutable" "template" "thread_local" - "using" "virtual") + c++ (append '("constexpr" "explicit" "friend" "mutable" "template" + "thread_local" "using" "virtual") (c-lang-const c-modifier-kwds)) objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static") ;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead. @@ -2246,7 +2329,12 @@ contain type identifiers." (c c++) '(;; GCC extension. "__attribute__" ;; MSVC extension. - "__declspec")) + "__declspec") + c++ (append (c-lang-const c-paren-nontype-kwds) '("noexcept"))) + +(c-lang-defconst c-paren-nontype-key + t (c-make-keywords-re t (c-lang-const c-paren-nontype-kwds))) +(c-lang-defvar c-paren-nontype-key (c-lang-const c-paren-nontype-key)) (c-lang-defconst c-paren-type-kwds "Keywords that may be followed by a parenthesis expression containing @@ -2294,6 +2382,15 @@ assumed to be set if this isn't nil." t (c-make-keywords-re t (c-lang-const c-<>-sexp-kwds))) (c-lang-defvar c-opt-<>-sexp-key (c-lang-const c-opt-<>-sexp-key)) +(c-lang-defconst c-inside-<>-type-kwds + "Keywords which, used inside a C++ style template arglist, introduce a type." + t nil + java '("extends" "super")) + +(c-lang-defconst c-inside-<>-type-key + t (c-make-keywords-re t (c-lang-const c-inside-<>-type-kwds))) +(c-lang-defvar c-inside-<>-type-key (c-lang-const c-inside-<>-type-key)) + (c-lang-defconst c-brace-id-list-kwds "Keywords that may be followed by a brace block containing a comma separated list of identifier definitions, i.e. like the list of @@ -2493,6 +2590,41 @@ Note that Java specific rules are currently applied to tell this from (c-lang-defvar c-opt-inexpr-brace-list-key (c-lang-const c-opt-inexpr-brace-list-key)) +(c-lang-defconst c-flat-decl-block-kwds + ;; Keywords that can introduce another declaration level, i.e. where a + ;; following "{" isn't a function block or brace list. Note that, for + ;; historical reasons, `c-decl-block-key' is NOT constructed from this lang + ;; const. + t (c--delete-duplicates + (append (c-lang-const c-class-decl-kwds) + (c-lang-const c-other-block-decl-kwds) + (c-lang-const c-inexpr-class-kwds)) + :test 'string-equal)) + +(c-lang-defconst c-brace-stack-thing-key + ;; Regexp matching any keyword or operator relevant to the brace stack (see + ;; `c-update-brace-stack' in cc-engine.el). + t (c-make-keywords-re 'appendable + (append + (c-lang-const c-flat-decl-block-kwds) + (if (c-lang-const c-recognize-<>-arglists) + '("{" "}" ";" "," ")" ":" "<") + '("{" "}" ";" "," ")" ":"))))) +(c-lang-defvar c-brace-stack-thing-key (c-lang-const c-brace-stack-thing-key)) + +(c-lang-defconst c-brace-stack-no-semi-key + ;; Regexp matching any keyword or operator relevant to the brace stack when + ;; a semicolon is not relevant (see `c-update-brace-stack' in + ;; cc-engine.el). + t (c-make-keywords-re 'appendable + (append + (c-lang-const c-flat-decl-block-kwds) + (if (c-lang-const c-recognize-<>-arglists) + '("{" "}" "<") + '("{" "}"))))) +(c-lang-defvar c-brace-stack-no-semi-key + (c-lang-const c-brace-stack-no-semi-key)) + (c-lang-defconst c-decl-block-key ;; Regexp matching keywords in any construct that contain another ;; declaration level, i.e. that isn't followed by a function block @@ -2915,6 +3047,10 @@ Identifier syntax is in effect when this is matched \(see "\\)" "\\([^=]\\|$\\)") c++ (concat "\\(" + "&&" + "\\|" + "\\.\\.\\." + "\\|" "[*(&]" "\\|" (c-lang-const c-type-decl-prefix-key) @@ -2932,6 +3068,28 @@ Identifier syntax is in effect when this is matched \(see (c-lang-defvar c-type-decl-prefix-key (c-lang-const c-type-decl-prefix-key) 'dont-doc) +(c-lang-defconst c-type-decl-operator-prefix-key + "Regexp matching any declarator operator which isn't a keyword +that might precede the identifier in a declaration, e.g. the +\"*\" in \"char *argv\". The end of the first submatch is taken +as the end of the operator. Identifier syntax is in effect when +this is matched \(see `c-identifier-syntax-table')." + t ;; Default to a regexp that never matches. + "\\<\\>" + ;; Check that there's no "=" afterwards to avoid matching tokens + ;; like "*=". + (c objc) (concat "\\(\\*\\)" + "\\([^=]\\|$\\)") + c++ (concat "\\(" + "\\.\\.\\." + "\\|" + "\\*" + "\\)" + "\\([^=]\\|$\\)") + pike "\\(\\*\\)\\([^=]\\|$\\)") +(c-lang-defvar c-type-decl-operator-prefix-key + (c-lang-const c-type-decl-operator-prefix-key)) + (c-lang-defconst c-type-decl-suffix-key "Regexp matching the declarator operators that might follow after the identifier in a declaration, e.g. the \"[\" in \"char argv[]\". This @@ -3061,7 +3219,7 @@ is in effect or not." (c-lang-defconst c-special-brace-lists "List of open- and close-chars that makes up a pike-style brace list, -i.e. for a ([ ]) list there should be a cons (?\\[ . ?\\]) in this +i.e., for a ([ ]) list there should be a cons (?\\[ . ?\\]) in this list." t nil pike '((?{ . ?}) (?\[ . ?\]) (?< . ?>))) @@ -3073,6 +3231,13 @@ list." c t) (c-lang-defvar c-recognize-knr-p (c-lang-const c-recognize-knr-p)) +(c-lang-defconst c-pre-id-bracelist-key + "A regexp matching tokens which, preceding an identifier, signify a bracelist. +" + t "\\<\\>" + c++ "new\\([^[:alnum:]_$]\\|$\\)\\|&&?\\(\\S.\\|$\\)") +(c-lang-defvar c-pre-id-bracelist-key (c-lang-const c-pre-id-bracelist-key)) + (c-lang-defconst c-recognize-typeless-decls "Non-nil means function declarations without return type should be recognized. That can introduce an ambiguity with parenthesized macro @@ -3210,8 +3375,8 @@ i.e. before \":\". Only used if `c-recognize-colon-labels' is set." (append (c-lang-const c-label-kwds) (c-lang-const c-protection-kwds)) :test 'string-equal))) - ;; Don't allow string literals, except in AWK. Character constants are OK. - (c objc java pike idl) (concat "\"\\|" + ;; Don't allow string literals, except in AWK and Java. Character constants are OK. + (c objc pike idl) (concat "\"\\|" (c-lang-const c-nonlabel-token-key)) ;; Also check for open parens in C++, to catch member init lists in ;; constructors. We normally allow it so that macros with arguments diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 9ebe6f79eb3..5b0679ac5b2 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -71,6 +71,19 @@ ;; ;; http://lists.sourceforge.net/mailman/listinfo/cc-mode-announce +;; Externally maintained major modes which use CC-mode's engine include: +;; - cuda-mode +;; - csharp-mode (https://github.com/josteink/csharp-mode) +;; - haxe-mode +;; - d-mode +;; - dart-mode +;; - cc-php-js-cs.el +;; - php-mode +;; - yang-mode +;; - math-mode (mathematica) +;; - unrealscript-mode +;; - groovy-mode + ;;; Code: ;; For Emacs < 22.2. @@ -479,10 +492,15 @@ preferably use the `c-mode-menu' language constant directly." (defvar c-just-done-before-change nil) (make-variable-buffer-local 'c-just-done-before-change) ;; This variable is set to t by `c-before-change' and to nil by -;; `c-after-change'. It is used to detect a spurious invocation of -;; `before-change-functions' directly following on from a correct one. This -;; happens in some Emacsen, for example when `basic-save-buffer' does (insert -;; ?\n) when `require-final-newline' is non-nil. +;; `c-after-change'. It is used for two purposes: (i) to detect a spurious +;; invocation of `before-change-functions' directly following on from a +;; correct one. This happens in some Emacsen, for example when +;; `basic-save-buffer' does (insert ?\n) when `require-final-newline' is +;; non-nil; (ii) to detect when Emacs fails to invoke +;; `before-change-functions'. This can happen when reverting a buffer - see +;; bug #24094. It seems these failures happen only in GNU Emacs; XEmacs +;; seems to maintain the strict alternation of calls to +;; `before-change-functions' and `after-change-functions'. (defun c-basic-common-init (mode default-style) "Do the necessary initialization for the syntax handling routines @@ -539,6 +557,8 @@ that requires a literal mode spec at compile time." ;; Initialize the cache of brace pairs, and opening braces/brackets/parens. (c-state-cache-init) + ;; Initialize the "brace stack" cache. + (c-init-bs-cache) (when (or c-recognize-<>-arglists (c-major-mode-is 'awk-mode) @@ -652,6 +672,14 @@ that requires a literal mode spec at compile time." (make-variable-buffer-local 'c-new-BEG) (defvar c-new-END 0) (make-variable-buffer-local 'c-new-END) +;; The following two variables record the values of `c-new-BEG' and +;; `c-new-END' just after `c-new-END' has been adjusted for the length of text +;; inserted or removed. They may be read by any after-change function (but +;; should not be altered by one). +(defvar c-old-BEG 0) +(make-variable-buffer-local 'c-old-BEG) +(defvar c-old-END 0) +(make-variable-buffer-local 'c-old-END) (defun c-common-init (&optional mode) "Common initialization for all CC Mode modes. @@ -685,9 +713,8 @@ compatible with old code; callers should always specify it." (funcall fn (point-min) (point-max))) c-get-state-before-change-functions) (mapc (lambda (fn) - (if (not (eq fn 'c-restore-<>-properties)) - (funcall fn (point-min) (point-max) - (- (point-max) (point-min))))) + (funcall fn (point-min) (point-max) + (- (point-max) (point-min)))) c-before-font-lock-functions)))) (set (make-local-variable 'outline-regexp) "[^#\n\^M]") @@ -853,14 +880,6 @@ Note that the style variables are always made local to the buffer." ;;; Change hooks, linking with Font Lock and electric-indent-mode. -;; Buffer local variables recording Beginning/End-of-Macro position before a -;; change, when a macro straddles, respectively, the BEG or END (or both) of -;; the change region. Otherwise these have the values BEG/END. -(defvar c-old-BOM 0) -(make-variable-buffer-local 'c-old-BOM) -(defvar c-old-EOM 0) -(make-variable-buffer-local 'c-old-EOM) - (defun c-called-from-text-property-change-p () ;; Is the primitive which invoked `before-change-functions' or ;; `after-change-functions' one which merely changes text properties? This @@ -873,9 +892,42 @@ Note that the style variables are always made local to the buffer." (memq (cadr (backtrace-frame 3)) '(put-text-property remove-list-of-text-properties))) +(defun c-depropertize-CPP (beg end) + ;; Remove the punctuation syntax-table text property from the CPP parts of + ;; (c-new-BEG c-new-END). + ;; + ;; This function is in the C/C++/ObjC values of + ;; `c-get-state-before-change-functions' and is called exclusively as a + ;; before change function. + (c-save-buffer-state (m-beg ss-found) + (goto-char c-new-BEG) + (while (and (< (point) beg) + (search-forward-regexp c-anchored-cpp-prefix beg 'bound)) + (goto-char (match-beginning 1)) + (setq m-beg (point)) + (c-end-of-macro) + (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) + + (while (and (< (point) end) + (setq ss-found + (search-forward-regexp c-anchored-cpp-prefix end 'bound))) + (goto-char (match-beginning 1)) + (setq m-beg (point)) + (c-end-of-macro)) + (if (and ss-found (> (point) end)) + (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) + + (while (and (< (point) c-new-END) + (search-forward-regexp c-anchored-cpp-prefix c-new-END 'bound)) + (goto-char (match-beginning 1)) + (setq m-beg (point)) + (c-end-of-macro) + (c-clear-char-property-with-value + m-beg (point) 'syntax-table '(1))))) + (defun c-extend-region-for-CPP (beg end) - ;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the - ;; beginning/end of any preprocessor construct they may be in. + ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of + ;; any preprocessor construct they may be in. ;; ;; Point is undefined both before and after this function call; the buffer ;; has already been widened, and match-data saved. The return value is @@ -884,45 +936,56 @@ Note that the style variables are always made local to the buffer." ;; This function is in the C/C++/ObjC values of ;; `c-get-state-before-change-functions' and is called exclusively as a ;; before change function. - (goto-char beg) + (goto-char c-new-BEG) (c-beginning-of-macro) - (setq c-old-BOM (point)) + (when (< (point) c-new-BEG) + (setq c-new-BEG (max (point) (c-determine-limit 500 c-new-BEG)))) - (goto-char end) + (goto-char c-new-END) (when (c-beginning-of-macro) (c-end-of-macro) (or (eobp) (forward-char))) ; Over the terminating NL which may be marked ; with a c-cpp-delimiter category property - (setq c-old-EOM (point))) - -(defun c-extend-font-lock-region-for-macros (begg endd &optional old-len) - ;; Extend the region (BEGG ENDD) to cover all (possibly changed) - ;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should - ;; be either the old length parameter when called from an - ;; after-change-function, or nil otherwise. This defun uses the variables - ;; c-old-BOM, c-new-BOM. + (when (> (point) c-new-END) + (setq c-new-END (min (point) (c-determine-+ve-limit 500 c-new-END))))) + +(defun c-depropertize-new-text (beg end old-len) + ;; Remove from the new text in (BEG END) any and all text properties which + ;; might interfere with CC Mode's proper working. + ;; + ;; This function is called exclusively as an after-change function. It + ;; appears in the value (for all languages) of + ;; `c-before-font-lock-functions'. The value of point is undefined both on + ;; entry and exit, and the return value has no significance. The parameters + ;; BEG, END, and OLD-LEN are the standard ones supplied to all after-change + ;; functions. + (c-save-buffer-state () + (when (> end beg) + (c-clear-char-properties beg end 'syntax-table) + (c-clear-char-properties beg end 'category) + (c-clear-char-properties beg end 'c-is-sws) + (c-clear-char-properties beg end 'c-in-sws) + (c-clear-char-properties beg end 'c-type) + (c-clear-char-properties beg end 'c-awk-NL-prop)))) + +(defun c-extend-font-lock-region-for-macros (begg endd old-len) + ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed) + ;; preprocessor macros; The return value has no significance. ;; ;; Point is undefined on both entry and exit to this function. The buffer ;; will have been widened on entry. - (let (limits new-beg new-end) - (goto-char c-old-BOM) ; already set to old start of macro or begg. - (setq new-beg - (min begg - (if (setq limits (c-state-literal-at (point))) - (cdr limits) ; go forward out of any string or comment. - (point)))) - - (goto-char endd) - (if (setq limits (c-state-literal-at (point))) - (goto-char (car limits))) ; go backward out of any string or comment. - (if (c-beginning-of-macro) - (c-end-of-macro)) - (setq new-end (max endd - (if old-len - (+ (- c-old-EOM old-len) (- endd begg)) - c-old-EOM) - (point))) - (cons new-beg new-end))) + ;; + ;; c-new-BEG has already been extended in `c-extend-region-for-CPP' so we + ;; don't need to repeat the exercise here. + ;; + ;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'. + (goto-char endd) + (when (c-beginning-of-macro) + (c-end-of-macro) + ;; Determine the region, (c-new-BEG c-new-END), which will get font + ;; locked. This restricts the region should there be long macros. + (setq c-new-END (min (max c-new-END (point)) + (c-determine-+ve-limit 500 c-new-END))))) (defun c-neutralize-CPP-line (beg end) ;; BEG and END bound a region, typically a preprocessor line. Put a @@ -951,19 +1014,14 @@ Note that the style variables are always made local to the buffer." (t nil))))))) (defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) - ;; (i) Extend the font lock region to cover all changed preprocessor - ;; regions; it does this by setting the variables `c-new-BEG' and - ;; `c-new-END' to the new boundaries. - ;; - ;; (ii) "Neutralize" every preprocessor line wholly or partially in the - ;; extended changed region. "Restore" lines which were CPP lines before the - ;; change and are no longer so; these can be located from the Buffer local - ;; variables `c-old-BOM' and `c-old-EOM'. + ;; (i) "Neutralize" every preprocessor line wholly or partially in the + ;; changed region. "Restore" lines which were CPP lines before the change + ;; and are no longer so. ;; - ;; (iii) Mark every CPP construct by placing a `category' property value + ;; (ii) Mark each CPP construct by placing a `category' property value ;; `c-cpp-delimiter' at its start and end. The marked characters are the ;; opening # and usually the terminating EOL, but sometimes the character - ;; before a comment/string delimiter. + ;; before a comment delimiter. ;; ;; That is, set syntax-table properties on characters that would otherwise ;; interact syntactically with those outside the CPP line(s). @@ -980,16 +1038,9 @@ Note that the style variables are always made local to the buffer." ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!! ;; ;; This function might make hidden buffer changes. - (c-save-buffer-state (new-bounds) - ;; First determine the region, (c-new-BEG c-new-END), which will get font - ;; locked. It might need "neutralizing". This region may not start - ;; inside a string, comment, or macro. - (setq new-bounds (c-extend-font-lock-region-for-macros - c-new-BEG c-new-END old-len)) - (setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg)) - c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd))) - ;; Clear all old relevant properties. - (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) + (c-save-buffer-state (limits) + ;; Clear 'syntax-table properties "punctuation": + ;; (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) ;; CPP "comment" markers: (if (eval-when-compile (memq 'category-properties c-emacs-features));Emacs. @@ -999,6 +1050,8 @@ Note that the style variables are always made local to the buffer." ;; Add needed properties to each CPP construct in the region. (goto-char c-new-BEG) + (if (setq limits (c-literal-limits)) ; Go past any literal. + (goto-char (cdr limits))) (skip-chars-backward " \t") (let ((pps-position (point)) pps-state mbeg) (while (and (< (point) c-new-END) @@ -1018,7 +1071,7 @@ Note that the style variables are always made local to the buffer." (nth 4 pps-state)))) ; in a comment? (goto-char (match-beginning 1)) (setq mbeg (point)) - (if (> (c-syntactic-end-of-macro) mbeg) + (if (> (c-no-comment-end-of-macro) mbeg) (progn (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties (if (eval-when-compile @@ -1027,6 +1080,102 @@ Note that the style variables are always made local to the buffer." (forward-line)) ; no infinite loop with, e.g., "#//" ))))) +(defun c-before-after-change-digit-quote (beg end &optional old-len) + ;; This function either removes or applies the punctuation value ('(1)) of + ;; the `syntax-table' text property on single quote marks which are + ;; separator characters in long integer literals, e.g. "4'294'967'295". It + ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it + ;; should also apply to binary literals.) + ;; + ;; In both uses of the function, the `syntax-table' properties are + ;; removed/applied only on quote marks which appear to be digit separators. + ;; + ;; Point is undefined on both entry and exit to this function, and the + ;; return value has no significance. The function is called solely as a + ;; before-change function (see `c-get-state-before-change-functions') and as + ;; an after change function (see `c-before-font-lock-functions', with the + ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard + ;; values for before/after-change functions. + (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end) + (goto-char c-new-END) + (when (looking-at "\\(x\\)?[0-9a-fA-F']+") + (setq c-new-END (match-end 0))) + (goto-char c-new-BEG) + (when (looking-at "\\(x?\\)[0-9a-fA-F']") + (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t) + (setq c-new-BEG (point)))) + + (while + (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t) + (setq try-end (1- (point))) + (re-search-backward "[^0-9a-fA-F']" num-begin t) + (setq digit-re + (cond + ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x ?X))) + "[0-9a-fA-F]") + ((and (eq (char-after (1+ (point))) ?0) + (memq (char-after (+ 2 (point))) '(?b ?B))) + "[01]") + ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + "[0-9]") + (t nil))) + (when digit-re + (cond ((eq (char-after) ?x) (forward-char)) + ((looking-at ".?0[Bb]") (goto-char (match-end 0))) + ((looking-at digit-re)) + (t (forward-char))) + (when (not (c-in-literal)) + (let ((num-end ; End of valid sequence of digits/quotes. + (save-excursion + (re-search-forward + (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t) + (point)))) + (setq try-end ; End of sequence of digits/quotes + (save-excursion + (re-search-forward + (concat "\\=\\(" digit-re "\\|'\\)+") nil t) + (point))) + (while (re-search-forward + (concat digit-re "\\('\\)" digit-re) num-end t) + (if old-len ; i.e. are we in an after-change function? + (c-put-char-property (match-beginning 1) 'syntax-table '(1)) + (c-clear-char-property (match-beginning 1) 'syntax-table)) + (backward-char))))) + (goto-char try-end) + (setq num-begin (point))))) + +;; The following doesn't seem needed at the moment (2016-08-15). +;; (defun c-before-after-change-extend-region-for-lambda-capture +;; (_beg _end &optional _old-len) +;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any lambda +;; ;; function capture lists we happen to be inside. This function is expected +;; ;; to be called both as a before-change and after change function. +;; ;; +;; ;; Note that these things _might_ be nested, with a capture list looking +;; ;; like: +;; ;; +;; ;; [ ...., &foo = [..](){...}(..), ... ] +;; ;; +;; ;; . What a wonderful language is C++. ;-) +;; (c-save-buffer-state (paren-state pos) +;; (goto-char c-new-BEG) +;; (setq paren-state (c-parse-state)) +;; (while (setq pos (c-pull-open-brace paren-state)) +;; (goto-char pos) +;; (when (c-looking-at-c++-lambda-capture-list) +;; (setq c-new-BEG (min c-new-BEG pos)) +;; (if (c-go-list-forward) +;; (setq c-new-END (max c-new-END (point)))))) + +;; (goto-char c-new-END) +;; (setq paren-state (c-parse-state)) +;; (while (setq pos (c-pull-open-brace paren-state)) +;; (goto-char pos) +;; (when (c-looking-at-c++-lambda-capture-list) +;; (setq c-new-BEG (min c-new-BEG pos)) +;; (if (c-go-list-forward) +;; (setq c-new-END (max c-new-END (point)))))))) + (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls ;; the language dependent `c-get-state-before-change-functions'. It is @@ -1141,10 +1290,22 @@ Note that the style variables are always made local to the buffer." ;; This calls the language variable c-before-font-lock-functions, if non nil. ;; This typically sets `syntax-table' properties. + ;; We can sometimes get two consecutive calls to `after-change-functions' + ;; without an intervening call to `before-change-functions' when reverting + ;; the buffer (see bug #24094). Whatever the cause, assume that the entire + ;; buffer has changed. + (when (not c-just-done-before-change) + (save-restriction + (widen) + (c-before-change (point-min) (point-max)) + (setq beg (point-min) + end (point-max) + old-len (- end beg)))) + ;; (c-new-BEG c-new-END) will be the region to fontify. It may become ;; larger than (beg end). - ;; (setq c-new-BEG beg c-new-END end) (setq c-new-END (- (+ c-new-END (- end beg)) old-len)) + (setq c-old-BEG c-new-BEG c-old-END c-new-END) (unless (c-called-from-text-property-change-p) (setq c-just-done-before-change nil) @@ -1192,28 +1353,41 @@ Note that the style variables are always made local to the buffer." (defun c-fl-decl-start (pos) ;; If the beginning of the line containing POS is in the middle of a "local" - ;; declaration (i.e. one which does not start outside of braces enclosing - ;; POS, such as a struct), return the beginning of that declaration. - ;; Otherwise return nil. Note that declarations, in this sense, can be - ;; nested. + ;; declaration, return the beginning of that declaration. Otherwise return + ;; nil. Note that declarations, in this sense, can be nested. (A local + ;; declaration is one which does not start outside of struct braces (and + ;; similar) enclosing POS. Brace list braces here are not "similar". ;; ;; This function is called indirectly from font locking stuff - either from ;; c-after-change (to prepare for after-change font-locking) or from font ;; lock context (etc.) fontification. - (let ((lit-limits (c-literal-limits)) + (let ((lit-start (c-literal-start)) (new-pos pos) + capture-opener bod-lim bo-decl) (goto-char (c-point 'bol new-pos)) - (when lit-limits ; Comment or string. - (goto-char (car lit-limits))) + (when lit-start ; Comment or string. + (goto-char lit-start)) (setq bod-lim (c-determine-limit 500)) + ;; In C++ Mode, first check if we are within a (possibly nested) lambda + ;; form capture list. + (when (c-major-mode-is 'c++-mode) + (let ((paren-state (c-parse-state)) + opener) + (save-excursion + (while (setq opener (c-pull-open-brace paren-state)) + (goto-char opener) + (if (c-looking-at-c++-lambda-capture-list) + (setq capture-opener (point))))))) + (while ;; Go to a less nested declaration each time round this loop. (and - (eq (car (c-beginning-of-decl-1 bod-lim)) 'same) + (c-syntactic-skip-backward "^;{}" bod-lim t) (> (point) bod-lim) - (progn (setq bo-decl (point)) + (progn (c-forward-syntactic-ws) + (setq bo-decl (point)) ;; Are we looking at a keyword such as "template" or ;; "typedef" which can decorate a type, or the type itself? (when (or (looking-at c-prefix-spec-kwds-re) @@ -1230,12 +1404,19 @@ Note that the style variables are always made local to the buffer." (and (eq (char-before) ?\<) (eq (c-get-char-property (1- (point)) 'syntax-table) - c-<-as-paren-syntax))))) + c-<-as-paren-syntax)) + (and (eq (char-before) ?{) + (save-excursion + (backward-char) + (consp (c-looking-at-or-maybe-in-bracelist)))) + ))) (not (bobp))) (backward-char)) ; back over (, [, <. + (when (and capture-opener (< capture-opener new-pos)) + (setq new-pos capture-opener)) (and (/= new-pos pos) new-pos))) -(defun c-change-expand-fl-region (beg end old-len) +(defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock ;; region. This will usually be the smallest sequence of whole lines ;; containing `c-new-BEG' and `c-new-END', but if `c-new-BEG' is in a @@ -1244,10 +1425,15 @@ Note that the style variables are always made local to the buffer." ;; ;; This is called from an after-change-function, but the parameters BEG END ;; and OLD-LEN are not used. - (if font-lock-mode - (setq c-new-BEG - (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) - c-new-END (c-point 'bonl c-new-END)))) + (if font-lock-mode + (setq c-new-BEG + (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) + c-new-END + (save-excursion + (goto-char c-new-END) + (if (bolp) + (point) + (c-point 'bonl c-new-END)))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a @@ -1457,7 +1643,8 @@ This function is called from `c-common-init', once per mode initialization." ;;;###autoload (add-to-list 'auto-mode-alist '("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.\\(CC?\\|HH?\\)\\'" . c++-mode)) -;;;###autoload (add-to-list 'auto-mode-alist '("\\.[ch]\\'" . c-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.c\\'" . c-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-mode)) ;; NB: The following two associate yacc and lex files to C Mode, which ;; is not really suitable for those formats. Anyway, afaik there's @@ -1487,19 +1674,50 @@ initialization, then `c-mode-hook'. Key bindings: \\{c-mode-map}" + :after-hook (progn (c-make-noise-macro-regexps) + (c-make-macro-with-semi-re) + (c-update-modeline)) (c-initialize-cc-mode t) - (set-syntax-table c-mode-syntax-table) - (setq local-abbrev-table c-mode-abbrev-table - abbrev-mode t) - (use-local-map c-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'c-mode) - (c-make-noise-macro-regexps) - (c-make-macro-with-semi-re) ; matches macro names whose expansion ends with ; (c-common-init 'c-mode) (easy-menu-add c-c-menu) (cc-imenu-init cc-imenu-c-generic-expression) - (c-run-mode-hooks 'c-mode-common-hook 'c-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) + +(defconst c-or-c++-mode--regexp + (eval-when-compile + (let ((id "[a-zA-Z0-9_]+") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*")) + (concat "^" ws-maybe "\\(?:" + "using" ws "\\(?:namespace" ws "std;\\|std::\\)" + "\\|" "namespace" "\\(:?" ws id "\\)?" ws-maybe "{" + "\\|" "class" ws id ws-maybe "[:{\n]" + "\\|" "template" ws-maybe "<.*>" + "\\|" "#include" ws-maybe "<\\(?:string\\|iostream\\|map\\)>" + "\\)"))) + "A regexp applied to C header files to check if they are really C++.") + +;;;###autoload +(defun c-or-c++-mode () + "Analyse buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-mode' or `c++-mode'." + (if (save-excursion + (save-restriction + (save-match-data + (widen) + (goto-char (point-min)) + (re-search-forward c-or-c++-mode--regexp + (+ (point) c-guess-region-max) t)))) + (c++-mode) + (c-mode))) ;; Support for C++ @@ -1543,19 +1761,16 @@ initialization, then `c++-mode-hook'. Key bindings: \\{c++-mode-map}" + :after-hook (progn (c-make-noise-macro-regexps) + (c-make-macro-with-semi-re) + (c-update-modeline)) (c-initialize-cc-mode t) - (set-syntax-table c++-mode-syntax-table) - (setq local-abbrev-table c++-mode-abbrev-table - abbrev-mode t) - (use-local-map c++-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'c++-mode) - (c-make-noise-macro-regexps) - (c-make-macro-with-semi-re) ; matches macro names whose expansion ends with ; (c-common-init 'c++-mode) (easy-menu-add c-c++-menu) (cc-imenu-init cc-imenu-c++-generic-expression) - (c-run-mode-hooks 'c-mode-common-hook 'c++-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; Support for Objective-C @@ -1597,19 +1812,16 @@ initialization, then `objc-mode-hook'. Key bindings: \\{objc-mode-map}" + :after-hook (progn (c-make-noise-macro-regexps) + (c-make-macro-with-semi-re) + (c-update-modeline)) (c-initialize-cc-mode t) - (set-syntax-table objc-mode-syntax-table) - (setq local-abbrev-table objc-mode-abbrev-table - abbrev-mode t) - (use-local-map objc-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'objc-mode) - (c-make-noise-macro-regexps) - (c-make-macro-with-semi-re) ; matches macro names whose expansion ends with ; (c-common-init 'objc-mode) (easy-menu-add c-objc-menu) (cc-imenu-init nil 'cc-imenu-objc-function) - (c-run-mode-hooks 'c-mode-common-hook 'objc-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; Support for Java @@ -1659,17 +1871,14 @@ initialization, then `java-mode-hook'. Key bindings: \\{java-mode-map}" + :after-hook (c-update-modeline) (c-initialize-cc-mode t) - (set-syntax-table java-mode-syntax-table) - (setq local-abbrev-table java-mode-abbrev-table - abbrev-mode t) - (use-local-map java-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'java-mode) (c-common-init 'java-mode) (easy-menu-add c-java-menu) (cc-imenu-init cc-imenu-java-generic-expression) - (c-run-mode-hooks 'c-mode-common-hook 'java-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; Support for CORBA's IDL language @@ -1708,16 +1917,13 @@ initialization, then `idl-mode-hook'. Key bindings: \\{idl-mode-map}" + :after-hook (c-update-modeline) (c-initialize-cc-mode t) - (set-syntax-table idl-mode-syntax-table) - (setq local-abbrev-table idl-mode-abbrev-table) - (use-local-map idl-mode-map) (c-init-language-vars-for 'idl-mode) (c-common-init 'idl-mode) (easy-menu-add c-idl-menu) ;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO - (c-run-mode-hooks 'c-mode-common-hook 'idl-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; Support for Pike @@ -1760,17 +1966,14 @@ initialization, then `pike-mode-hook'. Key bindings: \\{pike-mode-map}" + :after-hook (c-update-modeline) (c-initialize-cc-mode t) - (set-syntax-table pike-mode-syntax-table) - (setq local-abbrev-table pike-mode-abbrev-table - abbrev-mode t) - (use-local-map pike-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'pike-mode) (c-common-init 'pike-mode) (easy-menu-add c-pike-menu) ;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO - (c-run-mode-hooks 'c-mode-common-hook 'pike-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; Support for AWK @@ -1789,9 +1992,9 @@ Key bindings: (defvar awk-mode-map (let ((map (c-make-inherited-keymap))) ;; Add bindings which are only useful for awk. - (define-key map "#" 'self-insert-command) - (define-key map "/" 'self-insert-command) - (define-key map "*" 'self-insert-command) + (define-key map "#" 'self-insert-command);Overrides electric parent binding. + (define-key map "/" 'self-insert-command);Overrides electric parent binding. + (define-key map "*" 'self-insert-command);Overrides electric parent binding. (define-key map "\C-c\C-n" 'undefined) ; #if doesn't exist in awk. (define-key map "\C-c\C-p" 'undefined) (define-key map "\C-c\C-u" 'undefined) @@ -1824,22 +2027,18 @@ initialization, then `awk-mode-hook'. Key bindings: \\{awk-mode-map}" + :after-hook (c-update-modeline) ;; We need the next line to stop the macro defining ;; `awk-mode-syntax-table'. This would mask the real table which is ;; declared in cc-awk.el and hasn't yet been loaded. :syntax-table nil (require 'cc-awk) ; Added 2003/6/10. (c-initialize-cc-mode t) - (set-syntax-table awk-mode-syntax-table) - (setq local-abbrev-table awk-mode-abbrev-table - abbrev-mode t) - (use-local-map awk-mode-map) + (setq abbrev-mode t) (c-init-language-vars-for 'awk-mode) (c-common-init 'awk-mode) (c-awk-unstick-NL-prop) - - (c-run-mode-hooks 'c-mode-common-hook 'awk-mode-hook) - (c-update-modeline)) + (c-run-mode-hooks 'c-mode-common-hook)) ;; bug reporting diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a6957185a2b..7a6f4baaa73 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -229,12 +229,25 @@ See `c-offsets-alist'." (setq offset (cdr offset))) (null offset))))) - +(defun c-string-list-p (val) + "Return non-nil if VAL is a list of strings." + (and + (listp val) + (catch 'string + (dolist (elt val) + (if (not (stringp elt)) + (throw 'string nil))) + t))) + +(defun c-string-or-string-list-p (val) + "Return non-nil if VAL is a string or a list of strings." + (or (stringp val) + (c-string-list-p val))) ;;; User variables (defcustom c-strict-syntax-p nil - "*If non-nil, all syntactic symbols must be found in `c-offsets-alist'. + "If non-nil, all syntactic symbols must be found in `c-offsets-alist'. If the syntactic symbol for a particular line does not match a symbol in the offsets alist, or if no non-nil offset value can be determined for a symbol, an error is generated, otherwise no error is reported @@ -247,12 +260,12 @@ syntactic symbols in `c-offsets-alist'. Please keep it set to nil." :group 'c) (defcustom c-echo-syntactic-information-p nil - "*If non-nil, syntactic info is echoed when the line is indented." + "If non-nil, syntactic info is echoed when the line is indented." :type 'boolean :group 'c) (defcustom c-report-syntactic-errors nil - "*If non-nil, certain syntactic errors are reported with a ding + "If non-nil, certain syntactic errors are reported with a ding and a message, for example when an \"else\" is indented for which there's no corresponding \"if\". @@ -264,7 +277,7 @@ anchoring position to indent the line in that case." :group 'c) (defcustom-c-stylevar c-basic-offset 4 - "*Amount of basic offset used by + and - symbols in `c-offsets-alist'. + "Amount of basic offset used by + and - symbols in `c-offsets-alist'. Also used as the indentation step when `c-syntactic-indentation' is nil." :type 'integer @@ -273,7 +286,7 @@ nil." (defcustom c-tab-always-indent t - "*Controls the operation of the TAB key. + "Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin or in the line's indentation, otherwise it inserts a `real' tab character \(see @@ -295,7 +308,7 @@ by the `c-comment-only-line-offset' variable." :group 'c) (defcustom c-insert-tab-function 'insert-tab - "*Function used when inserting a tab for \\[c-indent-command]. + "Function used when inserting a tab for \\[c-indent-command]. Only used when `c-tab-always-indent' indicates a `real' tab character should be inserted. Value must be a function taking no arguments. The default, `insert-tab', inserts either a tab or the equivalent @@ -304,7 +317,7 @@ number of spaces depending on the value of `indent-tabs-mode'." :group 'c) (defcustom c-syntactic-indentation t - "*Whether the indentation should be controlled by the syntactic context. + "Whether the indentation should be controlled by the syntactic context. If t, the indentation functions indent according to the syntactic context, using the style settings specified by `c-offsets-alist'. @@ -320,7 +333,7 @@ e.g. `c-special-indent-hook'." (put 'c-syntactic-indentation 'safe-local-variable 'booleanp) (defcustom c-syntactic-indentation-in-macros t - "*Enable syntactic analysis inside macros. + "Enable syntactic analysis inside macros. If this is nil, all lines inside macro definitions are analyzed as `cpp-macro-cont'. Otherwise they are analyzed syntactically, just like normal code, and `cpp-define-intro' is used to create the @@ -339,7 +352,7 @@ better with the \"do { ... } while \(0)\" trick)." (put 'c-syntactic-indentation-in-macros 'safe-local-variable 'booleanp) (defcustom c-defun-tactic 'go-outward - "*Whether functions are recognized inside, e.g., a class. + "Whether functions are recognized inside, e.g., a class. This is used by `c-beginning-of-defun' and like functions. Its value is one of: @@ -354,7 +367,7 @@ Its value is one of: :group 'c) (defcustom-c-stylevar c-comment-only-line-offset 0 - "*Extra offset for line which contains only the start of a comment. + "Extra offset for line which contains only the start of a comment. Can contain an integer or a cons cell of the form: (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) @@ -378,7 +391,7 @@ default)." '((anchored-comment . (column . 0)) (end-block . (space . 1)) (cpp-end-block . (space . 2))) - "*Specifies how \\[indent-for-comment] calculates the comment start column. + "Specifies how \\[indent-for-comment] calculates the comment start column. This is an association list that contains entries of the form: (LINE-TYPE . INDENT-SPEC) @@ -452,7 +465,7 @@ in that case, i.e. as if \\[c-indent-command] was used instead." :group 'c) (defcustom-c-stylevar c-indent-comments-syntactically-p nil - "*Specifies how \\[indent-for-comment] should handle comment-only lines. + "Specifies how \\[indent-for-comment] should handle comment-only lines. When this variable is non-nil, comment-only lines are indented according to syntactic analysis via `c-offsets-alist'. Otherwise, the comment is indented as if it was preceded by code. Note that this @@ -475,7 +488,7 @@ comment-only lines." (if (boundp 'c-comment-continuation-stars) (symbol-value 'c-comment-continuation-stars) "* ") - "*Specifies the line prefix of continued C-style block comments. + "Specifies the line prefix of continued C-style block comments. You should set this variable to the literal string that gets inserted at the front of continued block style comment lines. This should either be the empty string, or some characters without preceding @@ -494,7 +507,7 @@ style comments." '((pike-mode . "//+!?\\|\\**") (awk-mode . "#+") (other . "//+\\|\\**")) - "*Regexp to match the line prefix inside comments. + "Regexp to match the line prefix inside comments. This regexp is used to recognize the fill prefix inside comments for correct paragraph filling and other things. @@ -551,7 +564,7 @@ variable in a mode hook." '((java-mode . javadoc) (pike-mode . autodoc) (c-mode . gtkdoc)) - "*Specifies documentation comment style(s) to recognize. + "Specifies documentation comment style(s) to recognize. This is primarily used to fontify doc comments and the markup within them, e.g. Javadoc comments. @@ -621,7 +634,7 @@ afterwards to redo that work." :group 'c) (defcustom c-ignore-auto-fill '(string cpp code) - "*List of contexts in which automatic filling never occurs. + "List of contexts in which automatic filling never occurs. If Auto Fill mode is active, it will be temporarily disabled if point is in any context on this list. It's e.g. useful to enable Auto Fill in comments only, but not in strings or normal code. The valid @@ -641,7 +654,7 @@ contexts are: :group 'c) (defcustom-c-stylevar c-cleanup-list '(scope-operator) - "*List of various C/C++/ObjC constructs to \"clean up\". + "List of various C/C++/ObjC constructs to \"clean up\". The following clean ups only take place when the auto-newline feature is turned on, as evidenced by the `/la' appearing next to the mode name: @@ -738,7 +751,7 @@ involve auto-newline inserted newlines: (inexpr-class-open after) (inexpr-class-close before) (arglist-cont-nonempty)) - "*Controls the insertion of newlines before and after braces + "Controls the insertion of newlines before and after braces when the auto-newline feature is active. This variable contains an association list with elements of the following form: \(SYNTACTIC-SYMBOL . ACTION). @@ -802,7 +815,7 @@ Zero or nil means no limit." :group 'c) (defcustom-c-stylevar c-hanging-colons-alist nil - "*Controls the insertion of newlines before and after certain colons. + "Controls the insertion of newlines before and after certain colons. This variable contains an association list with elements of the following form: (SYNTACTIC-SYMBOL . ACTION). @@ -825,7 +838,7 @@ currently not supported for this variable." (defcustom-c-stylevar c-hanging-semi&comma-criteria '(c-semi&comma-inside-parenlist) - "*List of functions that decide whether to insert a newline or not. + "List of functions that decide whether to insert a newline or not. The functions in this list are called, in order, whenever the auto-newline minor mode is activated (as evidenced by a `/a' or `/ah' string in the mode line), and a semicolon or comma is typed (see @@ -842,7 +855,7 @@ then no newline is inserted." :group 'c) (defcustom-c-stylevar c-backslash-column 48 - "*Minimum alignment column for line continuation backslashes. + "Minimum alignment column for line continuation backslashes. This is used by the functions that automatically insert or align the line continuation backslashes in multiline macros. If any line in the macro exceeds this column then the next tab stop from that line is @@ -852,7 +865,7 @@ used as alignment column instead. See also `c-backslash-max-column'." ;;;###autoload(put 'c-backslash-column 'safe-local-variable 'integerp) (defcustom-c-stylevar c-backslash-max-column 72 - "*Maximum alignment column for line continuation backslashes. + "Maximum alignment column for line continuation backslashes. This is used by the functions that automatically insert or align the line continuation backslashes in multiline macros. If any line in the macro exceeds this column then the backslashes for the other lines @@ -861,7 +874,7 @@ will be aligned at this column." :group 'c) (defcustom c-auto-align-backslashes t - "*Align automatically inserted line continuation backslashes. + "Align automatically inserted line continuation backslashes. When line continuation backslashes are inserted automatically for line breaks in multiline macros, e.g. by \\[c-context-line-break], they are aligned with the other backslashes in the same macro if this flag is @@ -871,12 +884,12 @@ space." :group 'c) (defcustom c-backspace-function 'backward-delete-char-untabify - "*Function called by `c-electric-backspace' when deleting backwards." + "Function called by `c-electric-backspace' when deleting backwards." :type 'function :group 'c) (defcustom c-delete-function 'delete-char - "*Function called by `c-electric-delete-forward' when deleting forwards." + "Function called by `c-electric-delete-forward' when deleting forwards." :type 'function :group 'c) @@ -888,7 +901,7 @@ space." '((c-mode . t) (c++-mode . t) (objc-mode . t)) - "*Controls whether a final newline is ensured when the file is saved. + "Controls whether a final newline is ensured when the file is saved. The value is an association list that for each language mode specifies the value to give to `require-final-newline' at mode initialization; see that variable for details about the value. If a language isn't @@ -918,20 +931,20 @@ present on the association list, CC Mode won't touch :group 'c) (defcustom c-electric-pound-behavior nil - "*List of behaviors for electric pound insertion. + "List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'." :type '(set (const alignleft)) :group 'c) (defcustom c-special-indent-hook nil - "*Hook for user defined special indentation adjustments. + "Hook for user defined special indentation adjustments. This hook gets called after each line is indented by the mode. It is only called when `c-syntactic-indentation' is non-nil." :type 'hook :group 'c) (defcustom-c-stylevar c-label-minimum-indentation 1 - "*Minimum indentation for lines inside code blocks. + "Minimum indentation for lines inside code blocks. This variable typically only affects code using the `gnu' style, which mandates a minimum of one space in front of every line inside code blocks. Specifically, the function `c-gnu-impose-minimum' on your @@ -940,7 +953,7 @@ blocks. Specifically, the function `c-gnu-impose-minimum' on your :group 'c) (defcustom c-progress-interval 5 - "*Interval used to update progress status during long re-indentation. + "Interval used to update progress status during long re-indentation. If a number, percentage complete gets updated after each interval of that many seconds. To inhibit all messages during indentation, set this variable to nil." @@ -948,7 +961,7 @@ this variable to nil." :group 'c) (defcustom c-objc-method-arg-min-delta-to-bracket 2 - "*Minimum number of chars to the opening bracket. + "Minimum number of chars to the opening bracket. Consider this ObjC snippet: @@ -968,7 +981,7 @@ This behavior can be overridden by customizing the indentation of :group 'c) (defcustom c-objc-method-arg-unfinished-offset 4 - "*Offset relative to bracket if first selector is on a new line. + "Offset relative to bracket if first selector is on a new line. [aaaaaaaaa |<-x->|bbbbbbb: cccccc @@ -977,7 +990,7 @@ This behavior can be overridden by customizing the indentation of :group 'c) (defcustom c-objc-method-parameter-offset 4 - "*Offset for selector parameter on a new line (relative to first selector. + "Offset for selector parameter on a new line (relative to first selector. [aaaaaaa bbbbbbbbbb: |<-x->|cccccccc @@ -988,7 +1001,7 @@ This behavior can be overridden by customizing the indentation of (defcustom c-default-style '((java-mode . "java") (awk-mode . "awk") (other . "gnu")) - "*Style which gets installed by default when a file is visited. + "Style which gets installed by default when a file is visited. The value of this variable can be any style defined in `c-style-alist', including styles you add. The value can also be an @@ -1398,7 +1411,7 @@ Here is the current list of valid syntactic element symbols: do-while-closure else-clause catch-clause inlambda annotation-var-cont)) (defcustom c-style-variables-are-local-p t - "*Whether style variables should be buffer local by default. + "Whether style variables should be buffer local by default. If non-nil, then all indentation style related variables will be made buffer local by default. If nil, they will remain global. Variables are made buffer local when this file is loaded, and once buffer @@ -1429,54 +1442,54 @@ The list of variables to buffer localize are: :group 'c) (defcustom c-mode-hook nil - "*Hook called by `c-mode'." + "Hook called by `c-mode'." :type 'hook :group 'c) (defcustom c++-mode-hook nil - "*Hook called by `c++-mode'." + "Hook called by `c++-mode'." :type 'hook :group 'c) (defcustom objc-mode-hook nil - "*Hook called by `objc-mode'." + "Hook called by `objc-mode'." :type 'hook :group 'c) (defcustom java-mode-hook nil - "*Hook called by `java-mode'." + "Hook called by `java-mode'." :type 'hook :group 'c) (defcustom idl-mode-hook nil - "*Hook called by `idl-mode'." + "Hook called by `idl-mode'." :type 'hook :group 'c) (defcustom pike-mode-hook nil - "*Hook called by `pike-mode'." + "Hook called by `pike-mode'." :type 'hook :group 'c) (defcustom awk-mode-hook nil - "*Hook called by `awk-mode'." + "Hook called by `awk-mode'." :type 'hook :group 'c) (defcustom c-mode-common-hook nil - "*Hook called by all CC Mode modes for common initializations." + "Hook called by all CC Mode modes for common initializations." :type 'hook :group 'c) (defcustom c-initialization-hook nil - "*Hook called when the CC Mode package gets initialized. + "Hook called when the CC Mode package gets initialized. This hook is only run once per Emacs session and can be used as a `load-hook' or in place of using `eval-after-load'." :type 'hook :group 'c) (defcustom c-enable-xemacs-performance-kludge-p nil - "*Enables a XEmacs only hack that may improve speed for some coding styles. + "Enables a XEmacs only hack that may improve speed for some coding styles. For styles that hang top-level opening braces (as is common with JDK Java coding styles) this can improve performance between 3 and 60 times for core indentation functions (e.g. `c-parse-state'). For @@ -1486,8 +1499,8 @@ This variable only has effect in XEmacs." :type 'boolean :group 'c) -(defvar c-old-style-variable-behavior nil - "*Enables the old style variable behavior when non-nil. +(defcustom c-old-style-variable-behavior nil + "Enables the old style variable behavior when non-nil. Normally the values of the style variables will override the style settings specified by the variables `c-default-style' and @@ -1500,7 +1513,9 @@ It's believed that despite this change, the new behavior will still produce the same results for most old CC Mode configurations, since all style variables are per default set in a special non-override state. Set this variable only if your configuration has stopped -working due to this change.") +working due to this change." + :type 'boolean + :group 'c) (define-widget 'c-extra-types-widget 'radio "Internal CC Mode widget for the `*-font-lock-extra-types' variables." @@ -1619,8 +1634,8 @@ names).")) :type 'c-extra-types-widget :group 'c) -(defvar c-noise-macro-with-parens-name-re nil) -(defvar c-noise-macro-name-re nil) +(defvar c-noise-macro-with-parens-name-re "\\<\\>") +(defvar c-noise-macro-name-re "\\<\\>") (defcustom c-noise-macro-names nil "A list of names of macros which expand to nothing, or compiler extensions @@ -1630,9 +1645,10 @@ identifiers. If you change this variable's value, call the function `c-make-noise-macro-regexps' to set the necessary internal variables (or do -this implicitly by reinitialising C/C++/Objc Mode on any buffer)." +this implicitly by reinitializing C/C++/Objc Mode on any buffer)." :type '(repeat :tag "List of names" string) :group 'c) +(put 'c-noise-macro-names 'safe-local-variable #'c-string-list-p) (defcustom c-noise-macro-with-parens-names nil "A list of names of macros \(or compiler extensions like \"__attribute__\") @@ -1640,6 +1656,7 @@ which optionally have arguments in parentheses, and which expand to nothing. These are recognized by CC Mode only in declarations." :type '(regexp :tag "List of names (possibly empty)" string) :group 'c) +(put 'c-noise-macro-with-parens-names 'safe-local-variable #'c-string-list-p) (defun c-make-noise-macro-regexps () ;; Convert `c-noise-macro-names' and `c-noise-macro-with-parens-names' into @@ -1685,11 +1702,10 @@ the regular expression must match only valid identifiers. If you change this variable's value, call the function `c-make-macros-with-semi-re' to set the necessary internal -variables. - -Note that currently \(2008-11-04) this variable is a prototype, -and is likely to disappear or change its form soon.") +variables.") (make-variable-buffer-local 'c-macro-names-with-semicolon) +(put 'c-macro-names-with-semicolon 'safe-local-variable + #'c-string-or-string-list-p) (defun c-make-macro-with-semi-re () ;; Convert `c-macro-names-with-semicolon' into the regexp diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index b7ab408f744..f2e397a4136 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -161,6 +161,13 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?: [0-9]+\\)?:\\)?\\)" 2 (3 . 4) (5 . 6) (7)) + (cmake + "^CMake \\(?:Error\\|\\(Warning\\)\\) at \\(.*\\):\\([1-9][0-9]*\\) ([^)]+):$" + 2 3 nil (1)) + (cmake-info + "^ \\(?: \\*\\)?\\(.*\\):\\([1-9][0-9]*\\) ([^)]+)$" + 1 2 nil 0) + (comma "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) @@ -1736,7 +1743,7 @@ Returns the compilation buffer created." (funcall compilation-process-setup-function)) (and outwin (compilation-set-window-height outwin)) ;; Start the compilation. - (if (fboundp 'start-process) + (if (fboundp 'make-process) (let ((proc (if (eq mode t) ;; comint uses `start-file-process'. @@ -2753,7 +2760,9 @@ FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME). In the former case, FILENAME may be relative or absolute. The file-structure looks like this: - ((FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)" + ((FILENAME [TRUE-DIRNAME]) FMT ...) + +TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." (or (gethash file compilation-locs) ;; File was not previously encountered, at least not in the form passed. ;; Let's normalize it and look again. @@ -2808,7 +2817,7 @@ The file-structure looks like this: (let ((fs (compilation-get-file-structure file))) (cl-assert (eq fs (gethash file compilation-locs))) (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs))) - compilation-locs))) + compilation-locs))) (maphash (lambda (k v) (if (eq v fs) (remhash k compilation-locs))) compilation-locs))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index de546f7c1d4..9658b8b9280 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -202,7 +202,7 @@ (defcustom cperl-extra-newline-before-brace nil - "*Non-nil means that if, elsif, while, until, else, for, foreach + "Non-nil means that if, elsif, while, until, else, for, foreach and do constructs look like: if () @@ -218,13 +218,13 @@ instead of: (defcustom cperl-extra-newline-before-brace-multiline cperl-extra-newline-before-brace - "*Non-nil means the same as `cperl-extra-newline-before-brace', but + "Non-nil means the same as `cperl-extra-newline-before-brace', but for constructs with multiline if/unless/while/until/for/foreach condition." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-indent-level 2 - "*Indentation of CPerl statements with respect to containing block." + "Indentation of CPerl statements with respect to containing block." :type 'integer :group 'cperl-indentation-details) @@ -242,52 +242,52 @@ for constructs with multiline if/unless/while/until/for/foreach condition." ;;;###autoload(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) (defcustom cperl-lineup-step nil - "*`cperl-lineup' will always lineup at multiple of this number. + "`cperl-lineup' will always lineup at multiple of this number. If nil, the value of `cperl-indent-level' will be used." :type '(choice (const nil) integer) :group 'cperl-indentation-details) (defcustom cperl-brace-imaginary-offset 0 - "*Imagined indentation of a Perl open brace that actually follows a statement. + "Imagined indentation of a Perl open brace that actually follows a statement. An open brace following other text is treated as if it were this far to the right of the start of its line." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-brace-offset 0 - "*Extra indentation for braces, compared with other text in same context." + "Extra indentation for braces, compared with other text in same context." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-label-offset -2 - "*Offset of CPerl label lines relative to usual indentation." + "Offset of CPerl label lines relative to usual indentation." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-min-label-indent 1 - "*Minimal offset of CPerl label lines." + "Minimal offset of CPerl label lines." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-continued-statement-offset 2 - "*Extra indent for lines not starting new statements." + "Extra indent for lines not starting new statements." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-continued-brace-offset 0 - "*Extra indent for substatements that start with open-braces. + "Extra indent for substatements that start with open-braces. This is in addition to cperl-continued-statement-offset." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-close-paren-offset -1 - "*Extra indent for substatements that start with close-parenthesis." + "Extra indent for substatements that start with close-parenthesis." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-indent-wrt-brace t - "*Non-nil means indent statements in if/etc block relative brace, not if/etc. + "Non-nil means indent statements in if/etc block relative brace, not if/etc. Versions 5.2 ... 5.20 behaved as if this were nil." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-auto-newline nil - "*Non-nil means automatically newline before and after braces, + "Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in CPerl code. The following \\[cperl-electric-backspace] will remove the inserted whitespace. Insertion after colons requires both this variable and @@ -296,43 +296,43 @@ Insertion after colons requires both this variable and :group 'cperl-autoinsert-details) (defcustom cperl-autoindent-on-semi nil - "*Non-nil means automatically indent after insertion of (semi)colon. + "Non-nil means automatically indent after insertion of (semi)colon. Active if `cperl-auto-newline' is false." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-auto-newline-after-colon nil - "*Non-nil means automatically newline even after colons. + "Non-nil means automatically newline even after colons. Subject to `cperl-auto-newline' setting." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-tab-always-indent t - "*Non-nil means TAB in CPerl mode should always reindent the current line, + "Non-nil means TAB in CPerl mode should always reindent the current line, regardless of where in the line point is when the TAB command is used." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-font-lock nil - "*Non-nil (and non-null) means CPerl buffers will use `font-lock-mode'. + "Non-nil (and non-null) means CPerl buffers will use `font-lock-mode'. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-electric-lbrace-space nil - "*Non-nil (and non-null) means { after $ should be preceded by ` '. + "Non-nil (and non-null) means { after $ should be preceded by ` '. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-electric-parens-string "({[]})<" - "*String of parentheses that should be electric in CPerl. + "String of parentheses that should be electric in CPerl. Closing ones are electric only if the region is highlighted." :type 'string :group 'cperl-affected-by-hairy) (defcustom cperl-electric-parens nil - "*Non-nil (and non-null) means parentheses should be electric in CPerl. + "Non-nil (and non-null) means parentheses should be electric in CPerl. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) @@ -345,20 +345,20 @@ Can be overwritten by `cperl-hairy' if nil." transient-mark-mode) (and (boundp 'zmacs-regions) ; For XEmacs zmacs-regions))) - "*Not-nil means that electric parens look for active mark. + "Not-nil means that electric parens look for active mark. Default is yes if there is visual feedback on mark." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-electric-linefeed nil - "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy. + "If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy. In any case these two mean plain and hairy linefeeds together. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-electric-keywords nil - "*Not-nil (and non-null) means keywords are electric in CPerl. + "Not-nil (and non-null) means keywords are electric in CPerl. Can be overwritten by `cperl-hairy' if nil. Uses `abbrev-mode' to do the expansion. If you want to use your @@ -372,12 +372,12 @@ that begin with \"cperl-electric\". :group 'cperl-affected-by-hairy) (defcustom cperl-electric-backspace-untabify t - "*Not-nil means electric-backspace will untabify in CPerl." + "Not-nil means electric-backspace will untabify in CPerl." :type 'boolean :group 'cperl-autoinsert-details) (defcustom cperl-hairy nil - "*Not-nil means most of the bells and whistles are enabled in CPerl. + "Not-nil means most of the bells and whistles are enabled in CPerl. Affects: `cperl-font-lock', `cperl-electric-lbrace-space', `cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords', `cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings', @@ -386,22 +386,22 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space', :group 'cperl-affected-by-hairy) (defcustom cperl-comment-column 32 - "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)." + "Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)." :type 'integer :group 'cperl-indentation-details) (defcustom cperl-indent-comment-at-column-0 nil - "*Non-nil means that comment started at column 0 should be indentable." + "Non-nil means that comment started at column 0 should be indentable." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-vc-sccs-header '("($sccs) = ('%W\ %' =~ /(\\d+(\\.\\d+)+)/) ;") - "*Special version of `vc-sccs-header' that is used in CPerl mode buffers." + "Special version of `vc-sccs-header' that is used in CPerl mode buffers." :type '(repeat string) :group 'cperl) (defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\ $ ' =~ /(\\d+(\\.\\d+)+)/);") - "*Special version of `vc-rcs-header' that is used in CPerl mode buffers." + "Special version of `vc-rcs-header' that is used in CPerl mode buffers." :type '(repeat string) :group 'cperl) @@ -418,43 +418,43 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space', ;; (boundp 'interpreter-mode-alist) ;; (assoc "miniperl" interpreter-mode-alist) ;; (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist))) -;; "*Whether to install us into `interpreter-' and `extension' mode lists." +;; "Whether to install us into `interpreter-' and `extension' mode lists." ;; :type 'boolean ;; :group 'cperl) (defcustom cperl-info-on-command-no-prompt nil - "*Not-nil (and non-null) means not to prompt on C-h f. + "Not-nil (and non-null) means not to prompt on C-h f. The opposite behavior is always available if prefixed with C-c. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-clobber-lisp-bindings nil - "*Not-nil (and non-null) means not overwrite C-h f. + "Not-nil (and non-null) means not overwrite C-h f. The function is available on \\[cperl-info-on-command], \\[cperl-get-help]. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) (defcustom cperl-lazy-help-time nil - "*Not-nil (and non-null) means to show lazy help after given idle time. + "Not-nil (and non-null) means to show lazy help after given idle time. Can be overwritten by `cperl-hairy' to be 5 sec if nil." :type '(choice (const null) (const nil) integer) :group 'cperl-affected-by-hairy) (defcustom cperl-pod-face 'font-lock-comment-face - "*Face for POD highlighting." + "Face for POD highlighting." :type 'face :group 'cperl-faces) (defcustom cperl-pod-head-face 'font-lock-variable-name-face - "*Face for POD highlighting. + "Face for POD highlighting. Font for POD headers." :type 'face :group 'cperl-faces) (defcustom cperl-here-face 'font-lock-string-face - "*Face for here-docs highlighting." + "Face for here-docs highlighting." :type 'face :group 'cperl-faces) @@ -462,23 +462,23 @@ Font for POD headers." (defvar cperl-singly-quote-face (featurep 'xemacs)) (defcustom cperl-invalid-face 'underline - "*Face for highlighting trailing whitespace." + "Face for highlighting trailing whitespace." :type 'face :version "21.1" :group 'cperl-faces) (defcustom cperl-pod-here-fontify '(featurep 'font-lock) - "*Not-nil after evaluation means to highlight POD and here-docs sections." + "Not-nil after evaluation means to highlight POD and here-docs sections." :type 'boolean :group 'cperl-faces) (defcustom cperl-fontify-m-as-s t - "*Not-nil means highlight 1arg regular expressions operators same as 2arg." + "Not-nil means highlight 1arg regular expressions operators same as 2arg." :type 'boolean :group 'cperl-faces) (defcustom cperl-highlight-variables-indiscriminately nil - "*Non-nil means perform additional highlighting on variables. + "Non-nil means perform additional highlighting on variables. Currently only changes how scalar variables are highlighted. Note that that variable is only read at initialization time for the variable `cperl-font-lock-keywords-2', so changing it after you've @@ -487,125 +487,125 @@ entered CPerl mode the first time will have no effect." :group 'cperl) (defcustom cperl-pod-here-scan t - "*Not-nil means look for POD and here-docs sections during startup. + "Not-nil means look for POD and here-docs sections during startup. You can always make lookup from menu or using \\[cperl-find-pods-heres]." :type 'boolean :group 'cperl-speed) (defcustom cperl-regexp-scan t - "*Not-nil means make marking of regular expression more thorough. + "Not-nil means make marking of regular expression more thorough. Effective only with `cperl-pod-here-scan'." :type 'boolean :group 'cperl-speed) (defcustom cperl-hook-after-change t - "*Not-nil means install hook to know which regions of buffer are changed. + "Not-nil means install hook to know which regions of buffer are changed. May significantly speed up delayed fontification. Changes take effect after reload." :type 'boolean :group 'cperl-speed) (defcustom cperl-imenu-addback nil - "*Not-nil means add backreferences to generated `imenu's. + "Not-nil means add backreferences to generated `imenu's. May require patched `imenu' and `imenu-go'. Obsolete." :type 'boolean :group 'cperl-help-system) (defcustom cperl-max-help-size 66 - "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents." + "Non-nil means shrink-wrapping of info-buffer allowed up to these percents." :type '(choice integer (const nil)) :group 'cperl-help-system) (defcustom cperl-shrink-wrap-info-frame t - "*Non-nil means shrink-wrapping of info-buffer-frame allowed." + "Non-nil means shrink-wrapping of info-buffer-frame allowed." :type 'boolean :group 'cperl-help-system) (defcustom cperl-info-page "perl" - "*Name of the info page containing perl docs. + "Name of the info page containing perl docs. Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) (defcustom cperl-use-syntax-table-text-property (boundp 'parse-sexp-lookup-properties) - "*Non-nil means CPerl sets up and uses `syntax-table' text property." + "Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean :group 'cperl-speed) (defcustom cperl-use-syntax-table-text-property-for-tags cperl-use-syntax-table-text-property - "*Non-nil means: set up and use `syntax-table' text property generating TAGS." + "Non-nil means: set up and use `syntax-table' text property generating TAGS." :type 'boolean :group 'cperl-speed) (defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$" - "*Regexp to match files to scan when generating TAGS." + "Regexp to match files to scan when generating TAGS." :type 'regexp :group 'cperl) (defcustom cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|CVS\\|blib\\)$" - "*Regexp to match files/dirs to skip when generating TAGS." + "Regexp to match files/dirs to skip when generating TAGS." :type 'regexp :group 'cperl) (defcustom cperl-regexp-indent-step nil - "*Indentation used when beautifying regexps. + "Indentation used when beautifying regexps. If nil, the value of `cperl-indent-level' will be used." :type '(choice integer (const nil)) :group 'cperl-indentation-details) (defcustom cperl-indent-left-aligned-comments t - "*Non-nil means that the comment starting in leftmost column should indent." + "Non-nil means that the comment starting in leftmost column should indent." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-under-as-char nil - "*Non-nil means that the _ (underline) should be treated as word char." + "Non-nil means that the _ (underline) should be treated as word char." :type 'boolean :group 'cperl) (make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4") (defcustom cperl-extra-perl-args "" - "*Extra arguments to use when starting Perl. + "Extra arguments to use when starting Perl. Currently used with `cperl-check-syntax' only." :type 'string :group 'cperl) (defcustom cperl-message-electric-keyword t - "*Non-nil means that the `cperl-electric-keyword' prints a help message." + "Non-nil means that the `cperl-electric-keyword' prints a help message." :type 'boolean :group 'cperl-help-system) (defcustom cperl-indent-region-fix-constructs 1 - "*Amount of space to insert between `}' and `else' or `elsif' + "Amount of space to insert between `}' and `else' or `elsif' in `cperl-indent-region'. Set to nil to leave as is. Values other than 1 and nil will probably not work." :type '(choice (const nil) (const 1)) :group 'cperl-indentation-details) (defcustom cperl-break-one-line-blocks-when-indent t - "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs + "Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs need to be reformatted into multiline ones when indenting a region." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-fix-hanging-brace-when-indent t - "*Non-nil means that BLOCK-end `}' may be put on a separate line + "Non-nil means that BLOCK-end `}' may be put on a separate line when indenting a region. Braces followed by else/elsif/while/until are excepted." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-merge-trailing-else t - "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue + "Non-nil means that BLOCK-end `}' followed by else/elsif/continue may be merged to be on the same line when indenting a region." :type 'boolean :group 'cperl-indentation-details) (defcustom cperl-indent-parens-as-block nil - "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks, + "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks, but for trailing \",\" inside the group, which won't increase indentation. One should tune up `cperl-close-paren-offset' as well." :type 'boolean @@ -614,20 +614,20 @@ One should tune up `cperl-close-paren-offset' as well." (defcustom cperl-syntaxify-by-font-lock (and cperl-can-font-lock (boundp 'parse-sexp-lookup-properties)) - "*Non-nil means that CPerl uses the `font-lock' routines for syntaxification." + "Non-nil means that CPerl uses the `font-lock' routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) (defcustom cperl-syntaxify-unwind t - "*Non-nil means that CPerl unwinds to a start of a long construction + "Non-nil means that CPerl unwinds to a start of a long construction when syntaxifying a chunk of buffer." :type 'boolean :group 'cperl-speed) (defcustom cperl-syntaxify-for-menu t - "*Non-nil means that CPerl syntaxifies up to the point before showing menu. + "Non-nil means that CPerl syntaxifies up to the point before showing menu. This way enabling/disabling of menu items is more correct." :type 'boolean :group 'cperl-speed) @@ -2304,7 +2304,7 @@ to nil." (memq this-command '(self-insert-command newline)))) head1 notlast name p really-delete over) (and (save-excursion - (forward-word -1) + (forward-word-strictly -1) (and (eq (preceding-char) ?=) (progn @@ -2327,7 +2327,7 @@ to nil." (progn (insert "\n\n=cut") (cperl-ensure-newlines 2) - (forward-word -2) + (forward-word-strictly -2) (if (and head1 (not (save-excursion @@ -2335,7 +2335,7 @@ to nil." (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>" nil t)))) ; Only one (progn - (forward-word 1) + (forward-word-strictly 1) (setq name (file-name-base) p (point)) (insert " NAME\n\n" name @@ -2343,10 +2343,10 @@ to nil." "=head1 DESCRIPTION") (cperl-ensure-newlines 4) (goto-char p) - (forward-word 2) + (forward-word-strictly 2) (end-of-line) (setq really-delete t)) - (forward-word 1)))) + (forward-word-strictly 1)))) (if over (progn (setq p (point)) @@ -2354,7 +2354,7 @@ to nil." "=back") (cperl-ensure-newlines 2) (goto-char p) - (forward-word 1) + (forward-word-strictly 1) (end-of-line) (setq really-delete t))) (if (and delete really-delete) @@ -2480,7 +2480,7 @@ If in POD, insert appropriate lines." (if (and over (progn (forward-paragraph -1) - (forward-word 1) + (forward-word-strictly 1) (setq pos (point)) (setq cut (buffer-substring (point) (point-at-eol))) (delete-char (- (point-at-eol) (point))) @@ -2531,7 +2531,7 @@ If in POD, insert appropriate lines." ;; and do no indentation for them. (and (eq last-command-event ?:) (save-excursion - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward " \t") (and (< (point) end) (progn (goto-char (- end 1)) @@ -4309,7 +4309,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; Now: tail: if the second part is non-matching without ///e (if (eq (char-syntax (following-char)) ?w) (progn - (forward-word 1) ; skip modifiers s///s + (forward-word-strictly 1) ; skip modifiers s///s (if tail (cperl-commentify tail (point) t)) (cperl-postpone-fontification e1 (point) 'face my-cperl-REx-modifiers-face))) @@ -5110,7 +5110,7 @@ Returns some position at the last line." (if (looking-at "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") (progn - (forward-word 1) + (forward-word-strictly 1) (delete-horizontal-space) (insert (make-string cperl-indent-region-fix-constructs ?\s)) (beginning-of-line))) @@ -5119,7 +5119,7 @@ Returns some position at the last line." (if (looking-at "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") (progn - (forward-word 2) + (forward-word-strictly 2) (delete-horizontal-space) (insert (make-string cperl-indent-region-fix-constructs ?\s)) (beginning-of-line))) @@ -8502,7 +8502,7 @@ the appropriate statement modifier." (insert B " ") (and B-comment (insert B-comment " ")) (just-one-space) - (forward-word 1) + (forward-word-strictly 1) (setq pre-A (point)) (insert " " A ";") (delete-horizontal-space) @@ -8578,7 +8578,7 @@ the appropriate statement modifier." (cperl-perldoc (cperl-word-at-point))) (defcustom pod2man-program "pod2man" - "*File name for `pod2man'." + "File name for `pod2man'." :type 'file :group 'cperl) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 7d641ab47f0..4e029ea6c80 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -104,6 +104,14 @@ Each entry is a list with the following elements: (const :tag "Both branches writable" both)))) :group 'cpp) +(defcustom cpp-message-min-time-interval 1.0 + "Minimum time interval in seconds for `cpp-progress-message' messages. +If nil, `cpp-progress-message' prints no progress messages." + :type '(choice (const :tag "Disable progress messages" nil) + float) + :group 'cpp + :version "26.1") + (defvar cpp-overlay-list nil) ;; List of cpp overlays active in the current buffer. (make-variable-buffer-local 'cpp-overlay-list) @@ -278,7 +286,7 @@ A prefix arg suppresses display of that buffer." (cpp-parse-close from to)) (t (cpp-parse-error "Parser error")))))))) - (message "Parsing...done")) + (cpp-progress-message "Parsing...done")) (if cpp-state-stack (save-excursion (goto-char (nth 3 (car cpp-state-stack))) @@ -819,16 +827,21 @@ BRANCH should be either nil (false branch), t (true branch) or `both'." ;;; Utilities: -(defvar cpp-progress-time 0) -;; Last time we issued a progress message. +(defvar cpp-progress-time 0 + "Last time `cpp-progress-message' issued a progress message.") (defun cpp-progress-message (&rest args) - ;; Report progress at most once a second. Take same ARGS as `message'. - (let ((time (nth 1 (current-time)))) - (if (= time cpp-progress-time) - () - (setq cpp-progress-time time) - (apply 'message args)))) + "Report progress by printing messages used by \"cpp-\" functions. + +Print messages at most once every `cpp-message-min-time-interval' seconds. +If that option is nil, don't prints messages. +ARGS are the same as for `message'." + (when cpp-message-min-time-interval + (let ((time (current-time))) + (when (>= (float-time (time-subtract time cpp-progress-time)) + cpp-message-min-time-interval) + (setq cpp-progress-time time) + (apply 'message args))))) (provide 'cpp) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index ffb93de8062..c4e62683a6a 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1191,7 +1191,7 @@ Elements of ALIST that are not conses are ignored." "Translate an EBNF to a syntactic chart on PostScript." :prefix "ebnf-" :version "20" - :group 'wp + :group 'text :group 'postscript) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8f0b4f13b9e..d6f26795132 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -452,7 +452,13 @@ It can be quoted, or be inside a quoted form." ((facep sym) (find-definition-noselect sym 'defface))))) (defun elisp-completion-at-point () - "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." + "Function used for `completion-at-point-functions' in `emacs-lisp-mode'. +If the context at point allows only a certain category of +symbols (e.g. functions, or variables) then the returned +completions are restricted to that category. In contexts where +any symbol is possible (following a quote, for example), +functions are annotated with \"<f>\" via the +`:annotation-function' property." (with-syntax-table emacs-lisp-mode-syntax-table (let* ((pos (point)) (beg (condition-case nil @@ -533,9 +539,9 @@ It can be quoted, or be inside a quoted form." (delete-dups ;; FIXME: We should include some ;; docstring with each entry. - (append - macro-declarations-alist - defun-declarations-alist))))) + (append macro-declarations-alist + defun-declarations-alist + nil))))) ; Copy both alists. ((and (or `condition-case `condition-case-unless-debug) (guard (save-excursion (ignore-errors @@ -572,7 +578,7 @@ It can be quoted, or be inside a quoted form." " " (cadr table-etc))) (cddr table-etc))))))))) -(defun lisp-completion-at-point (_predicate) +(defun lisp-completion-at-point (&optional _predicate) (declare (obsolete elisp-completion-at-point "25.1")) (elisp-completion-at-point)) @@ -712,7 +718,10 @@ non-nil result supercedes the xrefs produced by (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly (specializers (cl--generic-method-specializers method)) (non-default nil) - (met-name (cons symbol specializers)) + (met-name (cl--generic-load-hist-format + symbol + (cl--generic-method-qualifiers method) + specializers)) (file (find-lisp-object-file-name met-name 'cl-defmethod))) (dolist (item specializers) ;; default method has all 't' in specializers @@ -823,8 +832,9 @@ non-nil result supercedes the xrefs produced by (pcase-let (((cl-struct xref-elisp-location symbol type file) l)) (let ((buffer-point (find-function-search-for-symbol symbol type file))) (with-current-buffer (car buffer-point) - (goto-char (or (cdr buffer-point) (point-min))) - (point-marker))))) + (save-excursion + (goto-char (or (cdr buffer-point) (point-min))) + (point-marker)))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) (xref-elisp-location-file l)) @@ -1051,6 +1061,17 @@ If CHAR is not a character, return nil." ((or (eq (following-char) ?\') (eq (preceding-char) ?\')) (setq left-quote ?\`))) + + ;; When after a named character literal, skip over the entire + ;; literal, not only its last word. + (when (= (preceding-char) ?}) + (let ((begin (save-excursion + (backward-char) + (skip-syntax-backward "w-") + (backward-char 3) + (when (looking-at-p "\\\\N{") (point))))) + (when begin (goto-char begin)))) + (forward-sexp -1) ;; If we were after `?\e' (or similar case), ;; use the whole thing, not just the `e'. @@ -1554,7 +1575,8 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ARGLIST is either a string, or a list of strings or symbols." (let ((str (cond ((stringp arglist) arglist) ((not (listp arglist)) nil) - (t (help--make-usage-docstring 'toto arglist))))) + (t (substitute-command-keys + (help--make-usage-docstring 'toto arglist)))))) (if (and str (string-match "\\`([^ )]+ ?" str)) (replace-match "(" t t str) str))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index a2a0df2d6e1..c72f0616b10 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -33,8 +33,9 @@ ;;;###autoload (defvar tags-file-name nil "File name of tags table. -To switch to a new tags table, setting this variable is sufficient. -If you set this variable, do not also set `tags-table-list'. +To switch to a new tags table, do not set this variable; instead, +invoke `visit-tags-table', which is the only reliable way of +setting the value of this variable, whether buffer-local or global. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. ;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) @@ -288,7 +289,8 @@ FILE should be the name of a file created with the `etags' program. A directory name is ok too; it means file TAGS in that directory. Normally \\[visit-tags-table] sets the global value of `tags-file-name'. -With a prefix arg, set the buffer-local value instead. +With a prefix arg, set the buffer-local value instead. When called +from Lisp, if the optional arg LOCAL is non-nil, set the local value. When you find a tag with \\[find-tag], the buffer it finds the tag in is given a local value of this variable which is the name of the tags file the tag was in." @@ -304,19 +306,28 @@ file the tag was in." ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will ;; initialize a buffer for FILE and set tags-file-name to the ;; fully-expanded name. - (let ((tags-file-name file)) + (let ((tags-file-name file) + (cbuf (current-buffer))) (save-excursion (or (visit-tags-table-buffer file) - (signal 'file-error (list "Visiting tags table" - "No such file or directory" - file))) - ;; Set FILE to the expanded name. - (setq file tags-file-name))) + (signal 'file-missing (list "Visiting tags table" + "No such file or directory" + file))) + ;; Set FILE to the expanded name. Do that in the buffer we + ;; started from, because visit-tags-table-buffer switches + ;; buffers after updating tags-file-name, so if tags-file-name + ;; is local in the buffer we started, that value is only visible + ;; in that buffer. + (setq file (with-current-buffer cbuf tags-file-name)))) (if local - ;; Set the local value of tags-file-name. - (set (make-local-variable 'tags-file-name) file) + (progn + ;; Force recomputation of tags-completion-table. + (setq-local tags-completion-table nil) + ;; Set the local value of tags-file-name. + (setq-local tags-file-name file)) ;; Set the global value of tags-file-name. - (setq-default tags-file-name file))) + (setq-default tags-file-name file) + (setq tags-completion-table nil))) (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." @@ -540,17 +551,21 @@ Returns nil when out of tables." (setq tags-file-name (car tags-table-list-pointer)))) ;;;###autoload -(defun visit-tags-table-buffer (&optional cont) +(defun visit-tags-table-buffer (&optional cont cbuf) "Select the buffer containing the current tags table. -If optional arg is a string, visit that file as a tags table. -If optional arg is t, visit the next table in `tags-table-list'. -If optional arg is the atom `same', don't look for a new table; +Optional arg CONT specifies which tags table to visit. +If CONT is a string, visit that file as a tags table. +If CONT is t, visit the next table in `tags-table-list'. +If CONT is the atom `same', don't look for a new table; just select the buffer visiting `tags-file-name'. -If arg is nil or absent, choose a first buffer from information in +If CONT is nil or absent, choose a first buffer from information in `tags-file-name', `tags-table-list', `tags-table-list-pointer'. +Optional second arg CBUF, if non-nil, specifies the initial buffer, +which is important if that buffer has a local value of `tags-file-name'. Returns t if it visits a tags table, or nil if there are no more in the list." ;; Set tags-file-name to the tags table file we want to visit. + (if cbuf (set-buffer cbuf)) (cond ((eq cont 'same) ;; Use the ambient value of tags-file-name. (or tags-file-name @@ -752,28 +767,33 @@ Assumes the tags table is the current buffer." (or tags-included-tables (setq tags-included-tables (funcall tags-included-tables-function)))) -(defun tags-completion-table () - "Build `tags-completion-table' on demand. +(defun tags-completion-table (&optional buf) + "Build `tags-completion-table' on demand for a buffer's tags tables. +Optional argument BUF specifies the buffer for which to build +\`tags-completion-table', and defaults to the current buffer. The tags included in the completion table are those in the current -tags table and its (recursively) included tags tables." - (or tags-completion-table - ;; No cached value for this buffer. - (condition-case () - (let (tables cont) - (message "Making tags completion table for %s..." buffer-file-name) - (save-excursion - ;; Iterate over the current list of tags tables. - (while (visit-tags-table-buffer cont) - ;; Find possible completions in this table. - (push (funcall tags-completion-table-function) tables) - (setq cont t))) - (message "Making tags completion table for %s...done" - buffer-file-name) - ;; Cache the result in a buffer-local variable. - (setq tags-completion-table - (nreverse (delete-dups (apply #'nconc tables))))) - (quit (message "Tags completion table construction aborted.") - (setq tags-completion-table nil))))) +tags table for BUF and its (recursively) included tags tables." + (if (not buf) (setq buf (current-buffer))) + (with-current-buffer buf + (or tags-completion-table + ;; No cached value for this buffer. + (condition-case () + (let (tables cont) + (message "Making tags completion table for %s..." + buffer-file-name) + (save-excursion + ;; Iterate over the current list of tags tables. + (while (visit-tags-table-buffer cont buf) + ;; Find possible completions in this table. + (push (funcall tags-completion-table-function) tables) + (setq cont t))) + (message "Making tags completion table for %s...done" + buffer-file-name) + ;; Cache the result in a variable. + (setq tags-completion-table + (nreverse (delete-dups (apply #'nconc tables))))) + (quit (message "Tags completion table construction aborted.") + (setq tags-completion-table nil)))))) ;;;###autoload (defun tags-lazy-completion-table () @@ -784,7 +804,9 @@ tags table and its (recursively) included tags tables." ;; If we need to ask for the tag table, allow that. (let ((enable-recursive-minibuffers t)) (visit-tags-table-buffer)) - (complete-with-action action (tags-completion-table) string pred)))))) + (complete-with-action action + (tags-completion-table buf) + string pred)))))) ;;;###autoload (defun tags-completion-at-point-function () ;;;###autoload (if (or tags-table-list tags-file-name) @@ -1084,6 +1106,7 @@ error message." (case-fold-search (if (memq tags-case-fold-search '(nil t)) tags-case-fold-search case-fold-search)) + (cbuf (current-buffer)) ) (save-excursion @@ -1104,8 +1127,7 @@ error message." (catch 'qualified-match-found ;; Iterate over the list of tags tables. - (while (or first-table - (visit-tags-table-buffer t)) + (while (or first-table (visit-tags-table-buffer t cbuf)) (and first-search first-table ;; Start at beginning of tags file. @@ -1707,25 +1729,26 @@ if the file was newly read in, the value is the filename." ((eq initialize t) ;; Initialize the list from the tags table. (save-excursion - ;; Visit the tags table buffer to get its list of files. - (visit-tags-table-buffer) - ;; Copy the list so we can setcdr below, and expand the file - ;; names while we are at it, in this buffer's default directory. - (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) - ;; Iterate over all the tags table files, collecting - ;; a complete list of referenced file names. - (while (visit-tags-table-buffer t) - ;; Find the tail of the working list and chain on the new - ;; sublist for this tags table. - (let ((tail next-file-list)) - (while (cdr tail) - (setq tail (cdr tail))) - ;; Use a copy so the next loop iteration will not modify the - ;; list later returned by (tags-table-files). - (if tail - (setcdr tail (mapcar 'expand-file-name (tags-table-files))) - (setq next-file-list (mapcar 'expand-file-name - (tags-table-files)))))))) + (let ((cbuf (current-buffer))) + ;; Visit the tags table buffer to get its list of files. + (visit-tags-table-buffer) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t cbuf) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail next-file-list)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (if tail + (setcdr tail (mapcar 'expand-file-name (tags-table-files))) + (setq next-file-list (mapcar 'expand-file-name + (tags-table-files))))))))) (t ;; Initialize the list by evalling the argument. (setq next-file-list (eval initialize)))) @@ -1880,8 +1903,6 @@ Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. -Fifth and sixth arguments START and END are accepted, for compatibility -with `query-replace-regexp', and ignored. If FILE-LIST-FORM is non-nil, it is a form to evaluate to produce the list of files to search. @@ -1923,8 +1944,9 @@ directory specification." (princ (substitute-command-keys "':\n\n")) (save-excursion (let ((first-time t) - (gotany nil)) - (while (visit-tags-table-buffer (not first-time)) + (gotany nil) + (cbuf (current-buffer))) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (if (funcall list-tags-function file) (setq gotany t))) @@ -1947,8 +1969,9 @@ directory specification." (tags-with-face 'highlight (princ regexp)) (princ (substitute-command-keys "':\n\n")) (save-excursion - (let ((first-time t)) - (while (visit-tags-table-buffer (not first-time)) + (let ((first-time t) + (cbuf (current-buffer))) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) @@ -2109,9 +2132,10 @@ for \\[find-tag] (which see)." (marks (make-hash-table :test 'equal)) (case-fold-search (if (memq tags-case-fold-search '(nil t)) tags-case-fold-search - case-fold-search))) + case-fold-search)) + (cbuf (current-buffer))) (save-excursion - (while (visit-tags-table-buffer (not first-time)) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (dolist (order-fun (cond (regexp? find-tag-regexp-tag-order) (t etags-xref-find-definitions-tag-order))) @@ -2146,8 +2170,9 @@ for \\[find-tag] (which see)." (with-slots (tag-info file) l (let ((buffer (find-file-noselect file))) (with-current-buffer buffer - (etags-goto-tag-location tag-info) - (point-marker))))) + (save-excursion + (etags-goto-tag-location tag-info) + (point-marker)))))) (cl-defmethod xref-location-line ((l xref-etags-location)) (with-slots (tag-info) l diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 588f4d99d78..d9a34720046 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -895,8 +895,10 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ;; This is for a TYPE block, not a variable of derived TYPE. ;; Hence no need to add CLASS for F2003. +;; Note that this also matches "type is", so you might need to use +;; f90-typeis-re as well. (defconst f90-type-def-re - ;; type word + ;; type word (includes "type is") ;; type :: word ;; type, attr-list :: word ;; where attr-list = attr [, attr ...] @@ -953,7 +955,7 @@ Used in the F90 entry in `hs-special-modes-alist'.") ;; Avoid F2003 "type is" in "select type", ;; and also variables of derived type "type (foo)". ;; "type, foo" must be a block (?). - "type[ \t,]\\(" + "\\(?:type\\|class\\)[ \t,]\\(" "[^i(!\n\"& \t]\\|" ; not-i( "i[^s!\n\"& \t]\\|" ; i not-s "is\\(?:\\sw\\|\\s_\\)\\)\\|" @@ -1452,6 +1454,7 @@ if all else fails." (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ \\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\ +\\(?:class\\|type\\)[ \t]*is\\|\ block\\|critical\\|enum\\|associate\\)\\_>") (looking-at "\\(program\\|\\(?:sub\\)?module\\|\ \\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>") @@ -2355,7 +2358,8 @@ CHANGE-WORD should be one of `upcase-word', `downcase-word', `capitalize-word'." (setq ref-point (point) ;; FIXME this does not work for constructs with ;; embedded space, eg "sync all". - back-point (save-excursion (backward-word 1) (point)) + back-point (save-excursion (backward-word-strictly 1) + (point)) saveword (buffer-substring back-point ref-point)) (funcall change-word -1) (or (string= saveword (buffer-substring back-point ref-point)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 30c9fed45ca..846ec22dbe3 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -102,6 +102,8 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'." "Enables/disables GUI warnings." :group 'flymake :type 'boolean) +(make-obsolete-variable 'flymake-gui-warnings-enabled + "it no longer has any effect." "26.1") (defcustom flymake-start-syntax-check-on-find-file t "Start syntax check on find file." @@ -1072,6 +1074,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." "flymake-proc" (current-buffer) cmd args)))) (set-process-sentinel process 'flymake-process-sentinel) (set-process-filter process 'flymake-process-filter) + (set-process-query-on-exit-flag process nil) (push process flymake-processes) (setq flymake-is-running t) @@ -1189,15 +1192,17 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-mode-line mode-line) (force-mode-line-update))) -(defun flymake-display-warning (warning) - "Display a warning to user." - (message-box warning)) +;; Nothing in flymake uses this at all any more, so this is just for +;; third-party compatibility. +(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") (defun flymake-report-fatal-status (status warning) "Display a warning and switch flymake mode off." - (when flymake-gui-warnings-enabled - (flymake-display-warning (format "Flymake: %s. Flymake will be switched OFF" warning)) - ) + ;; This first message was always shown by default, and flymake-log + ;; does nothing by default, hence the use of message. + ;; Another option is display-warning. + (if (< flymake-log-level 0) + (message "Flymake: %s. Flymake will be switched OFF" warning)) (flymake-mode 0) (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" (buffer-name) status warning)) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 5ad101df7bf..4f8709a21d7 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -69,12 +69,12 @@ ;; 2) Use MinGW GDB instead. ;; 3) Use cygwin-mount.el -;;; Mac OSX: +;;; macOS: -;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made -;; some changes to the version that they include as part of Mac OSX. -;; This requires GDB version 7.0 or later (estimated release date Aug 2009) -;; as earlier versions do not compile on Mac OSX. +;; GDB in Emacs on macOS works best with FSF GDB as Apple have made +;; some changes to the version that they include as part of macOS. +;; This requires GDB version 7.0 or later as earlier versions do not +;; compile on macOS. ;;; Known Bugs: @@ -673,14 +673,18 @@ NOARG must be t when this macro is used outside `gud-def'" ;;;###autoload (defun gdb (command-line) - "Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger. - -COMMAND-LINE is the shell command for starting the gdb session. -It should be a string consisting of the name of the gdb -executable followed by command line options. The command line -options should include \"-i=mi\" to use gdb's MI text interface. + "Run gdb passing it COMMAND-LINE as arguments. + +If COMMAND-LINE names a program FILE to debug, gdb will run in +a buffer named *gud-FILE*, and the directory containing FILE +becomes the initial working directory and source-file directory +for your debugger. +If COMMAND-LINE requests that gdb attaches to a process PID, gdb +will run in *gud-PID*, otherwise it will run in *gud*; in these +cases the initial working directory is the default-directory of +the buffer in which this command was invoked. + +COMMAND-LINE should include \"-i=mi\" to use gdb's MI text interface. Note that the old \"--annotate\" option is no longer supported. If option `gdb-many-windows' is nil (the default value) then gdb just @@ -1972,6 +1976,7 @@ is running." (not gdb-non-stop)) gud-running) (and gdb-gud-control-all-threads + (not (null gdb-running-threads-count)) (> gdb-running-threads-count 0)))) ;; GUD displays the selected GDB frame. This might might not be the current @@ -2488,7 +2493,9 @@ current thread and update GDB buffers." ;; Reason is available with target-async only (let* ((result (gdb-json-string output-field)) (reason (bindat-get-field result 'reason)) - (thread-id (bindat-get-field result 'thread-id))) + (thread-id (bindat-get-field result 'thread-id)) + (retval (bindat-get-field result 'return-value)) + (varnum (bindat-get-field result 'gdb-result-var))) ;; -data-list-register-names needs to be issued for any stopped ;; thread @@ -2514,6 +2521,15 @@ current thread and update GDB buffers." (if (string-equal reason "exited-normally") (setq gdb-active-process nil)) + (when (and retval varnum + ;; When the user typed CLI commands, GDB/MI helpfully + ;; includes the "Value returned" response in the "~" + ;; record; here we avoid displaying it twice. + (not (string-match "^Value returned is " gdb-filter-output))) + (setq gdb-filter-output + (concat gdb-filter-output + (format "Value returned is %s = %s\n" varnum retval)))) + ;; Select new current thread. ;; Don't switch if we have no reasons selected @@ -2646,8 +2662,15 @@ responses. If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with \"FIX-LIST=[..]\" prior to parsing. This is used to fix broken -break-info output when it contains breakpoint script field -incompatible with GDB/MI output syntax." +incompatible with GDB/MI output syntax. + +If `default-directory' is remote, full file names are adapted accordingly." (save-excursion + (let ((remote (file-remote-p default-directory))) + (when remote + (goto-char (point-min)) + (while (re-search-forward "[\\[,]fullname=\"\\(.+\\)\"" nil t) + (replace-match (concat remote "\\1") nil nil nil 1)))) (goto-char (point-min)) (when fix-key (save-excursion diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 2b44b58f245..5112c6bd638 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -235,7 +235,7 @@ buffer should be saved or not. E.g., one can set this to (lambda () (string-prefix-p my-grep-root (file-truename (buffer-file-name)))) to limit saving to files located under `my-grep-root'." - :version "25.2" + :version "26.1" :type '(choice (const :tag "Ask before saving" ask) (const :tag "Don't save buffers" nil) @@ -543,7 +543,9 @@ This function is called from `compilation-filter-hook'." (let* ((host-id (intern (or (file-remote-p default-directory) "localhost"))) (host-defaults (assq host-id grep-host-defaults-alist)) - (defaults (assq nil grep-host-defaults-alist))) + (defaults (assq nil grep-host-defaults-alist)) + (quot-braces (shell-quote-argument "{}")) + (quot-scolon (shell-quote-argument ";"))) ;; There are different defaults on different hosts. They must be ;; computed for every host once. (dolist (setting '(grep-command grep-template @@ -637,9 +639,8 @@ This function is called from `compilation-filter-hook'." ""))) (cons (if (eq grep-find-use-xargs 'exec-plus) - (format "%s %s{} +" cmd0 null) - (format "%s {} %s%s" cmd0 null - (shell-quote-argument ";"))) + (format "%s %s%s +" cmd0 null quot-braces) + (format "%s %s %s%s" cmd0 quot-braces null quot-scolon)) (1+ (length cmd0))))) (t (format "%s . -type f -print | \"%s\" %s" @@ -655,12 +656,11 @@ This function is called from `compilation-filter-hook'." (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s" find-program xargs-program gcmd)) ((eq grep-find-use-xargs 'exec) - (format "%s <D> <X> -type f <F> -exec %s {} %s%s" - find-program gcmd null - (shell-quote-argument ";"))) + (format "%s <D> <X> -type f <F> -exec %s %s %s%s" + find-program gcmd quot-braces null quot-scolon)) ((eq grep-find-use-xargs 'exec-plus) - (format "%s <D> <X> -type f <F> -exec %s %s{} +" - find-program gcmd null)) + (format "%s <D> <X> -type f <F> -exec %s %s%s +" + find-program gcmd null quot-braces)) (t (format "%s <D> <X> -type f <F> -print | \"%s\" %s" find-program xargs-program gcmd)))))))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 9bf739463ed..0bdafdbac6e 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -733,9 +733,15 @@ It should return a list of completion strings.") ;; The old gdb command (text command mode). The new one is in gdb-mi.el. ;;;###autoload (defun gud-gdb (command-line) - "Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working -directory and source-file directory for your debugger." + "Run gdb passing it COMMAND-LINE as arguments. +If COMMAND-LINE names a program FILE to debug, gdb will run in +a buffer named *gud-FILE*, and the directory containing FILE +becomes the initial working directory and source-file directory +for your debugger. +If COMMAND-LINE requests that gdb attaches to a process PID, gdb +will run in *gud-PID*, otherwise it will run in *gud*; in these +cases the initial working directory is the default-directory of +the buffer in which this command was invoked." (interactive (list (gud-query-cmdline 'gud-gdb))) (when (and gud-comint-buffer @@ -1947,10 +1953,10 @@ the source code display in sync with the debugging session.") PATH gives the directories in which to search for files with extension EXTN. Normally EXTN is given as the regular expression \"\\.java$\" ." - (apply 'nconc (mapcar (lambda (d) - (when (file-directory-p d) - (directory-files d t extn nil))) - path))) + (mapcan (lambda (d) + (when (file-directory-p d) + (directory-files d t extn nil))) + path)) ;; Move point past whitespace. (defun gud-jdb-skip-whitespace () @@ -2561,9 +2567,6 @@ comint mode, which see." :group 'gud :type 'boolean) -(declare-function tramp-file-name-localname "tramp" (vec)) -(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) - ;; Perform initializations common to all debuggers. ;; The first arg is the specified command line, ;; which starts with the program to debug. @@ -2618,13 +2621,8 @@ comint mode, which see." (let ((w args)) (while (and w (not (eq (car w) t))) (setq w (cdr w))) - (if w - (setcar w - (if (file-remote-p file) - ;; Tramp has already been loaded if we are here. - (setq file (tramp-file-name-localname - (tramp-dissect-file-name file))) - file)))) + ;; Tramp has already been loaded if we are here. + (if w (setcar w (setq file (file-local-name file))))) (apply 'make-comint (concat "gud" filepart) program nil (if massage-args (funcall massage-args file args) args)) ;; Since comint clobbered the mode, we don't set it until now. @@ -2852,8 +2850,7 @@ Obeying it means displaying in another window the specified file and line." (frame (or gud-last-frame gud-last-last-frame)) (buffer-file-name-localized (and (buffer-file-name) - (or (file-remote-p (buffer-file-name) 'localname) - (buffer-file-name)))) + (file-local-name (buffer-file-name)))) result) (while (and str (let ((case-fold-search nil)) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 8a87eb9770a..9fbb7d6ad32 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1114,8 +1114,8 @@ preprocessing token" result))) (defun hif-delimit (lis atom) - (nconc (cl-mapcan (lambda (l) (list l atom)) - (butlast lis)) + (nconc (mapcan (lambda (l) (list l atom)) + (butlast lis)) (last lis))) ;; Perform token replacement: @@ -1828,7 +1828,7 @@ This allows #ifdef VAR to be hidden." (let* ((default (save-excursion (beginning-of-line) (cond ((looking-at hif-ifx-else-endif-regexp) - (forward-word 2) + (forward-word-strictly 2) (current-word 'strict)) (t nil)))) diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 7fde29dcf7a..c91f98e3206 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -404,8 +404,8 @@ Returns nil if line starts inside a string, t if in a comment." (ch-syntax (char-syntax ch))) (if (eq ch-syntax ?w) (assoc (buffer-substring - (progn (forward-word -1) (point)) - (progn (forward-word 1) (point))) + (progn (forward-word-strictly -1) (point)) + (progn (forward-word-strictly 1) (point))) icon-resword-alist) (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\# ?\, ?\. ?\n)))))) @@ -431,7 +431,8 @@ Returns nil if line starts inside a string, t if in a comment." ((and (eq (char-syntax (following-char)) ?w) (cdr (assoc (buffer-substring (point) - (save-excursion (forward-word 1) (point))) + (save-excursion (forward-word-strictly 1) + (point))) icon-resword-alist))) 0) (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim)))) @@ -475,7 +476,7 @@ Returns nil if line starts inside a string, t if in a comment." (interactive) (if (not (bobp)) (forward-char -1)) (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move) - (forward-word -1) + (forward-word-strictly -1) (forward-line 1)) (defun indent-icon-exp () diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 0e0714e27ed..d857bfd88c3 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -439,7 +439,7 @@ static char * file[] = { \" \", \" \", \" \"};") - "The Cont icon.") + "The Cont icon.") (defvar idlwave-toolbar-to-here-icon (idlwave-toolbar-make-button @@ -918,7 +918,7 @@ static char * file[] = { (help (aref x 3)) (key (vector 'tool-bar func)) (def (list 'menu-item - "a" + "" func :image (symbol-value icon) :visible show diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index ab87a584bfd..bc607ac4019 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -420,22 +420,22 @@ A value of t means to show all source files." :type 'integer) (defcustom idlwave-library-path nil - "Library path for Windows and MacOS (OS9). Not needed under UNIX. + "Library path for Windows and Mac OS (OS9). Not needed under UNIX. When selecting the directories to scan for IDL user catalog routine info, IDLWAVE can, under UNIX, query the shell for the exact search -path \(the value of !PATH). However, under Windows and MacOS -\(pre-OSX), the IDLWAVE shell does not work. In this case, this -variable can be set to specify the paths where IDLWAVE can find PRO -files. The shell will only be asked for a list of paths when this -variable is nil. The value is a list of directories. A directory +path (the value of !PATH). However, under MS-Windows, the +IDLWAVE shell does not work. In this case, this variable can be +set to specify the paths where IDLWAVE can find PRO files. The +shell will only be asked for a list of paths when this variable +is nil. The value is a list of directories. A directory preceded by a `+' will be searched recursively. If you set this -variable on a UNIX system, the shell will not be queried. See also -`idlwave-system-directory'." +variable on a UNIX system, the shell will not be queried. See +also `idlwave-system-directory'." :group 'idlwave-routine-info :type '(repeat (directory))) (defcustom idlwave-system-directory "" - "The IDL system directory for Windows and MacOS. Not needed under + "The IDL system directory for Windows and Mac OS. Not needed under UNIX. Set this to the value of the `!DIR' system variable in IDL. IDLWAVE uses this to find out which of the library routines belong to the official system library. All files inside the `lib' subdirectory @@ -2118,7 +2118,7 @@ An END token must be preceded by whitespace." (if (not (idlwave-quoted)) (if (save-excursion - (backward-word 1) + (backward-word-strictly 1) (backward-char 1) (looking-at "[ \t\n\f]")) (idlwave-show-begin)))) @@ -2435,13 +2435,13 @@ If prefix ARG < 0 then move forward to enclosing block end." "Go to the beginning of the current block." (interactive) (idlwave-block-jump-out -1 'nomark) - (forward-word 1)) + (forward-word-strictly 1)) (defun idlwave-end-of-block () "Go to the beginning of the current block." (interactive) (idlwave-block-jump-out 1 'nomark) - (backward-word 1)) + (backward-word-strictly 1)) (defun idlwave-forward-block (&optional arg) "Move across next nested block." @@ -3150,12 +3150,12 @@ possibility of unbalanced blocks." (if (>= dir 0) (end-of-line)) ;Make sure we are in current block (if (setq found (idlwave-find-key block-reg dir t unit-limit)) (while (and found (looking-at block-limit)) - (if (>= dir 0) (forward-word 1)) + (if (>= dir 0) (forward-word-strictly 1)) (idlwave-block-jump-out dir t) (setq found (idlwave-find-key block-reg dir t unit-limit)))) (if (not nomark) (push-mark here)) (if (not found) (goto-char unit-limit) - (if (>= dir 0) (forward-word 1))))) + (if (>= dir 0) (forward-word-strictly 1))))) (defun idlwave-min-current-statement-indent (&optional end-reg) "The minimum indent in the current statement." @@ -6325,7 +6325,7 @@ Must accept two arguments: `apos' and `info'.") (is-self (and arrow (save-excursion (goto-char apos) - (forward-word -1) + (forward-word-strictly -1) (let ((case-fold-search t)) (looking-at "self\\>"))))) (force-query idlwave-force-class-query) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1e5cc60ee51..6fff981c6bd 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -62,7 +62,7 @@ (defvar moz-repl-name) (defvar ido-cur-list) (defvar electric-layout-rules) -(declare-function ido-mode "ido") +(declare-function ido-mode "ido" (&optional arg)) (declare-function inferior-moz-process "ext:mozrepl" ()) ;;; Constants @@ -838,7 +838,7 @@ return the name of the function, or t if the name could not be determined. Otherwise, return nil." (cl-assert (looking-at "\\_<function\\_>")) (let ((name t)) - (forward-word) + (forward-word-strictly) (forward-comment most-positive-fixnum) (when (eq (char-after) ?*) (forward-char) @@ -1722,7 +1722,8 @@ This performs fontification according to `js--class-styles'." (eval-when-compile (append "=({[,:;" '(nil)))))) (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "\"/")) - (js-syntax-propertize-regexp end)))))) + (js-syntax-propertize-regexp end))))) + ("\\`\\(#\\)!" (1 "< b"))) (point) end)) (defconst js--prettify-symbols-alist @@ -1744,7 +1745,7 @@ This performs fontification according to `js--class-styles'." "Regular expression matching variable declaration keywords.") (defconst js--indent-operator-re - (concat "[-+*/%<>&^|?:.]\\([^-+*/]\\|$\\)\\|!?=\\|" + (concat "[-+*/%<>&^|?:.]\\([^-+*/.]\\|$\\)\\|!?=\\|" (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") @@ -1757,6 +1758,10 @@ This performs fontification according to `js--class-styles'." (and (js--re-search-backward "[?:{]\\|\\_<case\\_>" nil t) (eq (char-after) ??)))) (not (and + (eq (char-after) ?/) + (save-excursion + (eq (nth 3 (syntax-ppss)) ?/)))) + (not (and (eq (char-after) ?*) ;; Generator method (possibly using computed property). (looking-at (concat "\\* *\\(?:\\[\\|" js--name-re " *(\\)")) @@ -1770,16 +1775,20 @@ This performs fontification according to `js--class-styles'." "Return non-nil if the current line continues an expression." (save-excursion (back-to-indentation) - (or (js--looking-at-operator-p) - (and (js--re-search-backward "\n" nil t) - (progn - (skip-chars-backward " \t") - (or (bobp) (backward-char)) - (and (> (point) (point-min)) - (save-excursion (backward-char) (not (looking-at "[/*]/"))) - (js--looking-at-operator-p) - (and (progn (backward-char) - (not (looking-at "+\\+\\|--\\|/[/*]")))))))))) + (if (js--looking-at-operator-p) + (or (not (memq (char-after) '(?- ?+))) + (progn + (forward-comment (- (point))) + (not (memq (char-before) '(?, ?\[ ?\())))) + (and (js--re-search-backward "\n" nil t) + (progn + (skip-chars-backward " \t") + (or (bobp) (backward-char)) + (and (> (point) (point-min)) + (save-excursion (backward-char) (not (looking-at "[/*]/"))) + (js--looking-at-operator-p) + (and (progn (backward-char) + (not (looking-at "+\\+\\|--\\|/[/*]")))))))))) (defun js--end-of-do-while-loop-p () @@ -1888,9 +1897,11 @@ In particular, return the buffer position of the first `for' kwd." ;; To skip arbitrary expressions we need the parser, ;; so we'll just guess at it. (if (and (> end (point)) ; Not empty literal. - (re-search-forward "[^,]]* \\(for\\) " end t) + (re-search-forward "[^,]]* \\(for\\_>\\)" end t) ;; Not inside comment or string literal. - (not (nth 8 (parse-partial-sexp bracket (point))))) + (let ((status (parse-partial-sexp bracket (point)))) + (and (= 1 (car status)) + (not (nth 8 status))))) (match-beginning 1))))))) (defun js--array-comp-indentation (bracket for-kwd) @@ -2242,7 +2253,7 @@ i.e., customize JSX element indentation with `sgml-basic-offset', "Fill the paragraph with `c-fill-paragraph'." (interactive "*P") (let ((js--filling-paragraph t) - (fill-paragraph-function 'c-fill-paragraph)) + (fill-paragraph-function #'c-fill-paragraph)) (c-fill-paragraph justify))) ;;; Type database and Imenu @@ -3489,6 +3500,7 @@ browser, respectively." (unwind-protect + ;; FIXME: Don't impose IDO on the user. (setq selected-tab-cname (let ((ido-minibuffer-setup-hook (cons #'setup-hook ido-minibuffer-setup-hook))) @@ -3711,9 +3723,9 @@ If one hasn't been set, or if it's stale, prompt for a new one." (define-derived-mode js-mode prog-mode "JavaScript" "Major mode for editing JavaScript." :group 'js - (setq-local indent-line-function 'js-indent-line) - (setq-local beginning-of-defun-function 'js-beginning-of-defun) - (setq-local end-of-defun-function 'js-end-of-defun) + (setq-local indent-line-function #'js-indent-line) + (setq-local beginning-of-defun-function #'js-beginning-of-defun) + (setq-local end-of-defun-function #'js-end-of-defun) (setq-local open-paren-in-column-0-is-defun-start nil) (setq-local font-lock-defaults (list js--font-lock-keywords)) (setq-local syntax-propertize-function #'js-syntax-propertize) @@ -3726,7 +3738,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; Comments (setq-local comment-start "// ") (setq-local comment-end "") - (setq-local fill-paragraph-function 'js-c-fill-paragraph) + (setq-local fill-paragraph-function #'js-c-fill-paragraph) ;; Parse cache (add-hook 'before-change-functions #'js--flush-caches t t) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index ee4b1040566..fb714208294 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -103,7 +103,6 @@ (t (:reverse-video t))) "Face to use for highlighting leading spaces in Font-Lock mode." :group 'makefile) -(define-obsolete-face-alias 'makefile-space-face 'makefile-space "22.1") (defface makefile-targets ;; This needs to go along both with foreground and background colors (i.e. shell) diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el index 913849df324..ea9d400dd9e 100644 --- a/lisp/progmodes/mantemp.el +++ b/lisp/progmodes/mantemp.el @@ -157,8 +157,8 @@ the lines." "^template class [A-z :&*<>~=,0-9+!]*(" nil t nil) (progn (beginning-of-line) - (forward-word 1) - (delete-region (point) (progn (forward-word 1) (point))))))) + (forward-word-strictly 1) + (delete-region (point) (progn (forward-word-strictly 1) (point))))))) (defun mantemp-make-mantemps () "Gathering interface to the functions modifying the buffer." diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 28619a55853..4f223f2f3cc 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -34,31 +34,6 @@ ;;; Code: (require 'comint) -;;; For emacs < 24.3. -(require 'newcomment) -(eval-and-compile - (unless (fboundp 'user-error) - (defalias 'user-error 'error)) - (unless (fboundp 'delete-consecutive-dups) - (defalias 'delete-consecutive-dups 'delete-dups)) - (unless (fboundp 'completion-table-with-cache) - (defun completion-table-with-cache (fun &optional ignore-case) - ;; See eg bug#11906. - (let* (last-arg last-result - (new-fun - (lambda (arg) - (if (and last-arg (string-prefix-p last-arg arg ignore-case)) - last-result - (prog1 - (setq last-result (funcall fun arg)) - (setq last-arg arg)))))) - (completion-table-dynamic new-fun))))) -(eval-when-compile - (unless (fboundp 'setq-local) - (defmacro setq-local (var val) - "Set variable VAR to value VAL in current buffer." - (list 'set (list 'make-local-variable (list 'quote var)) val)))) - (defgroup octave nil "Editing Octave code." :link '(custom-manual "(octave-mode)Top") @@ -605,13 +580,8 @@ Key bindings: (setq-local fill-nobreak-predicate (lambda () (eq (octave-in-string-p) ?'))) - (with-no-warnings - (if (fboundp 'add-function) ; new in 24.4 - (add-function :around (local 'comment-line-break-function) - #'octave--indent-new-comment-line) - (setq-local comment-line-break-function - (apply-partially #'octave--indent-new-comment-line - #'comment-indent-new-line)))) + (add-function :around (local 'comment-line-break-function) + #'octave--indent-new-comment-line) (setq font-lock-defaults '(octave-font-lock-keywords)) @@ -908,9 +878,6 @@ startup file, `~/.emacs-octave'." (inferior-octave-completion-table) 'comint-completion-file-name-table)))))) -(define-obsolete-function-alias 'inferior-octave-complete - 'completion-at-point "24.1") - (defun inferior-octave-dynamic-list-input-ring () "List the buffer's input history in a help buffer." ;; We cannot use `comint-dynamic-list-input-ring', because it replaces @@ -1060,8 +1027,7 @@ directory and makes this the current buffer's default directory." (skip-syntax-backward "-(") (thing-at-point 'symbol))))) (completing-read - (format (if def "Function (default %s): " - "Function: ") def) + (format (if def "Function (default %s): " "Function: ") def) (inferior-octave-completion-table) nil nil nil nil def))) @@ -1088,7 +1054,7 @@ The value is (START END NAME-START NAME-END) of the function." (save-excursion (goto-char (point-min)) (when (equal (funcall smie-forward-token-function) "function") - (forward-word -1) + (forward-word-strictly -1) (let* ((start (point)) (end (progn (forward-sexp 1) (point))) (name (when (progn @@ -1448,9 +1414,6 @@ The block marked is the one that contains point or follows point." (inferior-octave-completion-table)) octave-reserved-words))))) -(define-obsolete-function-alias 'octave-complete-symbol - 'completion-at-point "24.1") - (defun octave-add-log-current-defun () "A function for `add-log-current-defun-function' (which see)." (save-excursion diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index b0929ebd040..76441ea03e6 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1023,7 +1023,7 @@ indent of the current line in parameterlist." (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start) ":" "=")) (stpos (if start start - (forward-word 2) (backward-word 1) (point))) + (forward-word-strictly 2) (backward-word 1) (point))) (edpos (set-marker (make-marker) (if end end (max (progn (pascal-declaration-end) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 241521bef4d..7ed87e8f033 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -301,7 +301,7 @@ ;; sub tr {...} (3 (ignore (if (save-excursion (goto-char (match-beginning 0)) - (forward-word -1) + (forward-word-strictly -1) (looking-at-p "sub[ \t\n]")) ;; This is defining a function. nil @@ -404,7 +404,8 @@ (skip-syntax-backward " ") (skip-syntax-backward "w") (member (buffer-substring - (point) (progn (forward-word 1) (point))) + (point) (progn (forward-word-strictly 1) + (point))) '("tr" "s" "y")))) (close (cdr (assq char perl-quote-like-pairs))) (st (perl-quote-syntax-table char))) @@ -993,7 +994,7 @@ Returns (parse-state) if line starts inside a string." ((memq c '(?\) ?\] ?\} ?\")) (forward-sexp -1) (forward-comment (- (point))) t) ((eq ?w (char-syntax c)) - (forward-word -1) (forward-comment (- (point))) t) + (forward-word-strictly -1) (forward-comment (- (point))) t) (t (forward-char -1) (forward-comment (- (point))) t))))) ;; note: this may be slower than the c-mode version, but I can understand it. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 1251bca2491..a51c383b93b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -101,7 +101,9 @@ that it is not applicable, or a project instance.") (defun project-current (&optional maybe-prompt dir) "Return the project instance in DIR or `default-directory'. When no project found in DIR, and MAYBE-PROMPT is non-nil, ask -the user for a different directory to look in." +the user for a different directory to look in. If that directory +is not a part of a detectable project either, return a +`transient' project instance rooted in it." (unless dir (setq dir default-directory)) (let ((pr (project--find-in-directory dir))) (cond @@ -110,7 +112,8 @@ the user for a different directory to look in." (setq dir (read-directory-name "Choose the project directory: " dir nil t) pr (project--find-in-directory dir)) (unless pr - (user-error "No project found in `%s'" dir)))) + (message "Using '%s' as a transient project root" dir) + (setq pr (cons 'transient dir))))) pr)) (defun project--find-in-directory (dir) @@ -169,7 +172,8 @@ to find the list of ignores for each directory." (let ((command (format "%s %s %s -type f -print0" find-program - dir + (shell-quote-argument + (expand-file-name dir)) (xref--find-ignores-arguments (project-ignores project dir) (expand-file-name dir))))) @@ -182,6 +186,9 @@ to find the list of ignores for each directory." (t (complete-with-action action all-files string pred)))))) +(cl-defmethod project-roots ((project (head transient))) + (list (cdr project))) + (defgroup project-vc nil "Project implementation using the VC package." :version "25.1" diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 9ee405b31e1..2b23c51a114 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -271,6 +271,9 @@ (require 'easymenu) (require 'align) +(eval-when-compile + (or (fboundp 'use-region-p) + (defsubst use-region-p () (region-exists-p)))) (defgroup prolog nil "Editing and running Prolog and Mercury files." @@ -1271,7 +1274,7 @@ Actually this is just customized `prolog-mode'." (comint-send-string proc (string last-command-event)) (call-interactively 'self-insert-command)))) -(declare-function 'compilation-shell-minor-mode "compile" (&optional arg)) +(declare-function compilation-shell-minor-mode "compile" (&optional arg)) (defvar compilation-error-regexp-alist) (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog" @@ -1374,8 +1377,20 @@ the variable `prolog-prompt-regexp'." () (with-current-buffer (get-buffer-create "*prolog*") (prolog-inferior-mode) - (apply 'make-comint-in-buffer "prolog" (current-buffer) - (prolog-program-name) nil (prolog-program-switches)) + + ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier, + ;; which assumes it is running under Emacs if either INFERIOR=yes or + ;; if EMACS is set to a nonempty value. The EMACS setting is + ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should + ;; know about INSIDE_EMACS (which replaced EMACS) and should not need + ;; this hack. + (let ((process-environment + (if (getenv "INFERIOR") + process-environment + (cons "INFERIOR=yes" process-environment)))) + (apply 'make-comint-in-buffer "prolog" (current-buffer) + (prolog-program-name) nil (prolog-program-switches))) + (unless prolog-system ;; Setup auto-detection. (setq-local @@ -3317,12 +3332,6 @@ PREFIX is the prefix of the search regexp." ;; prolog buffer) ;;------------------------------------------------------------------- -(unless (fboundp 'region-exists-p) - (defun region-exists-p () - "Non-nil if the mark is set. Lobotomized version for Emacsen that do not provide their own." - (mark))) - - ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus ;; are defined _is_ important! @@ -3356,7 +3365,7 @@ PREFIX is the prefix of the search regexp." :included (not (eq prolog-system 'mercury))] ["Consult buffer" prolog-consult-buffer :included (not (eq prolog-system 'mercury))] - ["Consult region" prolog-consult-region :active (region-exists-p) + ["Consult region" prolog-consult-region :active (use-region-p) :included (not (eq prolog-system 'mercury))] ["Consult predicate" prolog-consult-predicate :included (not (eq prolog-system 'mercury))] @@ -3368,7 +3377,7 @@ PREFIX is the prefix of the search regexp." :included (eq prolog-system 'sicstus)] ["Compile buffer" prolog-compile-buffer :included (eq prolog-system 'sicstus)] - ["Compile region" prolog-compile-region :active (region-exists-p) + ["Compile region" prolog-compile-region :active (use-region-p) :included (eq prolog-system 'sicstus)] ["Compile predicate" prolog-compile-predicate :included (eq prolog-system 'sicstus)] @@ -3406,11 +3415,11 @@ PREFIX is the prefix of the search regexp." prolog-edit-menu-insert-move prolog-mode-map "Commands for Prolog code manipulation." '("Prolog" - ["Comment region" comment-region (region-exists-p)] - ["Uncomment region" prolog-uncomment-region (region-exists-p)] + ["Comment region" comment-region (use-region-p)] + ["Uncomment region" prolog-uncomment-region (use-region-p)] ["Add comment/move to comment" indent-for-comment t] ["Convert variables in region to '_'" prolog-variables-to-anonymous - :active (region-exists-p) :included (not (eq prolog-system 'mercury))] + :active (use-region-p) :included (not (eq prolog-system 'mercury))] "---" ["Insert predicate template" prolog-insert-predicate-template t] ["Insert next clause head" prolog-insert-next-clause t] @@ -3423,10 +3432,10 @@ PREFIX is the prefix of the search regexp." ["End of predicate" prolog-end-of-predicate t] "---" ["Indent line" indent-according-to-mode t] - ["Indent region" indent-region (region-exists-p)] + ["Indent region" indent-region (use-region-p)] ["Indent predicate" prolog-indent-predicate t] ["Indent buffer" prolog-indent-buffer t] - ["Align region" align (region-exists-p)] + ["Align region" align (use-region-p)] "---" ["Mark clause" prolog-mark-clause t] ["Mark predicate" prolog-mark-predicate t] diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index c9299055a4d..3b0694541b1 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -1082,7 +1082,7 @@ Use line numbers if `ps-run-error-line-numbers' is not nil" (goto-char (max 1 (1- (point))))) (when (looking-at "[0-9]") (forward-char 1) - (forward-word -1) + (forward-word-strictly -1) (when (looking-at "[0-9]+") (let (i) (setq diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 01f7f251edd..37018122f30 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el -;; Version: 0.25.1 +;; Version: 0.25.2 ;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 @@ -330,6 +330,7 @@ ;; Some util commands (define-key map "\C-c\C-v" 'python-check) (define-key map "\C-c\C-f" 'python-eldoc-at-point) + (define-key map "\C-c\C-d" 'python-describe-at-point) ;; Utilities (substitute-key-definition 'complete-symbol 'completion-at-point map global-map) @@ -384,7 +385,10 @@ (defconst python-rx-constituents `((block-start . ,(rx symbol-start (or "def" "class" "if" "elif" "else" "try" - "except" "finally" "for" "while" "with") + "except" "finally" "for" "while" "with" + ;; Python 3.5+ PEP492 + (and "async" (+ space) + (or "def" "for" "with"))) symbol-end)) (dedenter . ,(rx symbol-start (or "elif" "else" "except" "finally") @@ -395,7 +399,11 @@ symbol-end)) (decorator . ,(rx line-start (* space) ?@ (any letter ?_) (* (any word ?_)))) - (defun . ,(rx symbol-start (or "def" "class") symbol-end)) + (defun . ,(rx symbol-start + (or "def" "class" + ;; Python 3.5+ PEP492 + (and "async" (+ space) "def")) + symbol-end)) (if-name-main . ,(rx line-start "if" (+ space) "__name__" (+ space) "==" (+ space) (any ?' ?\") "__main__" (any ?' ?\") @@ -527,6 +535,9 @@ The type returned can be `comment', `string' or `paren'." ;; fontified like that in order to keep font-lock consistent between ;; Python versions. "nonlocal" + ;; Python 3.5+ PEP492 + (and "async" (+ space) (or "def" "for" "with")) + "await" ;; Extra: "self") symbol-end) @@ -551,23 +562,32 @@ The type returned can be `comment', `string' or `paren'." ;; Builtin Exceptions (,(rx symbol-start (or + ;; Python 2 and 3: "ArithmeticError" "AssertionError" "AttributeError" "BaseException" - "DeprecationWarning" "EOFError" "EnvironmentError" "Exception" - "FloatingPointError" "FutureWarning" "GeneratorExit" "IOError" - "ImportError" "ImportWarning" "IndexError" "KeyError" - "KeyboardInterrupt" "LookupError" "MemoryError" "NameError" - "NotImplementedError" "OSError" "OverflowError" - "PendingDeprecationWarning" "ReferenceError" "RuntimeError" - "RuntimeWarning" "StopIteration" "SyntaxError" "SyntaxWarning" - "SystemError" "SystemExit" "TypeError" "UnboundLocalError" - "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError" - "UnicodeTranslateError" "UnicodeWarning" "UserWarning" "VMSError" - "ValueError" "Warning" "WindowsError" "ZeroDivisionError" + "BufferError" "BytesWarning" "DeprecationWarning" "EOFError" + "EnvironmentError" "Exception" "FloatingPointError" "FutureWarning" + "GeneratorExit" "IOError" "ImportError" "ImportWarning" + "IndentationError" "IndexError" "KeyError" "KeyboardInterrupt" + "LookupError" "MemoryError" "NameError" "NotImplementedError" + "OSError" "OverflowError" "PendingDeprecationWarning" + "ReferenceError" "RuntimeError" "RuntimeWarning" "StopIteration" + "SyntaxError" "SyntaxWarning" "SystemError" "SystemExit" "TabError" + "TypeError" "UnboundLocalError" "UnicodeDecodeError" + "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" + "UnicodeWarning" "UserWarning" "ValueError" "Warning" + "ZeroDivisionError" ;; Python 2: "StandardError" ;; Python 3: - "BufferError" "BytesWarning" "IndentationError" "ResourceWarning" - "TabError") + "BlockingIOError" "BrokenPipeError" "ChildProcessError" + "ConnectionAbortedError" "ConnectionError" "ConnectionRefusedError" + "ConnectionResetError" "FileExistsError" "FileNotFoundError" + "InterruptedError" "IsADirectoryError" "NotADirectoryError" + "PermissionError" "ProcessLookupError" "RecursionError" + "ResourceWarning" "StopAsyncIteration" "TimeoutError" + ;; OS specific + "VMSError" "WindowsError" + ) symbol-end) . font-lock-type-face) ;; Builtins (,(rx symbol-start @@ -2359,7 +2379,9 @@ the `buffer-name'." (defun python-shell-calculate-command () "Calculate the string used to execute the inferior Python process." (format "%s %s" - (shell-quote-argument python-shell-interpreter) + ;; `python-shell-make-comint' expects to be able to + ;; `split-string-and-unquote' the result of this function. + (combine-and-quote-strings (list python-shell-interpreter)) python-shell-interpreter-args)) (define-obsolete-function-alias @@ -2416,7 +2438,7 @@ banner and the initial prompt are received separately." (defun python-shell-comint-end-of-output-p (output) "Return non-nil if OUTPUT is ends with input prompt." (string-match - ;; XXX: It seems on OSX an extra carriage return is attached + ;; XXX: It seems on macOS an extra carriage return is attached ;; at the end of output, this handles that too. (concat "\r?\n?" @@ -2680,6 +2702,7 @@ variable. \(Type \\[describe-mode] in the process buffer for a list of commands.)" (when python-shell--parent-buffer (python-util-clone-local-variables python-shell--parent-buffer)) + (set (make-local-variable 'indent-tabs-mode) nil) ;; Users can interactively override default values for ;; `python-shell-interpreter' and `python-shell-interpreter-args' ;; when calling `run-python'. This ensures values let-bound in @@ -3129,13 +3152,10 @@ t when called interactively." (insert-file-contents (or temp-file-name file-name)) (python-info-encoding))) - (file-name (expand-file-name - (or (file-remote-p file-name 'localname) - file-name))) + (file-name (expand-file-name (file-local-name file-name))) (temp-file-name (when temp-file-name (expand-file-name - (or (file-remote-p temp-file-name 'localname) - temp-file-name))))) + (file-local-name temp-file-name))))) (python-shell-send-string (format (concat @@ -3297,7 +3317,7 @@ When a match is found, native completion is disabled." python-shell-completion-native-try-output-timeout)) (python-shell-completion-native-get-completions (get-buffer-process (current-buffer)) - nil ""))) + nil "_"))) (defun python-shell-completion-native-setup () "Try to setup native completion, return non-nil on success." @@ -4019,14 +4039,14 @@ be added to `python-mode-skeleton-abbrev-table'." "Abbrev table for Python mode." :parents (list python-mode-skeleton-abbrev-table)) -(defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel) +(defmacro python-define-auxiliary-skeleton (name &optional doc &rest skel) "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME." (declare (indent 2)) (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton--" name))) - (msg (format-message - "Add `%s' clause? " name))) + (msg (funcall (if (fboundp 'format-message) #'format-message #'format) + "Add `%s' clause? " name))) (when (not skel) (setq skel `(< ,(format "%s:" name) \n \n @@ -4039,11 +4059,11 @@ The skeleton will be bound to python-skeleton-NAME." (signal 'quit t)) ,@skel))) -(python-define-auxiliary-skeleton else nil) +(python-define-auxiliary-skeleton else) -(python-define-auxiliary-skeleton except nil) +(python-define-auxiliary-skeleton except) -(python-define-auxiliary-skeleton finally nil) +(python-define-auxiliary-skeleton finally) (python-skeleton-define if nil "Condition: " @@ -4293,12 +4313,47 @@ returns will be used. If not FORCE-PROCESS is passed what (unless (zerop (length docstring)) docstring))))) +(defvar-local python-eldoc-get-doc t + "Non-nil means eldoc should fetch the documentation + automatically. Set to nil by `python-eldoc-function' if + `python-eldoc-function-timeout-permanent' is non-nil and + `python-eldoc-function' times out.") + +(defcustom python-eldoc-function-timeout 1 + "Timeout for `python-eldoc-function' in seconds." + :group 'python + :type 'integer + :version "25.1") + +(defcustom python-eldoc-function-timeout-permanent t + "Non-nil means that when `python-eldoc-function' times out +`python-eldoc-get-doc' will be set to nil" + :group 'python + :type 'boolean + :version "25.1") + (defun python-eldoc-function () "`eldoc-documentation-function' for Python. For this to work as best as possible you should call `python-shell-send-buffer' from time to time so context in -inferior Python process is updated properly." - (python-eldoc--get-doc-at-point)) +inferior Python process is updated properly. + +If `python-eldoc-function-timeout' seconds elapse before this +function returns then if +`python-eldoc-function-timeout-permanent' is non-nil +`python-eldoc-get-doc' will be set to nil and eldoc will no +longer return the documentation at the point automatically. + +Set `python-eldoc-get-doc' to t to reenable eldoc documentation +fetching" + (when python-eldoc-get-doc + (with-timeout (python-eldoc-function-timeout + (if python-eldoc-function-timeout-permanent + (progn + (message "Eldoc echo-area display muted in this buffer, see `python-eldoc-function'") + (setq python-eldoc-get-doc nil)) + (message "`python-eldoc-function' timed out, see `python-eldoc-function-timeout'"))) + (python-eldoc--get-doc-at-point)))) (defun python-eldoc-at-point (symbol) "Get help on SYMBOL using `help'. @@ -4312,6 +4367,11 @@ Interactively, prompt for symbol." nil nil symbol)))) (message (python-eldoc--get-doc-at-point symbol))) +(defun python-describe-at-point (symbol process) + (interactive (list (python-info-current-symbol) + (python-shell-get-process))) + (comint-send-string process (concat "help('" symbol "')\n"))) + ;;; Hideshow @@ -4831,12 +4891,19 @@ point's current `syntax-ppss'." ;; Allow up to two consecutive docstrings only. (>= 2 - (progn + (let (last-backward-sexp-point) (while (save-excursion (python-nav-backward-sexp) (setq backward-sexp-point (point)) (and (= indentation (current-indentation)) - (not (bobp)) ; Prevent infloop. + ;; Make sure we're always moving point. + ;; If we get stuck in the same position + ;; on consecutive loop iterations, + ;; bail out. + (prog1 (not (eql last-backward-sexp-point + backward-sexp-point)) + (setq last-backward-sexp-point + backward-sexp-point)) (looking-at-p (concat "[uU]?[rR]?" (python-rx string-delimiter))))) @@ -5102,7 +5169,7 @@ returned as is." (add-to-list 'hs-special-modes-alist `(python-mode - "\\s-*\\(?:def\\|class\\)\\>" + "\\s-*\\_<\\(?:def\\|class\\)\\_>" ;; Use the empty string as end regexp so it doesn't default to ;; "\\s)". This way parens at end of defun are properly hidden. "" diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index d2370741972..e7b37acc3de 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -368,7 +368,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (exp (exp1) (exp "," exp) (exp "=" exp) (id " @ " exp)) (exp1 (exp2) (exp2 "?" exp1 ":" exp1)) - (exp2 (exp3) (exp3 "." exp2)) + (exp2 (exp3) (exp3 "." exp3)) (exp3 ("def" insts "end") ("begin" insts-rescue-insts "end") ("do" insts "end") @@ -388,7 +388,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (cases (exp "then" insts) (cases "when" cases) (insts "else" insts)) (expseq (exp) );;(expseq "," expseq) - (hashvals (id "=>" exp1) (hashvals "," hashvals)) + (hashvals (exp1 "=>" exp1) (hashvals "," hashvals)) (insts-rescue-insts (insts) (insts-rescue-insts "rescue" insts-rescue-insts) (insts-rescue-insts "ensure" insts-rescue-insts)) @@ -406,17 +406,18 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." '((right "=") (right "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" "<<=" ">>=" "&&=" "||=") - (left ".." "...") - (left "+" "-") - (left "*" "/" "%" "**") + (nonassoc ".." "...") (left "&&" "||") - (left "^" "&" "|") (nonassoc "<=>") - (nonassoc ">" ">=" "<" "<=") (nonassoc "==" "===" "!=") (nonassoc "=~" "!~") + (nonassoc ">" ">=" "<" "<=") + (left "^" "&" "|") (left "<<" ">>") - (right ".")))))) + (left "+" "-") + (left "*" "/" "%") + (left "**") + (assoc ".")))))) (defun ruby-smie--bosp () (save-excursion (skip-chars-backward " \t") @@ -443,12 +444,12 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (member (save-excursion (ruby-smie--backward-token)) '("iuwu-mod" "and" "or"))) (save-excursion - (forward-comment 1) - (eq (char-after) ?.)))))) + (forward-comment (point-max)) + (looking-at "&?\\.")))))) (defun ruby-smie--redundant-do-p (&optional skip) (save-excursion - (if skip (backward-word 1)) + (if skip (backward-word-strictly 1)) (member (nth 2 (smie-backward-sexp ";")) '("while" "until" "for")))) (defun ruby-smie--opening-pipe-p () @@ -517,7 +518,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (setq tok (concat "." tok))) (cond ((member tok '("unless" "if" "while" "until")) - (if (save-excursion (forward-word -1) (ruby-smie--bosp)) + (if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp)) tok "iuwu-mod")) ((string-match-p "\\`|[*&]?\\'" tok) (forward-char (- 1 (length tok))) @@ -535,6 +536,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (line-end-position)) (ruby-smie--forward-token)) ;Fully redundant. (t ";"))) + ((equal tok "&.") ".") (t tok))))))))) (defun ruby-smie--backward-token () @@ -575,11 +577,12 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ((equal tok "do") (cond ((not (ruby-smie--redundant-do-p)) tok) - ((> (save-excursion (forward-word 1) + ((> (save-excursion (forward-word-strictly 1) (forward-comment (point-max)) (point)) (line-end-position)) (ruby-smie--backward-token)) ;Fully redundant. (t ";"))) + ((equal tok "&.") ".") (t tok))))))) (defun ruby-smie--indent-to-stmt () @@ -627,19 +630,13 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." ;; because when `.' is inside the line, the ;; additional indentation from it looks out of place. ((smie-rule-parent-p ".") - (let (smie--parent) - (save-excursion - ;; Traverse up the parents until the parent is "." at - ;; indentation, or any other token. - (while (and (let ((parent (smie-indent--parent))) - (goto-char (cadr parent)) - (save-excursion - (unless (integerp (car parent)) (forward-char -1)) - (not (ruby-smie--bosp)))) - (progn - (setq smie--parent nil) - (smie-rule-parent-p ".")))) - (smie-rule-parent)))) + ;; Traverse up the call chain until the parent is not `.', + ;; or `.' at indentation, or at eol. + (while (and (not (ruby-smie--bosp)) + (equal (nth 2 (smie-backward-sexp ".")) ".") + (not (ruby-smie--bosp))) + (forward-char -1)) + (smie-indent-virtual)) (t (smie-rule-parent)))))) (`(:after . ,(or `"(" "[" "{")) ;; FIXME: Shouldn't this be the default behavior of @@ -659,7 +656,9 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'." (`(:before . ".") (if (smie-rule-sibling-p) (and ruby-align-chained-calls 0) - ruby-indent-level)) + (smie-backward-sexp ".") + (cons 'column (+ (current-column) + ruby-indent-level)))) (`(:before . ,(or `"else" `"then" `"elsif" `"rescue" `"ensure")) (smie-rule-parent)) (`(:before . "when") @@ -897,7 +896,7 @@ and `\\' when preceded by `?'." ;; us to do better. (when (not (memq (car (syntax-after (1- (point)))) '(2 3 6 10))) (or (not (memq (char-before) '(?\s ?\t))) - (ignore (forward-word -1)) + (ignore (forward-word-strictly -1)) (eq (char-before) ?_) (not (looking-at ruby-singleton-class-re)))))) @@ -1152,7 +1151,7 @@ delimiter." ((looking-at "<<") (cond ((and (ruby-expr-beg 'heredoc) - (looking-at "<<\\(-\\)?\\(\\([\"'`]\\)\\([^\n]+?\\)\\3\\|\\(?:\\sw\\|\\s_\\)+\\)")) + (looking-at "<<\\([-~]\\)?\\(\\([\"'`]\\)\\([^\n]+?\\)\\3\\|\\(?:\\sw\\|\\s_\\)+\\)")) (setq re (regexp-quote (or (match-string 4) (match-string 2)))) (if (match-beginning 1) (setq re (concat "\\s *" re))) (let* ((id-end (goto-char (match-end 0))) @@ -1240,7 +1239,7 @@ delimiter." ((let ((s (ruby-parse-region (point) ruby-indent-point))) (and (nth 2 s) (> (nth 2 s) 0) (or (goto-char (cdr (nth 1 s))) t))) - (forward-word -1) + (forward-word-strictly -1) (setq indent (ruby-indent-size (current-column) (nth 2 state)))) (t @@ -1259,7 +1258,7 @@ delimiter." (if (null (cdr (nth 1 state))) (error "Invalid nesting")) (goto-char (cdr (nth 1 state))) - (forward-word -1) ; skip back a keyword + (forward-word-strictly -1) ; skip back a keyword (setq begin (point)) (cond ((looking-at "do\\>[^_]") ; iter block is a special case @@ -1352,7 +1351,7 @@ delimiter." (forward-char -1) (not (looking-at "{"))) (progn - (forward-word -1) + (forward-word-strictly -1) (not (looking-at "do\\>[^_]"))))) (t t)))) (not (eq ?, c)) @@ -1375,7 +1374,7 @@ delimiter." (goto-char ruby-indent-point) (beginning-of-line) (skip-syntax-forward " ") - (if (looking-at "\\.[^.]") + (if (looking-at "\\.[^.]\\|&\\.") (+ indent ruby-indent-level) indent)))) @@ -1505,10 +1504,11 @@ With ARG, do it many times. Negative ARG means move backward." (not (eq (char-before (point)) ?.)) (not (eq (char-before (point)) ?:))) (ruby-end-of-block) - (forward-word 1)) + (forward-word-strictly 1)) ((looking-at "\\(\\$\\|@@?\\)?\\sw") (while (progn - (while (progn (forward-word 1) (looking-at "_"))) + (while (progn (forward-word-strictly 1) + (looking-at "_"))) (cond ((looking-at "::") (forward-char 2) t) ((> (skip-chars-forward ".") 0)) ((looking-at "\\?\\|!\\(=[~=>]\\|[^~=]\\)") @@ -1524,7 +1524,7 @@ With ARG, do it many times. Negative ARG means move backward." (skip-chars-forward "<")) (not expr)))) (setq i (1- i))) - ((error) (forward-word 1))) + ((error) (forward-word-strictly 1))) i)))) (defun ruby-backward-sexp (&optional arg) @@ -1560,7 +1560,7 @@ With ARG, do it many times. Negative ARG means move forward." ((looking-at "\\s(") nil) (t (forward-char 1) - (while (progn (forward-word -1) + (while (progn (forward-word-strictly -1) (pcase (char-before) (`?_ t) (`?. (forward-char -1) t) @@ -1799,9 +1799,9 @@ If the result is do-end block, it will always be multiline." (content (buffer-substring-no-properties (1+ min) (1- max)))) (setq content - (if (equal string-quote "\"") - (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\([^\\\\]\\)'" "\\1\\\\'" content)) - (replace-regexp-in-string "\\\\'" "'" (replace-regexp-in-string "\\([^\\\\]\\)\"" "\\1\\\\\"" content)))) + (if (equal string-quote "'") + (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\(\\`\\|[^\\\\]\\)'" "\\1\\\\'" content)) + (replace-regexp-in-string "\\\\'" "'" (replace-regexp-in-string "\\(\\`\\|[^\\\\]\\)\"" "\\1\\\\\"" content)))) (let ((orig-point (point))) (delete-region min max) (insert @@ -1858,7 +1858,9 @@ It will be properly highlighted even when the call omits parens.") (string-to-syntax "'")))) ;; Symbols with special characters. ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)\\)" - (3 (string-to-syntax "_"))) + (3 (unless (nth 8 (syntax-ppss (match-beginning 3))) + (goto-char (match-end 0)) + (string-to-syntax "_")))) ;; Part of method name when at the end of it. ("[!?]" (0 (unless (save-excursion @@ -2173,7 +2175,7 @@ See `font-lock-syntax-table'.") 'font-lock-string-face))) ;; Perl-ish keywords. "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$" - ;; Variables. + ;; Singleton objects. (,(concat ruby-font-lock-keyword-beg-re "\\_<\\(nil\\|true\\|false\\)\\_>") 1 font-lock-constant-face) @@ -2181,7 +2183,7 @@ See `font-lock-syntax-table'.") ("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" (0 font-lock-builtin-face)) ;; Symbols. - ("\\(^\\|[^:]\\)\\(:@?\\(?:\\w\\|_\\)+\\)\\([!?=]\\)?" + ("\\(^\\|[^:]\\)\\(:@\\{0,2\\}\\(?:\\sw\\|\\s_\\)+\\)" (2 font-lock-constant-face) (3 (unless (and (eq (char-before (match-end 3)) ?=) (eq (char-after (match-end 3)) ?>)) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 1fbc87e748d..66d9ed6fae6 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -54,7 +54,7 @@ (defvar scheme-mode-syntax-table (let ((st (make-syntax-table)) - (i 0)) + (i 0)) ;; Symbol constituents ;; We used to treat chars 128-256 as symbol-constituent, but they ;; should be valid word constituents (Bug#8843). Note that valid @@ -116,11 +116,11 @@ (defvar scheme-imenu-generic-expression '((nil - "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4) - ("Types" - "^(define-class\\s-+(?\\(\\sw+\\)" 1) - ("Macros" - "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2)) + "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4) + ("Types" + "^(define-class\\s-+(?\\(\\sw+\\)" 1) + ("Macros" + "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2)) "Imenu generic expression for Scheme mode. See `imenu-generic-expression'.") (defun scheme-mode-variables () @@ -151,11 +151,11 @@ (setq-local imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w"))) (setq-local syntax-propertize-function #'scheme-syntax-propertize) (setq font-lock-defaults - '((scheme-font-lock-keywords - scheme-font-lock-keywords-1 scheme-font-lock-keywords-2) - nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14")) - beginning-of-defun - (font-lock-mark-block-function . mark-defun))) + '((scheme-font-lock-keywords + scheme-font-lock-keywords-1 scheme-font-lock-keywords-2) + nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14")) + beginning-of-defun + (font-lock-mark-block-function . mark-defun))) (setq-local prettify-symbols-alist lisp-prettify-symbols-alist) (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt)) @@ -163,7 +163,7 @@ (defvar scheme-mode-map (let ((smap (make-sparse-keymap)) - (map (make-sparse-keymap "Scheme"))) + (map (make-sparse-keymap "Scheme"))) (set-keymap-parent smap lisp-mode-shared-map) (define-key smap [menu-bar scheme] (cons "Scheme" map)) (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme)) @@ -271,25 +271,25 @@ See `run-hooks'." ;; Declarations. Hannes Haug <hannes.haug@student.uni-tuebingen.de> says ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS. (list (concat "(\\(define\\*?\\(" - ;; Function names. - "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|" - ;; Macro names, as variable names. A bit dubious, this. - "\\(-syntax\\|-macro\\)\\|" - ;; Class names. - "-class" + ;; Function names. + "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|" + ;; Macro names, as variable names. A bit dubious, this. + "\\(-syntax\\|-macro\\)\\|" + ;; Class names. + "-class" ;; Guile modules. "\\|-module" - "\\)\\)\\>" - ;; Any whitespace and declared object. - ;; The "(*" is for curried definitions, e.g., - ;; (define ((sum a) b) (+ a b)) - "[ \t]*(*" - "\\(\\sw+\\)?") - '(1 font-lock-keyword-face) - '(6 (cond ((match-beginning 3) font-lock-function-name-face) - ((match-beginning 5) font-lock-variable-name-face) - (t font-lock-type-face)) - nil t)) + "\\)\\)\\>" + ;; Any whitespace and declared object. + ;; The "(*" is for curried definitions, e.g., + ;; (define ((sum a) b) (+ a b)) + "[ \t]*(*" + "\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(6 (cond ((match-beginning 3) font-lock-function-name-face) + ((match-beginning 5) font-lock-variable-name-face) + (t font-lock-type-face)) + nil t)) )) "Subdued expressions to highlight in Scheme modes.") @@ -301,21 +301,30 @@ See `run-hooks'." ;; Control structures. (cons (concat - "(" (regexp-opt - '("begin" "call-with-current-continuation" "call/cc" - "call-with-input-file" "call-with-output-file" "case" "cond" - "do" "else" "for-each" "if" "lambda" "λ" - "let" "let*" "let-syntax" "letrec" "letrec-syntax" - ;; R6RS library subforms. - "export" "import" - ;; SRFI 11 usage comes up often enough. - "let-values" "let*-values" - ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants: - "and" "or" "delay" "force" - ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother: - ;;"quasiquote" "quote" "unquote" "unquote-splicing" - "map" "syntax" "syntax-rules") t) - "\\>") 1) + "(" (regexp-opt + '("begin" "call-with-current-continuation" "call/cc" + "call-with-input-file" "call-with-output-file" "case" "cond" + "do" "else" "for-each" "if" "lambda" "λ" + "let" "let*" "let-syntax" "letrec" "letrec-syntax" + ;; R6RS library subforms. + "export" "import" + ;; SRFI 11 usage comes up often enough. + "let-values" "let*-values" + ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants: + "and" "or" "delay" "force" + ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother: + ;;"quasiquote" "quote" "unquote" "unquote-splicing" + "map" "syntax" "syntax-rules" + ;; For R7RS + "when" "unless" "letrec*" "include" "include-ci" "cond-expand" + "delay-force" "parameterize" "guard" "case-lambda" + "syntax-error" "only" "except" "prefix" "rename" "define-values" + "define-record-type" "define-library" + "include-library-declarations" + ;; SRFI-8 + "receive" + ) t) + "\\>") 1) ;; ;; It wouldn't be Scheme w/o named-let. '("(let\\s-+\\(\\sw+\\)" @@ -328,8 +337,8 @@ See `run-hooks'." '("\\<#?:\\sw+\\>" . font-lock-builtin-face) ;; R6RS library declarations. '("(\\(\\<library\\>\\)\\s-*(?\\(\\sw+\\)?" - (1 font-lock-keyword-face) - (2 font-lock-type-face)) + (1 font-lock-keyword-face) + (2 font-lock-type-face)) ))) "Gaudy expressions to highlight in Scheme modes.") @@ -394,9 +403,9 @@ that variable's value is a string." (not buffer-read-only) (insert dsssl-sgml-declaration)) (setq font-lock-defaults '(dsssl-font-lock-keywords - nil t (("+-*/.<>=?$%_&~^:" . "w")) - beginning-of-defun - (font-lock-mark-block-function . mark-defun))) + nil t (("+-*/.<>=?$%_&~^:" . "w")) + beginning-of-defun + (font-lock-mark-block-function . mark-defun))) (setq-local add-log-current-defun-function #'lisp-current-defun-name) (setq-local imenu-case-fold-search nil) (setq imenu-generic-expression dsssl-imenu-generic-expression) @@ -416,22 +425,22 @@ that variable's value is a string." (eval-when-compile (list ;; Similar to Scheme - (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\((?\\)\\(\\sw+\\)\\>" - '(1 font-lock-keyword-face) - '(4 font-lock-function-name-face)) + (list "(\\(define\\(-\\w+\\)?\\)\\>[ \t]*\\((?\\)\\(\\sw+\\)\\>" + '(1 font-lock-keyword-face) + '(4 font-lock-function-name-face)) (cons (concat "(\\(" - ;; (make-regexp '("case" "cond" "else" "if" "lambda" - ;; "let" "let*" "letrec" "and" "or" "map" "with-mode")) - "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|" - "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode" - "\\)\\>") + ;; (make-regexp '("case" "cond" "else" "if" "lambda" + ;; "let" "let*" "letrec" "and" "or" "map" "with-mode")) + "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|" + "l\\(ambda\\|et\\(\\|*\\|rec\\)\\)\\|map\\|or\\|with-mode" + "\\)\\>") 1) ;; DSSSL syntax - '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ ]*\\(\\sw+\\)" + '("(\\(element\\|mode\\|declare-\\w+\\)\\>[ \t]*\\(\\sw+\\)" (1 font-lock-keyword-face) (2 font-lock-type-face)) - '("(\\(element\\)\\>[ ]*(\\(\\S)+\\))" + '("(\\(element\\)\\>[ \t]*(\\(\\S)+\\))" (1 font-lock-keyword-face) (2 font-lock-type-face)) '("\\<\\sw+:\\>" . font-lock-constant-face) ; trailing `:' c.f. scheme @@ -468,7 +477,7 @@ indentation." (progn (goto-char calculate-lisp-indent-last-sexp) (beginning-of-line) (parse-partial-sexp (point) - calculate-lisp-indent-last-sexp 0 t))) + calculate-lisp-indent-last-sexp 0 t))) ;; Indent under the list or under the first sexp on the same ;; line as calculate-lisp-indent-last-sexp. Note that first ;; thing on that line has to be complete sexp since we are @@ -476,20 +485,20 @@ indentation." (backward-prefix-chars) (current-column)) (let ((function (buffer-substring (point) - (progn (forward-sexp 1) (point)))) - method) - (setq method (or (get (intern-soft function) 'scheme-indent-function) - (get (intern-soft function) 'scheme-indent-hook))) - (cond ((or (eq method 'defun) - (and (null method) - (> (length function) 3) - (string-match "\\`def" function))) - (lisp-indent-defform state indent-point)) - ((integerp method) - (lisp-indent-specform method state - indent-point normal-indent)) - (method - (funcall method state indent-point normal-indent))))))) + (progn (forward-sexp 1) (point)))) + method) + (setq method (or (get (intern-soft function) 'scheme-indent-function) + (get (intern-soft function) 'scheme-indent-hook))) + (cond ((or (eq method 'defun) + (and (null method) + (> (length function) 3) + (string-match "\\`def" function))) + (lisp-indent-defform state indent-point)) + ((integerp method) + (lisp-indent-specform method state + indent-point normal-indent)) + (method + (funcall method state indent-point normal-indent))))))) ;;; Let is different in Scheme @@ -547,6 +556,18 @@ indentation." (put 'call-with-values 'scheme-indent-function 1) ; r5rs? (put 'dynamic-wind 'scheme-indent-function 3) ; r5rs? +;; R7RS +(put 'when 'scheme-indent-function 1) +(put 'unless 'scheme-indent-function 1) +(put 'letrec* 'scheme-indent-function 1) +(put 'parameterize 'scheme-indent-function 1) +(put 'define-values 'scheme-indent-function 1) +(put 'define-record-type 'scheme-indent-function 1) ;; is 1 correct? +(put 'define-library 'scheme-indent-function 1) + +;; SRFI-8 +(put 'receive 'scheme-indent-function 2) + ;;;; MIT Scheme specific indentation. (if scheme-mit-dialect diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 5f29bb64f05..5d362e42c30 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -925,8 +925,6 @@ See `sh-feature'.") (:weight bold))) "Face to show quoted execs like \\=`blabla\\=`." :group 'sh-indentation) -(define-obsolete-face-alias 'sh-heredoc-face 'sh-heredoc "22.1") -(defvar sh-heredoc-face 'sh-heredoc) (defface sh-escaped-newline '((t :inherit font-lock-string-face)) "Face used for (non-escaped) backslash at end of a line in Shell-script mode." @@ -1207,7 +1205,7 @@ subshells can nest." (if q (if (characterp q) (if (eq q ?\`) 'sh-quoted-exec font-lock-string-face) - sh-heredoc-face) + 'sh-heredoc) font-lock-comment-face))) (defgroup sh-indentation nil @@ -1225,9 +1223,10 @@ and command `sh-reset-indent-vars-to-global-values'." :type 'hook :group 'sh-script) -(defcustom sh-mode-hook nil +(defcustom sh-mode-hook '(sh-electric-here-document-mode) "Hook run by `sh-mode'." :type 'hook + :options '(sh-electric-here-document-mode) :group 'sh-script) (defcustom sh-learn-basic-offset nil @@ -1616,7 +1615,8 @@ buffer indents as it currently is indented. \\[sh-execute-region] Have optional header and region be executed in a subshell. `sh-electric-here-document-mode' controls whether insertion of two -unquoted < insert a here document. +unquoted < insert a here document. You can control this behavior by +modifying `sh-mode-hook'. If you generally program a shell different from your login shell you can set `sh-shell-file' accordingly. If your shell's file name doesn't correctly @@ -1653,7 +1653,6 @@ with your script for an edit-interpret-debug cycle." (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) - (sh-electric-here-document-mode 1) (setq-local skeleton-pair-alist '((?` _ ?`))) (setq-local skeleton-pair-filter-function 'sh-quoted-p) (setq-local skeleton-further-elements @@ -1745,7 +1744,10 @@ This adds rules for comments and assignments." (defun sh--cmd-completion-table (string pred action) (let ((cmds (append (when (fboundp 'imenu--make-index-alist) - (mapcar #'car (imenu--make-index-alist))) + (mapcar #'car + (condition-case nil + (imenu--make-index-alist) + (imenu-unavailable nil)))) (mapcar (lambda (v) (concat v "=")) (sh--vars-before-point)) (locate-file-completion-table @@ -2004,16 +2006,16 @@ Does not preserve point." Continued lines can either be indented as \"one long wrapped line\" without paying attention to the actual syntactic structure, as in: - for f \ - in a; do \ - toto; \ + for f \\ + in a; do \\ + toto; \\ done or as lines that just don't have implicit semi-colons between them, as in: - for f \ - in a; do \ - toto; \ + for f \\ + in a; do \\ + toto; \\ done With `always' you get the former behavior whereas with nil you get the latter. @@ -2197,7 +2199,7 @@ Returns the construct's token and moves point before it, if so." Point should be before the newline." (save-excursion (let ((tok (funcall smie-backward-token-function))) - (if (or (when (equal tok "not") (forward-word 1) t) + (if (or (when (equal tok "not") (forward-word-strictly 1) t) (and (zerop (length tok)) (eq (char-before) ?\)))) (not (sh-smie--rc-after-special-arg-p)) (sh-smie--newline-semi-p tok))))) @@ -2431,8 +2433,8 @@ whose value is the shell name (don't quote it)." (funcall mksym "rules") :forward-token (funcall mksym "forward-token") :backward-token (funcall mksym "backward-token"))) + (setq-local parse-sexp-lookup-properties t) (unless sh-use-smie - (setq-local parse-sexp-lookup-properties t) (setq-local sh-kw-alist (sh-feature sh-kw)) (let ((regexp (sh-feature sh-kws-for-done))) (if regexp @@ -2901,7 +2903,7 @@ STRING This is ignored for the purposes of calculating ;;(This function never returns just t.) (cond ((or (nth 3 (syntax-ppss (point))) - (eq (get-text-property (point) 'face) sh-heredoc-face)) + (eq (get-text-property (point) 'face) 'sh-heredoc)) ;; String continuation -- don't indent (setq result t) (setq have-result t)) @@ -3107,8 +3109,7 @@ we go to the end of the previous line and do not check for continuations." (forward-comment (- (point-max))) (unless end (beginning-of-line)) (when (and (not (bobp)) - (equal (get-text-property (1- (point)) 'face) - sh-heredoc-face)) + (eq (get-text-property (1- (point)) 'face) 'sh-heredoc)) (let ((p1 (previous-single-property-change (1- (point)) 'face))) (when p1 (goto-char p1) diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 0c420dfbec6..d627309d6a4 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -568,7 +568,7 @@ The relative indentation among the lines of the statement are preserved." (if (and (eq (char-syntax (preceding-char)) ?w) (eq (char-syntax (following-char)) ?w)) (save-excursion - (backward-word 1) + (backward-word-strictly 1) (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>") (setq return-value nil))))) ((memq (preceding-char) '(?! ?t ?T)) @@ -654,12 +654,12 @@ If COUNT is negative, move forward up block level instead." (1+ count))))) (while (< count 0) (re-search-forward "\\<begin\\>\\|\\<end\\>") - (backward-word 1) + (backward-word-strictly 1) (if (not (simula-context)) (setq count (if (memq (following-char) '(?e ?E)) (1+ count) (1- count)))) - (backward-word -1))) + (backward-word-strictly -1))) ;; If block level not found, jump back to origin and signal an error (error (progn (goto-char origin) @@ -689,12 +689,12 @@ If COUNT is negative, move backward down block level instead." (if (< count start-count) (signal 'error nil))) (while (> count 0) (re-search-forward "\\<begin\\>\\|\\<end\\>") - (backward-word 1) + (backward-word-strictly 1) (if (not (simula-context)) (setq count (if (memq (following-char) '(?b ?B)) (1- count) (1+ count)))) - (backward-word -1) + (backward-word-strictly -1) ;; deeper level has to be found within starting block (if (> count start-count) (signal 'error nil)))) ;; If block level not found, jump back to origin and signal an error @@ -721,9 +721,9 @@ If COUNT is negative, move forward instead." (simula-skip-comment-backward) (if (memq (preceding-char) '(?n ?N)) (progn - (backward-word 1) + (backward-word-strictly 1) (if (not (looking-at "\\<begin\\>")) - (backward-word -1))) + (backward-word-strictly -1))) (if (eq (preceding-char) ?\;) (backward-char 1)) ) @@ -734,7 +734,7 @@ If COUNT is negative, move forward instead." (progn (if (eq (following-char) ?\;) (forward-char 1) - (backward-word -1)))) + (backward-word-strictly -1)))) (simula-skip-comment-forward)) (error (progn (goto-char origin) (error "Incomplete statement (too many ENDs)"))) @@ -753,13 +753,13 @@ If COUNT is negative, move backward instead." (condition-case () (progn (simula-skip-comment-forward) - (if (looking-at "\\<end\\>") (forward-word 1)) + (if (looking-at "\\<end\\>") (forward-word-strictly 1)) (while (and (natnump (setq count (1- count))) (setq status (simula-search-forward ";\\|\\<end\\>" (point-max) 'move)))) (if (and status (/= (preceding-char) ?\;)) (progn - (backward-word 1) + (backward-word-strictly 1) (simula-skip-comment-backward)))) (error (progn (goto-char origin) (error "Incomplete statement (too few ENDs)"))) @@ -802,7 +802,7 @@ If COUNT is negative, move backward instead." ((eq context 2) ;; an END-comment must belong to an END (re-search-backward "\\<end\\>") - (forward-word 1) + (forward-word-strictly 1) (throw 'simula-out nil)) ;; should be impossible to get here.. ))))) @@ -915,7 +915,7 @@ If COUNT is negative, move backward instead." ((memq (following-char) '(?E ?e)) (setq indent (cdr simula-if-indent))) (t - (forward-word 1) + (forward-word-strictly 1) (setq indent 0))) (simula-find-if)) ;; @@ -939,7 +939,7 @@ If COUNT is negative, move backward instead." (not (eq (preceding-char) ?\;)) (if (memq (preceding-char) '(?N ?n)) (save-excursion - (backward-word 1) + (backward-word-strictly 1) (not (looking-at "begin\\>"))) t)) (progn @@ -954,7 +954,7 @@ If COUNT is negative, move backward instead." ;; (not found-end) (if (eq (char-syntax (preceding-char)) ?w) (progn - (backward-word 1) + (backward-word-strictly 1) (not (looking-at "begin\\|then\\|else\\|when\\|otherwise\\|do" ))) @@ -975,14 +975,14 @@ If COUNT is negative, move backward instead." ((looking-at "begin\\>") (setq indent (+ indent simula-indent-level))) ((looking-at "end\\>") - (forward-word 1) + (forward-word-strictly 1) (simula-previous-statement 1)) ((looking-at "do\\>") (setq indent (+ indent simula-substatement-offset)) (simula-find-do-match)) ((looking-at "\\(if\\|then\\|else\\)\\>") (if (memq temp '(?I ?i)) - (forward-word 1) + (forward-word-strictly 1) (setq indent (+ indent simula-substatement-offset (if (memq temp '(?T ?t)) @@ -1030,7 +1030,7 @@ If COUNT is negative, move backward instead." (and (not (bobp)) (if (eq (char-syntax (preceding-char)) ?w) (save-excursion - (backward-word 1) + (backward-word-strictly 1) (not (looking-at "begin\\|then\\|else\\|when\\|otherwise\\|do"))) (not (memq (preceding-char) '(?: ?\;)))))) @@ -1067,7 +1067,7 @@ If COUNT is negative, move backward instead." (simula-skip-comment-backward) (if (and (eq (char-syntax (preceding-char)) ?w) (progn - (backward-word 1) + (backward-word-strictly 1) (looking-at "else\\>"))) () (throw 'simula-out t))) @@ -1189,7 +1189,7 @@ If COUNT is negative, move backward instead." (if where (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w)) (save-excursion - (backward-word 1) + (backward-word-strictly 1) (not (looking-at "end\\>")))))) (unexpand-abbrev) (cond @@ -1204,7 +1204,7 @@ If COUNT is negative, move backward instead." ;; check if the expanded word is on the beginning of the line. (if (and (eq (char-syntax (preceding-char)) ?w) (progn - (backward-word 1) + (backward-word-strictly 1) (if (looking-at "end\\>") (save-excursion (simula-backward-up-level 1) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index fd59f4687c6..9608a7d8373 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -462,9 +462,9 @@ file. Since that is a plaintext file, this could be dangerous." :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") :completion-object sql-postgres-completion-object - :prompt-regexp "^\\w*=[#>] " + :prompt-regexp "^[[:alnum:]_]*=[#>] " :prompt-length 5 - :prompt-cont-regexp "^\\w*[-(][#>] " + :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " :input-filter sql-remove-tabs-filter :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g")) @@ -514,9 +514,9 @@ file. Since that is a plaintext file, this could be dangerous." :sqli-comint-func sql-comint-vertica :list-all ("\\d" . "\\dS") :list-table "\\d %s" - :prompt-regexp "^\\w*=[#>] " + :prompt-regexp "^[[:alnum:]_]*=[#>] " :prompt-length 5 - :prompt-cont-regexp "^\\w*[-(][#>] ") + :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] ") ) "An alist of product specific configuration settings. @@ -1072,14 +1072,26 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." :version "20.8" :group 'SQL) -(defcustom sql-postgres-login-params `((user :default ,(user-login-name)) - (database :default ,(user-login-name)) - server) +(defcustom sql-postgres-login-params + `((user :default ,(user-login-name)) + (database :default ,(user-login-name) + :completion ,(completion-table-dynamic + (lambda (_) (sql-postgres-list-databases)))) + server) "List of login parameters needed to connect to Postgres." :type 'sql-login-params :version "24.1" :group 'SQL) +(defun sql-postgres-list-databases () + "Return a list of available PostgreSQL databases." + (when (executable-find sql-postgres-program) + (let ((res '())) + (dolist (row (process-lines sql-postgres-program "-ltX")) + (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) + (push (match-string 1 row) res))) + (nreverse res)))) + ;; Customization for Interbase (defcustom sql-interbase-program "isql" @@ -1340,7 +1352,7 @@ Based on `comint-mode-map'.") ;; double quotes (") don't delimit strings (modify-syntax-entry ?\" "." table) ;; Make these all punctuation - (mapc #'(lambda (c) (modify-syntax-entry c "." table)) + (mapc (lambda (c) (modify-syntax-entry c "." table)) (string-to-list "!#$%&+,.:;<=>?@\\|")) table) "Syntax table used in `sql-mode' and `sql-interactive-mode'.") @@ -2441,7 +2453,7 @@ highlighting rules in SQL mode.") (let ((init (or (and initial (symbol-name initial)) "ansi"))) (intern (completing-read prompt - (mapcar #'(lambda (info) (symbol-name (car info))) + (mapcar (lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match init 'sql-product-history init)))) @@ -2476,7 +2488,7 @@ configuration." ;; after this product's name. (let ((next-item) (down-display (downcase display))) - (map-keymap #'(lambda (k b) + (map-keymap (lambda (k b) (when (and (not next-item) (string-lessp down-display (downcase (cadr b)))) @@ -2582,7 +2594,7 @@ also be configured." (font-lock-mode-internal t)) (add-hook 'font-lock-mode-hook - #'(lambda () + (lambda () ;; Provide defaults for new font-lock faces. (defvar font-lock-builtin-face (if (boundp 'font-lock-preprocessor-face) @@ -2631,7 +2643,7 @@ adds a fontification pattern to fontify identifiers ending in "Iterate through login parameters and return a list of results." (delq nil (mapcar - #'(lambda (param) + (lambda (param) (let ((token (or (car-safe param) param)) (plist (cdr-safe param))) (funcall body token plist))) @@ -2643,7 +2655,7 @@ adds a fontification pattern to fontify identifiers ending in (defun sql-product-syntax-table () (let ((table (copy-syntax-table sql-mode-syntax-table))) - (mapc #'(lambda (entry) + (mapc (lambda (entry) (modify-syntax-entry (car entry) (cdr entry) table)) (sql-get-product-feature sql-product :syntax-alist)) table)) @@ -2652,7 +2664,7 @@ adds a fontification pattern to fontify identifiers ending in (append ;; Change all symbol character to word characters (mapcar - #'(lambda (entry) (if (string= (substring (cdr entry) 0 1) "_") + (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_") (cons (car entry) (concat "w" (substring (cdr entry) 1))) entry)) @@ -3025,7 +3037,7 @@ In order to qualify, the SQLi buffer must be alive, be in buf) ;; Look thru each buffer (car (apply #'append - (mapcar #'(lambda (b) + (mapcar (lambda (b) (and (sql-buffer-live-p b prod connection) (list (buffer-name b)))) (buffer-list))))))) @@ -3112,7 +3124,7 @@ server/database name." (apply #'append nil (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) - #'(lambda (token plist) + (lambda (token plist) (pcase token (`user (unless (string= "" sql-user) @@ -3278,12 +3290,12 @@ Allows the suppression of continuation prompts.") ((functionp filter) (setq string (funcall filter string))) ((listp filter) - (mapc #'(lambda (f) (setq string (funcall f string))) filter)) + (mapc (lambda (f) (setq string (funcall f string))) filter)) (t nil)) ;; Count how many newlines in the string (setq sql-output-newline-count - (apply #'+ (mapcar #'(lambda (ch) + (apply #'+ (mapcar (lambda (ch) (if (eq ch ?\n) 1 0)) string))) ;; Send the string @@ -3510,7 +3522,7 @@ list of SQLi command strings." (when visible (message "Executing SQL command...")) (if (consp command) - (mapc #'(lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) + (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) command) (sql-redirect-one sqlbuf command outbuf save-prior)) (when visible @@ -3594,7 +3606,7 @@ for each match." (match-string regexp-groups)) ;; list of numbers; return the specified matches only ((consp regexp-groups) - (mapcar #'(lambda (c) + (mapcar (lambda (c) (cond ((numberp c) (match-string c)) ((stringp c) (match-substitute-replacement c)) @@ -3624,7 +3636,7 @@ strings are formatted with ARG and executed. If the results are empty the OUTBUF is deleted, otherwise the buffer is popped into a view window." (mapc - #'(lambda (c) + (lambda (c) (cond ((stringp c) (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t) @@ -4009,7 +4021,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." "Read a connection name." (let ((completion-ignore-case t)) (completing-read prompt - (mapcar #'(lambda (c) (car c)) + (mapcar (lambda (c) (car c)) sql-connection-alist) nil t initial 'sql-connection-history default))) @@ -4040,6 +4052,12 @@ is specified in the connection settings." (if connect-set ;; Set the desired parameters (let (param-var login-params set-params rem-params) + ;; Set the parameters and start the interactive session + (mapc + (lambda (vv) + (set-default (car vv) (eval (cadr vv)))) + (cdr connect-set)) + (setq-default sql-connection connection) ;; :sqli-login params variable (setq param-var @@ -4052,7 +4070,7 @@ is specified in the connection settings." ;; Params in the connection (setq set-params (mapcar - #'(lambda (v) + (lambda (v) (pcase (car v) (`sql-user 'user) (`sql-password 'password) @@ -4065,17 +4083,10 @@ is specified in the connection settings." ;; the remaining params (w/o the connection params) (setq rem-params (sql-for-each-login login-params - #'(lambda (token plist) + (lambda (token plist) (unless (member token set-params) (if plist (cons token plist) token))))) - ;; Set the parameters and start the interactive session - (mapc - #'(lambda (vv) - (set-default (car vv) (eval (cadr vv)))) - (cdr connect-set)) - (setq-default sql-connection connection) - ;; Start the SQLi session with revised list of login parameters (eval `(let ((,param-var ',rem-params)) (sql-product-interactive ',sql-product ',new-name)))) @@ -4125,7 +4136,7 @@ optionally is saved to the user's init file." (cons name (sql-for-each-login `(product ,@login) - #'(lambda (token _plist) + (lambda (token _plist) (pcase token (`product `(sql-product ',product)) (`user `(sql-user ,user)) @@ -4144,7 +4155,7 @@ optionally is saved to the user's init file." "Generate menu entries for using each connection." (append (mapcar - #'(lambda (conn) + (lambda (conn) (vector (format "Connection <%s>\t%s" (car conn) (let ((sql-user "") (sql-database "") @@ -4428,7 +4439,7 @@ The default comes from `process-coding-system-alist' and ;; Remove any settings that haven't changed (mapc - #'(lambda (one-cur-setting) + (lambda (one-cur-setting) (setq saved-settings (delete one-cur-setting saved-settings))) (sql-oracle-save-settings sqlbuf)) @@ -4946,7 +4957,7 @@ Try to set `comint-output-filter-functions' like this: (sql-redirect sqlbuf "\\a")) ;; Return the list of table names (public schema name can be omitted) - (mapcar #'(lambda (tbl) + (mapcar (lambda (tbl) (if (string= (car tbl) "public") (format "\"%s\"" (cadr tbl)) (format "\"%s\".\"%s\"" (car tbl) (cadr tbl)))) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 987022e8cb3..00b287e69e6 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1109,7 +1109,7 @@ try to increase performance by using this macro." ((and (save-excursion (vera-backward-syntactic-ws nil t) ;; previous line ends with a block opening? - (or (/= (skip-chars-backward "{") 0) (backward-word 1)) + (or (/= (skip-chars-backward "{") 0) (backward-word-strictly 1)) (when (looking-at vera-beg-block-re) ;; go to beginning of substatement (vera-beginning-of-substatement) @@ -1162,7 +1162,7 @@ try to increase performance by using this macro." ;; is this line preceded by a substatement opening statement? ((save-excursion (vera-backward-syntactic-ws nil t) (when (= (preceding-char) ?\)) (backward-sexp)) - (backward-word 1) + (backward-word-strictly 1) (setq placeholder (point)) (looking-at vera-beg-substatement-re)) (goto-char placeholder) @@ -1225,7 +1225,7 @@ Calls `indent-region' for whole buffer." "If previous word is a block closing or `else', indent line again." (when (= (char-syntax (preceding-char)) ?w) (save-excursion - (backward-word 1) + (backward-word-strictly 1) (when (and (not (vera-in-literal)) (looking-at (concat vera-end-block-re "\\|\\<else\\>"))) (indent-according-to-mode))))) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6b6cc643ffc..5368b613569 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,7 +123,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2015-11-21-8112ca0-vpo-GNU" +(defconst verilog-mode-version "2016-11-14-26d3540-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -349,6 +349,11 @@ wherever possible, since it is slow." (condition-case nil (unless (fboundp 'prog-mode) (define-derived-mode prog-mode fundamental-mode "Prog")) + (error nil)) + ;; Added in Emacs 25.1 + (condition-case nil + (unless (fboundp 'forward-word-strictly) + (defalias 'forward-word-strictly 'forward-word)) (error nil))) (eval-when-compile @@ -748,6 +753,13 @@ mode is experimental." :type 'boolean) (put 'verilog-auto-declare-nettype 'safe-local-variable `stringp) +(defcustom verilog-auto-wire-comment t + "Non-nil indicates to insert to/from comments with `verilog-auto-wire' etc." + :version "25.1" + :group 'verilog-mode-actions + :type 'boolean) +(put 'verilog-auto-wire-comment 'safe-local-variable `verilog-booleanp) + (defcustom verilog-auto-wire-type nil "Non-nil specifies the data type to use with `verilog-auto-wire' etc. Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'." @@ -1126,32 +1138,67 @@ be replaced, and will remain symbolic. For example, imagine a submodule uses parameters to declare the size of its inputs. This is then used by an upper module: - module InstModule (o,i); - parameter WIDTH; - input [WIDTH-1:0] i; - endmodule + module InstModule (o,i); + parameter WIDTH; + input [WIDTH-1:0] i; + parameter type OUT_t; + output OUT_t o; + endmodule - module ExampInst; - InstModule - #(.PARAM(10)) - instName - (/*AUTOINST*/ - .i (i[PARAM-1:0])); + module ExampInst; + /*AUTOOUTPUT*/ + // Beginning of automatic outputs + output OUT_t o; + // End of automatics + + InstModule + #(.WIDTH(10), + ,.OUT_t(upper_t)) + instName + (/*AUTOINST*/ + .i (i[WIDTH-1:0]), + .o (o)); + +Note even though WIDTH=10, the AUTOINST has left the parameter as +a symbolic name. Likewise the OUT_t is preserved as the name +from the instantiated module. -Note even though PARAM=10, the AUTOINST has left the parameter as a -symbolic name. If `verilog-auto-inst-param-value' is set, this will +If `verilog-auto-inst-param-value' is set, this will instead expand to: module ExampInst; - InstModule - #(.PARAM(10)) - instName - (/*AUTOINST*/ - .i (i[9:0]));" + /*AUTOOUTPUT*/ + // Beginning of automatic outputs + output upper_t o; + // End of automatics + + InstModule + #(.WIDTH(10), + ,.OUT_t(upper_t)) + instName + (/*AUTOINST*/ + .i (i[9:0]), + .o (o)); + +Note that the instantiation now has \"i[9:0]\" as the WIDTH +was expanded. Likewise the data type of \"o\" in the AUTOOUTPUT +is now upper_t, from the OUT_t parameter override. +This second expansion of parameter types can be overridden with +`verilog-auto-inst-param-value-type'." :group 'verilog-mode-auto :type 'boolean) (put 'verilog-auto-inst-param-value 'safe-local-variable 'verilog-booleanp) +(defcustom verilog-auto-inst-param-value-type t + "Non-nil means expand parameter type in instantiations. +If nil, leave parameter types as symbolic names. + +See `verilog-auto-inst-param-value'." + :version "25.1" + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-inst-param-value-type 'safe-local-variable 'verilog-booleanp) + (defcustom verilog-auto-inst-sort nil "Non-nil means AUTOINST signals will be sorted, not in declaration order. Also affects AUTOINSTPARAM. Declaration order is the default for @@ -1321,8 +1368,13 @@ See also `verilog-case-fold'." :type 'hook) (defvar verilog-imenu-generic-expression - '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4) - ("*Vars*" "^\\s-*\\(reg\\|wire\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3)) + '((nil "^\\s-*\\(?:m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1) + ("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3) + ("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1) + ("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) + ("*Functions*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*function\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\(?:\\w+\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) + ("*Interfaces*" "^\\s-*interface\\s-+\\([a-zA-Z_0-9]+\\)" 1) + ("*Types*" "^\\s-*typedef\\s-+.*\\s-+\\([a-zA-Z_0-9]+\\)\\s-*;" 1)) "Imenu expression for Verilog mode. See `imenu-generic-expression'.") ;; @@ -1374,7 +1426,7 @@ If set will become buffer local.") (define-key map "\C-c\C-i" 'verilog-pretty-declarations) (define-key map "\C-c=" 'verilog-pretty-expr) (define-key map "\C-c\C-b" 'verilog-submit-bug-report) - (define-key map "\M-*" 'verilog-star-comment) + (define-key map "\C-c/" 'verilog-star-comment) (define-key map "\C-c\C-c" 'verilog-comment-region) (define-key map "\C-c\C-u" 'verilog-uncomment-region) (when (featurep 'xemacs) @@ -1751,7 +1803,7 @@ so there may be a large up front penalty for the first search." (let (pt) (while (and (not pt) (re-search-forward regexp bound noerror)) - (if (verilog-inside-comment-or-string-p) + (if (verilog-inside-comment-or-string-p (match-beginning 0)) (re-search-forward "[/\"\n]" nil t) ; Only way a comment or quote can end (setq pt (match-end 0)))) pt)) @@ -1765,7 +1817,7 @@ so there may be a large up front penalty for the first search." (let (pt) (while (and (not pt) (re-search-backward regexp bound noerror)) - (if (verilog-inside-comment-or-string-p) + (if (verilog-inside-comment-or-string-p (match-beginning 0)) (re-search-backward "[/\"]" nil t) ; Only way a comment or quote can begin (setq pt (match-beginning 0)))) pt)) @@ -2551,15 +2603,15 @@ find the errors." "\\|\\(\\<table\\>\\)" ;7 "\\|\\(\\<specify\\>\\)" ;8 "\\|\\(\\<function\\>\\)" ;9 - "\\|\\(\\(\\(\\<virtual\\>\\s-+\\)\\|\\(\\<protected\\>\\s-+\\)\\)*\\<function\\>\\)" ;10 - "\\|\\(\\<task\\>\\)" ;14 - "\\|\\(\\(\\(\\<virtual\\>\\s-+\\)\\|\\(\\<protected\\>\\s-+\\)\\)*\\<task\\>\\)" ;15 - "\\|\\(\\<generate\\>\\)" ;18 - "\\|\\(\\<covergroup\\>\\)" ;16 20 - "\\|\\(\\(\\(\\<cover\\>\\s-+\\)\\|\\(\\<assert\\>\\s-+\\)\\)*\\<property\\>\\)" ;17 21 - "\\|\\(\\<\\(rand\\)?sequence\\>\\)" ;21 25 - "\\|\\(\\<clocking\\>\\)" ;22 27 - "\\|\\(\\<`[ou]vm_[a-z_]+_begin\\>\\)" ;28 + "\\|\\(\\(?:\\<\\(?:virtual\\|protected\\|static\\)\\>\\s-+\\)*\\<function\\>\\)" ;10 + "\\|\\(\\<task\\>\\)" ;11 + "\\|\\(\\(?:\\<\\(?:virtual\\|protected\\|static\\)\\>\\s-+\\)*\\<task\\>\\)" ;12 + "\\|\\(\\<generate\\>\\)" ;13 + "\\|\\(\\<covergroup\\>\\)" ;14 + "\\|\\(\\(?:\\(?:\\<cover\\>\\s-+\\)\\|\\(?:\\<assert\\>\\s-+\\)\\)*\\<property\\>\\)" ;15 + "\\|\\(\\<\\(?:rand\\)?sequence\\>\\)" ;16 + "\\|\\(\\<clocking\\>\\)" ;17 + "\\|\\(\\<`[ou]vm_[a-z_]+_begin\\>\\)" ;18 "\\|\\(\\<`vmm_[a-z_]+_member_begin\\>\\)" ;; )) @@ -2802,10 +2854,12 @@ find the errors." "\\(\\<\\(import\\|export\\)\\>\\s-+\"DPI\\(-C\\)?\"\\s-+\\(\\<\\(context\\|pure\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-*=\\s-*\\)?\\<\\(function\\|task\\)\\>\\)" )) +(defconst verilog-default-clocking-re "\\<default\\s-+clocking\\>") (defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>") -(defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)") +(defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\|randcase\\)") (defconst verilog-extended-complete-re - (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" + ;; verilog-beg-of-statement also looks backward one token to extend this match + (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\|\\<static\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)" "\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)" "\\|\\(\\(\\<\\(import\\|export\\)\\>\\s-+\\)?\\(\"DPI\\(-C\\)?\"\\s-+\\)?\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-*=\\s-*\\)?\\(function\\>\\|task\\>\\)\\)" "\\|" verilog-extended-case-re )) @@ -3026,7 +3080,7 @@ See also `verilog-font-lock-extra-types'.") "Font lock mode face used to highlight AMS keywords." :group 'font-lock-highlighting-faces) -(defvar verilog-font-grouping-keywords-face +(defvar verilog-font-lock-grouping-keywords-face 'verilog-font-lock-grouping-keywords-face "Font to use for Verilog Grouping Keywords (such as begin..end).") (defface verilog-font-lock-grouping-keywords-face @@ -3470,7 +3524,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (found nil) (st (point))) (if (not (looking-at "\\<")) - (forward-word -1)) + (forward-word-strictly -1)) (cond ((verilog-skip-backward-comment-or-string)) ((looking-at "\\<else\\>") @@ -3522,7 +3576,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (st (point)) (nest 'yes)) (if (not (looking-at "\\<")) - (forward-word -1)) + (forward-word-strictly -1)) (cond ((verilog-skip-forward-comment-or-string) (verilog-forward-syntactic-ws)) @@ -3545,11 +3599,11 @@ Use filename, if current buffer being edited shorten to just buffer name." (and (looking-at "fork") (progn (setq here (point)) ; sometimes a fork is just a fork - (forward-word -1) + (forward-word-strictly -1) (looking-at verilog-disable-fork-re)))) (progn ; it is a disable fork; ignore it (goto-char (match-end 0)) - (forward-word 1) + (forward-word-strictly 1) (setq reg nil)) (progn ; it is a nice simple fork (goto-char here) ; return from looking for "disable fork" @@ -3574,32 +3628,32 @@ Use filename, if current buffer being edited shorten to just buffer name." ;; Search forward for matching endfunction (setq reg "\\<endfunction\\>" ) (setq nest 'no)) - ((match-end 14) + ((match-end 11) ;; Search forward for matching endtask (setq reg "\\<endtask\\>" ) (setq nest 'no)) - ((match-end 15) + ((match-end 12) ;; Search forward for matching endtask (setq reg "\\<endtask\\>" ) (setq nest 'no)) - ((match-end 19) + ((match-end 12) ;; Search forward for matching endgenerate (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" )) - ((match-end 20) + ((match-end 13) ;; Search forward for matching endgroup (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )) - ((match-end 21) + ((match-end 14) ;; Search forward for matching endproperty (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" )) - ((match-end 25) + ((match-end 15) ;; Search forward for matching endsequence (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) (setq md 3)) ; 3 to get to endsequence in the reg above - ((match-end 27) + ((match-end 17) ;; Search forward for matching endclocking (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" ))) (if (and reg - (forward-word 1)) + (forward-word-strictly 1)) (catch 'skip (if (eq nest 'yes) (let ((depth 1) @@ -3618,7 +3672,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (looking-at verilog-disable-fork-re) (and (looking-at "fork") (progn - (forward-word -1) + (forward-word-strictly -1) (looking-at verilog-disable-fork-re)))) (progn ; it is a disable fork; another false alarm (goto-char (match-end 0))) @@ -3870,6 +3924,28 @@ Key bindings specific to `verilog-mode-map' are: (add-hook 'write-contents-hooks 'verilog-auto-save-check nil 'local) ;; verilog-mode-hook call added by define-derived-mode ) + +;;; Integration with the speedbar +;; + +;; Avoid problems with XEmacs byte-compiles. +;; For GNU Emacs, the eval-after-load will handle if it isn't loaded yet. +(when (eval-when-compile (fboundp 'declare-function)) + (declare-function speedbar-add-supported-extension "speedbar" (extension))) + +(defun verilog-speedbar-initialize () + "Initialize speedbar to understand `verilog-mode'." + ;; Set Verilog file extensions (extracted from `auto-mode-alist') + (let ((mode-alist auto-mode-alist)) + (while mode-alist + (when (eq (cdar mode-alist) 'verilog-mode) + (speedbar-add-supported-extension (caar mode-alist))) + (setq mode-alist (cdr mode-alist))))) + +;; If the speedbar is loaded, execute initialization instructions right away, +;; otherwise add the initialization instructions to the speedbar loader. +(eval-after-load "speedbar" '(verilog-speedbar-initialize)) + ;;; Electric functions: ;; @@ -4292,7 +4368,7 @@ Uses `verilog-scan' cache." ;; stop if we see a named coverpoint (looking-at "\\w+\\W*:\\W*\\(coverpoint\\|cross\\|constraint\\)") ;; keep going if we are in the middle of a word - (not (or (looking-at "\\<") (forward-word -1))) + (not (or (looking-at "\\<") (forward-word-strictly -1))) ;; stop if we see an assertion (perhaps labeled) (and (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)") @@ -4537,7 +4613,7 @@ Limit search to point LIM." (progn (if (verilog-re-search-backward - "\\<\\(case[zx]?\\)\\>\\|;\\|\\<end\\>" nil 'move) + "\\<\\(randcase\\|case[zx]?\\)\\>\\|;\\|\\<end\\>" nil 'move) (progn (cond ((match-end 1) @@ -4841,7 +4917,7 @@ primitive or interface named NAME." ((looking-at "\\<end\\>") ;; HERE - (forward-word 1) + (forward-word-strictly 1) (verilog-forward-syntactic-ws) (setq err nil) (setq str (verilog-get-expr)) @@ -5663,13 +5739,17 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (goto-char here) (throw 'nesting 'block))))) - ((match-end 27) ; *sigh* might be a clocking declaration + ((match-end 17) ; *sigh* might be a clocking declaration (let ((here (point))) - (if (verilog-in-paren) - t ; this is a normal statement - (progn ; or is fork, starts a new block - (goto-char here) - (throw 'nesting 'block))))) + (cond ((verilog-in-paren) + t) ; this is a normal statement + ((save-excursion + (verilog-beg-of-statement) + (looking-at verilog-default-clocking-re)) + t) ; default clocking, normal statement + (t + (goto-char here) ; or is clocking, starts a new block + (throw 'nesting 'block))))) ;; need to consider typedef struct here... ((looking-at "\\<class\\|struct\\|function\\|task\\>") @@ -5797,7 +5877,7 @@ Jump from end to matching begin, from endcase to matching case, and so on." "\\(\\<endcase\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))) ((looking-at "\\<endtask\\>") ;; 2: Search back for matching task - (setq reg "\\(\\<task\\>\\)\\|\\(\\(\\(\\<virtual\\>\\s-+\\)\\|\\(\\<protected\\>\\s-+\\)\\)+\\<task\\>\\)") + (setq reg "\\(\\<task\\>\\)\\|\\(\\(\\<\\(virtual\\|protected\\|static\\)\\>\\s-+\\)+\\<task\\>\\)") (setq nesting 'no)) ((looking-at "\\<endcase\\>") (catch 'nesting @@ -5819,7 +5899,7 @@ Jump from end to matching begin, from endcase to matching case, and so on." (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" )) ((looking-at "\\<endfunction\\>") ;; 8: Search back for matching function - (setq reg "\\(\\<function\\>\\)\\|\\(\\(\\(\\<virtual\\>\\s-+\\)\\|\\(\\<protected\\>\\s-+\\)\\)+\\<function\\>\\)") + (setq reg "\\(\\<function\\>\\)\\|\\(\\(\\<\\(virtual\\|protected\\|static\\)\\>\\s-+\\)+\\<function\\>\\)") (setq nesting 'no)) ;;(setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" )) ((looking-at "\\<endgenerate\\>") @@ -5956,7 +6036,7 @@ Set point to where line starts." (verilog-backward-up-list 1) (verilog-backward-syntactic-ws) (let ((back (point))) - (forward-word -1) + (forward-word-strictly -1) (cond ;;XX ((looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|case\\(\\|[xz]\\)\\|for\\(\\|each\\|ever\\)\\|i\\(f\\|nitial\\)\\|repeat\\|while\\)\\>") @@ -5997,11 +6077,11 @@ Set point to where line starts." (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete t - (forward-word -1) + (forward-word-strictly -1) (while (or (= (preceding-char) ?\_) (= (preceding-char) ?\@) (= (preceding-char) ?\.)) - (forward-word -1)) + (forward-word-strictly -1)) (cond ((looking-at "\\<else\\>") t) @@ -6271,7 +6351,7 @@ Return >0 for nested struct." (let ((p (point))) (and (equal (char-after) ?\{) - (forward-list) + (ignore-errors (forward-list)) (progn (backward-char 1) (verilog-backward-ws&directives) (and @@ -6515,7 +6595,7 @@ Only look at a few lines to determine indent level." (= (following-char) ?\`)) (progn (forward-char 1) - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward " \t"))) ((= (following-char) ?\[) (progn @@ -7802,7 +7882,7 @@ See also `verilog-sk-header' for an alternative format." (if (verilog-sig-multidim sig) (let ((str "") (args (verilog-sig-multidim sig))) (while args - (setq str (concat str (car args))) + (setq str (concat (car args) str)) (setq args (cdr args))) str))) (defsubst verilog-sig-modport (sig) @@ -8323,7 +8403,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." in-modport in-clocking in-ign-to-semi ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const sigs-gparam sigs-intf sigs-modports - vec expect-signal keywd newsig rvalue enum io signed typedefed multidim + vec expect-signal keywd last-keywd newsig rvalue enum io + signed typedefed multidim modport varstack tmp) ;;(if dbg (setq dbg (concat dbg (format "\n\nverilog-read-decls START PT %s END %s\n" (point) end-mod-point)))) @@ -8404,7 +8485,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;; Normal or escaped identifier -- note we remember the \ if escaped ((looking-at "\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") (goto-char (match-end 0)) - (setq keywd (match-string-no-properties 1)) + (setq last-keywd keywd + keywd (match-string-no-properties 1)) (when (string-match "^\\\\" (match-string 1)) (setq keywd (concat keywd " "))) ; Escaped ID needs space at end ;; Add any :: package names to same identifier @@ -8469,7 +8551,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq functask (1- functask))) ((equal keywd "modport") (setq in-modport t)) - ((equal keywd "clocking") + ((and (equal keywd "clocking") + (not (equal last-keywd "default"))) (setq in-clocking t)) ((equal keywd "import") (if v2kargs-ok ; import in module header, not a modport import @@ -8594,12 +8677,20 @@ Return an array of [outputs inouts inputs wire reg assign const]." (defvar create-lockfiles) (defvar which-func-modes)) -(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim mem) +(defun verilog-read-sub-decls-type (par-values portdata) + "For `verilog-read-sub-decls-line', decode a signal type." + (let* ((type (verilog-sig-type portdata)) + (pvassoc (assoc type par-values))) + (cond ((member type '("wire" "reg")) nil) + (pvassoc (nth 1 pvassoc)) + (t type)))) + +(defun verilog-read-sub-decls-sig (submoddecls par-values comment port sig vec multidim mem) "For `verilog-read-sub-decls-line', add a signal." ;; sig eq t to indicate .name syntax ;;(message "vrsds: %s(%S)" port sig) (let ((dotname (eq sig t)) - portdata) + portdata) (when sig (setq port (verilog-symbol-detick-denumber port)) (setq sig (if dotname port (verilog-symbol-detick-denumber sig))) @@ -8618,8 +8709,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." mem nil (verilog-sig-signed portdata) - (unless (member (verilog-sig-type portdata) '("wire" "reg")) - (verilog-sig-type portdata)) + (verilog-read-sub-decls-type par-values portdata) multidim nil) sigs-inout))) ((or (setq portdata (assoc port (verilog-decls-get-outputs submoddecls))) @@ -8637,8 +8727,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;; Also for backwards compatibility we don't propagate ;; "input wire" upwards. ;; See also `verilog-signals-edit-wire-reg'. - (unless (member (verilog-sig-type portdata) '("wire" "reg")) - (verilog-sig-type portdata)) + (verilog-read-sub-decls-type par-values portdata) multidim nil) sigs-out))) ((or (setq portdata (assoc port (verilog-decls-get-inputs submoddecls))) @@ -8651,8 +8740,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." mem nil (verilog-sig-signed portdata) - (unless (member (verilog-sig-type portdata) '("wire" "reg")) - (verilog-sig-type portdata)) + (verilog-read-sub-decls-type par-values portdata) multidim nil) sigs-in))) ((setq portdata (assoc port (verilog-decls-get-interfaces submoddecls))) @@ -8664,7 +8752,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." mem nil (verilog-sig-signed portdata) - (verilog-sig-type portdata) + (verilog-read-sub-decls-type par-values portdata) multidim nil) sigs-intf))) ((setq portdata (and verilog-read-sub-decls-in-interfaced @@ -8677,13 +8765,13 @@ Return an array of [outputs inouts inputs wire reg assign const]." mem nil (verilog-sig-signed portdata) - (verilog-sig-type portdata) + (verilog-read-sub-decls-type par-values portdata) multidim nil) sigs-intf))) ;; (t -- warning pin isn't defined.) ; Leave for lint tool ))))) -(defun verilog-read-sub-decls-expr (submoddecls comment port expr) +(defun verilog-read-sub-decls-expr (submoddecls par-values comment port expr) "For `verilog-read-sub-decls-line', parse a subexpression and add signals." ;;(message "vrsde: `%s'" expr) ;; Replace special /*[....]*/ comments inserted by verilog-auto-inst-port @@ -8699,7 +8787,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (let ((mlst (split-string (match-string 1 expr) "[{},]")) mstr) (while (setq mstr (pop mlst)) - (verilog-read-sub-decls-expr submoddecls comment port mstr))))) + (verilog-read-sub-decls-expr submoddecls par-values comment port mstr))))) (t (let (sig vec multidim mem) ;; Remove leading reduction operators, etc @@ -8722,16 +8810,16 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq vec (match-string 1 expr) expr (substring expr (match-end 0)))) ;; Find .[unpacked_memory] or .[unpacked][unpacked]... - (while (string-match "^\\s-*\\.\\(\\[[^]]+\\]\\)" expr) + (while (string-match "^\\s-*\\.\\(\\(\\[[^]]+\\]\\)+\\)" expr) ;;(message "vrsde-m: `%s'" (match-string 1 expr)) (setq mem (match-string 1 expr) expr (substring expr (match-end 0)))) ;; If found signal, and nothing unrecognized, add the signal ;;(message "vrsde-rem: `%s'" expr) (when (and sig (string-match "^\\s-*$" expr)) - (verilog-read-sub-decls-sig submoddecls comment port sig vec multidim mem)))))) + (verilog-read-sub-decls-sig submoddecls par-values comment port sig vec multidim mem)))))) -(defun verilog-read-sub-decls-line (submoddecls comment) +(defun verilog-read-sub-decls-line (submoddecls par-values comment) "For `verilog-read-sub-decls', read lines of port defs until none match. Inserts the list of signals found, using submodi to look up each port." (let (done port) @@ -8749,13 +8837,13 @@ Inserts the list of signals found, using submodi to look up each port." ;; .name ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*[,)/]") (verilog-read-sub-decls-sig - submoddecls comment (match-string-no-properties 1) t ; sig==t for .name + submoddecls par-values comment (match-string-no-properties 1) t ; sig==t for .name nil nil nil) ; vec multidim mem (setq port nil)) ;; .\escaped_name ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*[,)/]") (verilog-read-sub-decls-sig - submoddecls comment (concat (match-string-no-properties 1) " ") t ; sig==t for .name + submoddecls par-values comment (concat (match-string-no-properties 1) " ") t ; sig==t for .name nil nil nil) ; vec multidim mem (setq port nil)) ;; random @@ -8770,28 +8858,29 @@ Inserts the list of signals found, using submodi to look up each port." (when port (cond ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig - submoddecls comment port + submoddecls par-values comment port (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig nil nil nil)) ; vec multidim mem ;; ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)") (verilog-read-sub-decls-sig - submoddecls comment port + submoddecls par-values comment port (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig (match-string-no-properties 2) nil nil)) ; vec multidim mem ;; Fastpath was above looking-at's. ;; For something more complicated invoke a parser ((looking-at "[^)]+") (verilog-read-sub-decls-expr - submoddecls comment port + submoddecls par-values comment port (buffer-substring-no-properties (point) (1- (progn (search-backward "(") ; start at ( (verilog-forward-sexp-ign-cmt 1) (point)))))))) ; expr ;; (forward-line 1))))) +;;(verilog-read-sub-decls-line (verilog-subdecls-new nil nil nil nil nil) nil "Cmt") -(defun verilog-read-sub-decls-gate (submoddecls comment submod end-inst-point) +(defun verilog-read-sub-decls-gate (submoddecls par-values comment submod end-inst-point) "For `verilog-read-sub-decls', read lines of UDP gate decl until none match. Inserts the list of signals found." (save-excursion @@ -8815,7 +8904,7 @@ Inserts the list of signals found." (setq verilog-read-sub-decls-gate-ios (or (car iolist) "input") iolist (cdr iolist)) (verilog-read-sub-decls-expr - submoddecls comment "primitive_port" + submoddecls par-values comment "primitive_port" (match-string 0))) (t (forward-char 1) @@ -8841,13 +8930,16 @@ Outputs comments above subcell signals, for example: .in (in));" (save-excursion (let ((end-mod-point (verilog-get-end-of-defun)) - st-point end-inst-point + st-point end-inst-point par-values ;; below 3 modified by verilog-read-sub-decls-line sigs-out sigs-inout sigs-in sigs-intf sigs-intfd) (verilog-beg-of-defun-quick) (while (verilog-re-search-forward-quick "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-mod-point t) (save-excursion (goto-char (match-beginning 0)) + (setq par-values (and verilog-auto-inst-param-value + verilog-auto-inst-param-value-type + (verilog-read-inst-param-value))) (unless (verilog-inside-comment-or-string-p) ;; Attempt to snarf a comment (let* ((submod (verilog-read-inst-module)) @@ -8865,7 +8957,7 @@ Outputs comments above subcell signals, for example: (point)) st-point (point)) (forward-char 1) - (verilog-read-sub-decls-gate submoddecls comment submod end-inst-point)) + (verilog-read-sub-decls-gate submoddecls par-values comment submod end-inst-point)) ;; Non-primitive (t (when (setq submodi (verilog-modi-lookup submod t)) @@ -8879,19 +8971,19 @@ Outputs comments above subcell signals, for example: ;; However I want it to be runnable even on user's manually added signals (let ((verilog-read-sub-decls-in-interfaced t)) (while (re-search-forward "\\s *(?\\s *// Interfaced" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment))) ; Modifies sigs-ifd + (verilog-read-sub-decls-line submoddecls par-values comment))) ; Modifies sigs-ifd (goto-char st-point) (while (re-search-forward "\\s *(?\\s *// Interfaces" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-out + (verilog-read-sub-decls-line submoddecls par-values comment)) ; Modifies sigs-out (goto-char st-point) (while (re-search-forward "\\s *(?\\s *// Outputs" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-out + (verilog-read-sub-decls-line submoddecls par-values comment)) ; Modifies sigs-out (goto-char st-point) (while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-inout + (verilog-read-sub-decls-line submoddecls par-values comment)) ; Modifies sigs-inout (goto-char st-point) (while (re-search-forward "\\s *(?\\s *// Inputs" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-in + (verilog-read-sub-decls-line submoddecls par-values comment)) ; Modifies sigs-in ))))))) ;; Combine duplicate bits ;;(setq rr (vector sigs-out sigs-inout sigs-in)) @@ -9016,7 +9108,8 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else-other %s\n" keywd)))) (setq gotend t)) ;; Final statement? - ((and exit-keywd (equal keywd exit-keywd)) + ((and exit-keywd (and (equal keywd exit-keywd) + (not (looking-at "::")))) (setq gotend t) (forward-char (length keywd))) ;; Standard tokens... @@ -9032,7 +9125,9 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (goto-char (match-end 0)) (forward-char 1))) ((equal keywd ":") ; Case statement, begin/end label, x?y:z - (cond ((equal "endcase" exit-keywd) ; case x: y=z; statement next + (cond ((looking-at "::") + (forward-char 1)) ; Another forward-char below + ((equal "endcase" exit-keywd) ; case x: y=z; statement next (setq ignore-next nil rvalue nil)) ((equal "?" exit-keywd) ; x?y:z rvalue ) ; NOP @@ -9079,7 +9174,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." ;;(if dbg (setq dbg (concat dbg (format "\tgot-end %s\n" exit-keywd)))) (setq ignore-next nil rvalue semi-rvalue) (if (not exit-keywd) (setq end-else-check t))) - ((member keywd '("case" "casex" "casez")) + ((member keywd '("case" "casex" "casez" "randcase")) (skip-syntax-forward "w_") (verilog-read-always-signals-recurse "endcase" t nil) (setq ignore-next nil rvalue semi-rvalue) @@ -9127,7 +9222,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (verilog-read-always-signals-recurse nil nil nil) (setq sigs-out-i (append sigs-out-i sigs-out-unk) sigs-out-unk nil) - ;;(if dbg (with-current-buffer (get-buffer-create "*vl-dbg*")) (delete-region (point-min) (point-max)) (insert dbg) (setq dbg "")) + ;;(if dbg (with-current-buffer (get-buffer-create "*vl-dbg*") (delete-region (point-min) (point-max)) (insert dbg) (setq dbg ""))) ;; Return what was found (verilog-alw-new sigs-out-d sigs-out-i sigs-temp sigs-in)))) @@ -9305,29 +9400,43 @@ Optionally associate it with the specified enumeration ENUMNAME." If the filename is provided, `verilog-library-flags' will be used to resolve it. If optional RECURSE is non-nil, recurse through \\=`includes. -Parameters must be simple assignments to constants, or have their own -\"parameter\" label rather than a list of parameters. Thus: +Localparams must be simple assignments to constants, or have their own +\"localparam\" label rather than a list of localparams. Thus: - parameter X = 5, Y = 10; // Ok - parameter X = {1\\='b1, 2\\='h2}; // Ok - parameter X = {1\\='b1, 2\\='h2}, Y = 10; // Bad, make into 2 parameter lines + localparam X = 5, Y = 10; // Ok + localparam X = {1\\='b1, 2\\='h2}; // Ok + localparam X = {1\\='b1, 2\\='h2}, Y = 10; // Bad, make into 2 localparam lines Defines must be simple text substitutions, one on a line, starting at the beginning of the line. Any ifdefs or multiline comments around the define are ignored. -Defines are stored inside Emacs variables using the name vh-{definename}. +Defines are stored inside Emacs variables using the name +vh-{definename}. + +Localparams define what symbols are constants so that AUTOSENSE +will not include them in sensitivity lists. However any +parameters in the include file are not considered ports in the +including file, thus will not appear in AUTOINSTPARAM lists for a +parent module.. -This function is useful for setting vh-* variables. The file variables -feature can be used to set defines that `verilog-mode' can see; put at the -*END* of your file something like: +The file variables feature can be used to set defines that +`verilog-mode' can see; put at the *END* of your file something +like: // Local Variables: // vh-macro:\"macro_definition\" // End: If macros are defined earlier in the same file and you want their values, -you can read them automatically (provided `enable-local-eval' is on): +you can read them automatically with: + + // Local Variables: + // verilog-auto-read-includes:t + // End: + +Or a more specific alternative example, which requires having +`enable-local-eval' non-nil: // Local Variables: // eval:(verilog-read-defines) @@ -9395,6 +9504,13 @@ file. It is often useful put at the *END* of your file something like: // Local Variables: + // verilog-auto-read-includes:t + // End: + +Or the equivalent longer version, which requires having +`enable-local-eval' non-nil: + + // Local Variables: // eval:(verilog-read-defines) // eval:(verilog-read-includes) // End: @@ -9816,9 +9932,14 @@ Uses the CURRENT filename, `verilog-library-extensions', `verilog-library-directories' and `verilog-library-files' variables to build the path." ;; Return search locations for it - (append (list current) ; first, current buffer - (verilog-library-filenames module current t) - verilog-library-files)) ; finally, any libraries + (append (list current) ; first, current buffer + (verilog-library-filenames module current t) + ;; Finally any libraries; fixed up if using e.g. tramp + (mapcar (lambda (fname) + (if (file-name-absolute-p fname) + (concat (file-remote-p current) fname) + fname)) + verilog-library-files))) ;; ;; Module Information @@ -10238,8 +10359,9 @@ When MODI is non-null, also add to modi-cache, for tracking." direction)) indent-pt) (insert (if v2k "," ";")) - (if (or (not (verilog-sig-comment sig)) - (equal "" (verilog-sig-comment sig))) + (if (or (not verilog-auto-wire-comment) + (not (verilog-sig-comment sig)) + (equal "" (verilog-sig-comment sig))) (insert "\n") (indent-to (max 48 (+ indent-pt 40))) (verilog-insert "// " (verilog-sig-comment sig) "\n")) @@ -10789,9 +10911,9 @@ Ignores WHITESPACE if t, and writes output to stdout if SHOW." Differences are between buffers B1 and B2, starting at point DIFFPT. This function is called via `verilog-diff-function'." (let ((name1 (with-current-buffer b1 (buffer-file-name)))) - (verilog-warn "%s:%d: Difference in AUTO expansion found" - name1 (with-current-buffer b1 - (count-lines (point-min) diffpt))) + (verilog-warn-error "%s:%d: Difference in AUTO expansion found" + name1 (with-current-buffer b1 + (count-lines (point-min) diffpt))) (cond (noninteractive (verilog-diff-file-with-buffer name1 b2 t t)) (t @@ -13008,7 +13130,7 @@ Typing \\[verilog-auto] will make this into: (verilog-read-signals (save-excursion (verilog-re-search-backward-quick - "\\(@\\|\\<\\(begin\\|if\\|case\\|always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t) + "\\(@\\|\\<\\(begin\\|if\\|case[xz]?\\|always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t) (point)) (point))))) (save-excursion diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 664642554fa..0756c790495 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -13,10 +13,10 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst vhdl-version "3.37.1" +(defconst vhdl-version "3.38.1" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2015-01-15" +(defconst vhdl-time-stamp "2015-03-12" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -4684,7 +4684,7 @@ Usage: SPECIAL MENUES: As an alternative to the speedbar, an index menu can be added (set option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu - (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up + (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up file) for browsing the file contents (is not populated if buffer is larger than 256000). Also, a source file menu can be added (set option `vhdl-source-file-menu' to non-nil) for browsing the @@ -4876,8 +4876,6 @@ Key bindings: (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) (set (make-local-variable 'comment-start) "--") (set (make-local-variable 'comment-end) "") - (when vhdl-emacs-21 - (set (make-local-variable 'comment-padding) "")) (set (make-local-variable 'comment-column) vhdl-inline-comment-column) (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) (set (make-local-variable 'comment-start-skip) "--+\\s-*") @@ -6001,6 +5999,7 @@ keyword." ;; following search list so that we don't run into ;; semicolons in the function interface list. (backward-sexp) + (skip-chars-forward "(") (let (foundp) (while (and (not foundp) (re-search-backward @@ -6582,7 +6581,7 @@ returned point is at the first character of the \"libunit\" keyword." ;; keyword, allow for the keyword and an extra character, ;; as this will be used when looking forward for the ;; "begin" keyword. - (save-excursion (forward-word 1) (1+ (point)))) + (save-excursion (forward-word-strictly 1) (1+ (point)))) foundp literal placeholder) ;; Find the "libunit" keyword. (while (and (not foundp) @@ -6633,7 +6632,7 @@ stops due to beginning or end of buffer." ;; keyword, allow for the keyword and an extra character, ;; as this will be used when looking forward for the ;; "begin" keyword. - (save-excursion (forward-word 1) (1+ (point)))) + (save-excursion (forward-word-strictly 1) (1+ (point)))) begin-string literal) (while (and (not foundp) (re-search-backward vhdl-defun-re nil 'move)) @@ -6779,7 +6778,8 @@ statement if already at the beginning of one." ;; start point was not inside leader area ;; set stop point at word after leader (setq pos (point)))) - (forward-word 1) + (unless (looking-at "\\<else\\s-+generate\\>") + (forward-word-strictly 1)) (vhdl-forward-syntactic-ws here) (setq pos (point))) (goto-char pos) @@ -8457,7 +8457,7 @@ buffer." (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) (goto-char end) - (backward-word 1) + (backward-word-strictly 1) (vhdl-forward-sexp) (push (cons end (point)) seq-region-list) (beginning-of-line))) @@ -8929,7 +8929,7 @@ is omitted or nil." (vhdl-insert-keyword ": BLOCK ") (goto-char start) (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1) (insert "(") (if (vhdl-template-field "[guard expression]" nil t) @@ -8965,7 +8965,7 @@ is omitted or nil." (if (vhdl-template-field "[quantity name]" " USE " t) (progn (vhdl-template-field "quantity name" " => ") t) (delete-region (point) - (progn (forward-word -1) (point))) + (progn (forward-word-strictly -1) (point))) nil)) (vhdl-template-field "[quantity name]" " => " t)) (vhdl-template-field "expression") @@ -8998,7 +8998,7 @@ is omitted or nil." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (when (vhdl-template-field "expression" nil t start (point)) (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) @@ -9280,7 +9280,7 @@ a configuration declaration if not within a design unit." (interactive) (insert " ") (unexpand-abbrev) - (backward-word 1) + (backward-word-strictly 1) (vhdl-case-word 1) (forward-char 1)) @@ -9289,7 +9289,7 @@ a configuration declaration if not within a design unit." (interactive) (insert " ") (unexpand-abbrev) - (backward-word 1) + (backward-word-strictly 1) (vhdl-case-word 1) (forward-char 1) (indent-according-to-mode)) @@ -9311,9 +9311,11 @@ a configuration declaration if not within a design unit." (let (margin) (vhdl-prepare-search-1 (vhdl-insert-keyword "ELSE") - (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t)) - (equal "WHEN" (upcase (match-string 1)))) + (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t)) + (match-string 2)) (insert " ") + (unless (vhdl-sequential-statement-p) + (vhdl-insert-keyword " GENERATE")) (indent-according-to-mode) (setq margin (current-indentation)) (insert "\n") @@ -9325,15 +9327,16 @@ a configuration declaration if not within a design unit." (let ((start (point)) margin) (vhdl-insert-keyword "ELSIF ") - (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams)) (when vhdl-conditions-in-parenthesis (insert "(")) (when (vhdl-template-field "condition" nil t start (point)) (when vhdl-conditions-in-parenthesis (insert ")")) (indent-according-to-mode) (setq margin (current-indentation)) (vhdl-insert-keyword - (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n")) - (indent-to (+ margin vhdl-basic-offset)))))) + (concat " " (cond ((vhdl-sequential-statement-p) "THEN") + ((vhdl-standard-p 'ams) "USE") + (t "GENERATE")) "\n")) + (indent-to (+ margin vhdl-basic-offset))))) (defun vhdl-template-entity () "Insert an entity." @@ -9450,7 +9453,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (when (setq index (vhdl-template-field "loop variable" nil t start (point))) @@ -9591,7 +9594,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (when vhdl-conditions-in-parenthesis (insert "(")) (when (vhdl-template-field "condition" nil t start (point)) @@ -9674,7 +9677,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (delete-char 1)) (insert "\n\n") (indent-to margin) @@ -9758,11 +9761,13 @@ otherwise." (cond ((equal definition "") (insert ";")) ((equal definition "ARRAY") - (delete-region (point) (progn (forward-word -1) (point))) + (delete-region (point) (progn (forward-word-strictly -1) + (point))) (vhdl-template-array 'nature t)) ((equal definition "RECORD") (setq mid-pos (point-marker)) - (delete-region (point) (progn (forward-word -1) (point))) + (delete-region (point) (progn (forward-word-strictly -1) + (point))) (vhdl-template-record 'nature name t)) (t (vhdl-insert-keyword " ACROSS ") @@ -9875,7 +9880,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) (insert "\n") @@ -9932,7 +9937,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (insert "(") (if (not seq) @@ -10128,7 +10133,7 @@ otherwise." (vhdl-insert-keyword "WITH ") (when (vhdl-template-field "selector expression" nil t start (+ (point) 7)) - (forward-word 1) + (forward-word-strictly 1) (delete-char 1) (insert "\n") (indent-to (+ margin vhdl-basic-offset)) @@ -10250,11 +10255,13 @@ otherwise." (delete-char -4) (insert ";")) ((equal definition "ARRAY") - (delete-region (point) (progn (forward-word -1) (point))) + (delete-region (point) (progn (forward-word-strictly -1) + (point))) (vhdl-template-array 'type t)) ((equal definition "RECORD") (setq mid-pos (point-marker)) - (delete-region (point) (progn (forward-word -1) (point))) + (delete-region (point) (progn (forward-word-strictly -1) + (point))) (vhdl-template-record 'type name t)) ((equal definition "ACCESS") (insert " ") @@ -10298,7 +10305,8 @@ otherwise." (if (or (save-excursion (progn (vhdl-beginning-of-block) (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>"))) - (save-excursion (backward-word 1) (looking-at "\\<shared\\>"))) + (save-excursion (backward-word-strictly 1) + (looking-at "\\<shared\\>"))) (vhdl-insert-keyword "VARIABLE ") (if (vhdl-standard-p '87) (error "ERROR: Not within sequential block") @@ -10356,7 +10364,7 @@ otherwise." (goto-char start) (setq label (vhdl-template-field "[label]" nil t)) (unless label (delete-char 2)) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (when vhdl-conditions-in-parenthesis (insert "(")) (when (vhdl-template-field "condition" nil t start (point)) @@ -11218,7 +11226,7 @@ else insert tab (used for word completion in VHDL minibuffer)." (save-match-data (save-excursion (goto-char (match-end 5)) - (forward-word 1) + (forward-word-strictly 1) (vhdl-forward-syntactic-ws) (when (looking-at "(") (forward-sexp)) @@ -11292,19 +11300,19 @@ else insert tab (used for word completion in VHDL minibuffer)." but not if inside a comment or quote." (if (or (vhdl-in-literal) (save-excursion - (forward-word -1) + (forward-word-strictly -1) (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) (progn (insert " ") (unexpand-abbrev) - (backward-word 1) + (backward-word-strictly 1) (vhdl-case-word 1) (delete-char 1)) (if (not vhdl-electric-mode) (progn (insert " ") (unexpand-abbrev) - (backward-word 1) + (backward-word-strictly 1) (vhdl-case-word 1) (delete-char 1)) (let ((invoke-char vhdl-last-input-event) @@ -11707,7 +11715,7 @@ reflected in a subsequent paste operation." (equal "END" (upcase (match-string 1)))) (throw 'parse "ERROR: Not within an entity or component declaration")) (setq decl-type (downcase (match-string-no-properties 1))) - (forward-word 1) + (forward-word-strictly 1) (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") (setq name (match-string-no-properties 1)) (message "Reading port of %s \"%s\"..." decl-type name) @@ -12996,7 +13004,7 @@ File statistics: \"%s\"\n\ (let (pos) (save-excursion (while (and (setq pos (re-search-forward regexp bound noerror count)) - (vhdl-in-literal)))) + (save-match-data (vhdl-in-literal))))) (when pos (goto-char pos)) pos)) @@ -13005,7 +13013,7 @@ File statistics: \"%s\"\n\ (let (pos) (save-excursion (while (and (setq pos (re-search-backward regexp bound noerror count)) - (vhdl-in-literal)))) + (save-match-data (vhdl-in-literal))))) (when pos (goto-char pos)) pos)) @@ -13211,7 +13219,7 @@ File statistics: \"%s\"\n\ ;; subprogram body (when (match-string 2) (re-search-forward "^\\s-*\\<begin\\>" nil t) - (backward-word 1) + (backward-word-strictly 1) (vhdl-forward-sexp))) ;; block (recursive) ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") @@ -13224,7 +13232,7 @@ File statistics: \"%s\"\n\ (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) ;; configuration declaration ((looking-at "^\\s-*configuration\\>") - (forward-word 4) + (forward-word-strictly 4) (vhdl-forward-sexp)) (t (goto-char pos)))))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 69e6a154ae5..05cd97932a3 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -436,6 +436,8 @@ If SELECT is non-nil, select the target window." ;;; XREF buffer (part of the UI) ;; The xref buffer is used to display a set of xrefs. +(defconst xref-buffer-name "*xref*" + "The name of the buffer to show xrefs.") (defmacro xref--with-dedicated-window (&rest body) `(let* ((xref-w (get-buffer-window xref-buffer-name)) @@ -470,6 +472,9 @@ If SELECT is non-nil, select the target window." (xref--show-pos-in-buf marker buf select)) (user-error (message (error-message-string err))))) +(defvar-local xref--window nil + "The original window this xref buffer was created from.") + (defun xref-show-location-at-point () "Display the source of xref at point in the appropriate window, if any." (interactive) @@ -500,9 +505,6 @@ If SELECT is non-nil, select the target window." (back-to-indentation) (get-text-property (point) 'xref-item))) -(defvar-local xref--window nil - "The original window this xref buffer was created from.") - (defun xref-goto-xref () "Jump to the xref on the current line and select its window." (interactive) @@ -519,58 +521,86 @@ references displayed in the current *xref* buffer." (let ((fr (read-regexp "Xref query-replace (regexp)" ".*"))) (list fr (read-regexp (format "Xref query-replace (regexp) %s with: " fr))))) - (let ((reporter (make-progress-reporter (format "Saving search results...") - 0 (line-number-at-pos (point-max)))) - (counter 0) - pairs item) + (let* (item xrefs iter) + (save-excursion + (while (setq item (xref--search-property 'xref-item)) + (when (xref-match-length item) + (push item xrefs)))) (unwind-protect (progn - (save-excursion - (goto-char (point-min)) - ;; TODO: This list should be computed on-demand instead. - ;; As long as the UI just iterates through matches one by - ;; one, there's no need to compute them all in advance. - ;; Then we can throw away the reporter. - (while (setq item (xref--search-property 'xref-item)) - (when (xref-match-length item) - (save-excursion - (let* ((loc (xref-item-location item)) - (beg (xref-location-marker loc)) - (end (move-marker (make-marker) - (+ beg (xref-match-length item)) - (marker-buffer beg)))) - ;; Perform sanity check first. - (xref--goto-location loc) - ;; FIXME: The check should probably be a generic - ;; function, instead of the assumption that all - ;; matches contain the full line as summary. - ;; TODO: Offer to re-scan otherwise. - (unless (equal (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - (xref-item-summary item)) - (user-error "Search results out of date")) - (progress-reporter-update reporter (cl-incf counter)) - (push (cons beg end) pairs))))) - (setq pairs (nreverse pairs))) - (unless pairs (user-error "No suitable matches here")) - (progress-reporter-done reporter) - (xref--query-replace-1 from to pairs)) - (dolist (pair pairs) - (move-marker (car pair) nil) - (move-marker (cdr pair) nil))))) + (goto-char (point-min)) + (setq iter (xref--buf-pairs-iterator (nreverse xrefs))) + (xref--query-replace-1 from to iter)) + (funcall iter :cleanup)))) + +(defun xref--buf-pairs-iterator (xrefs) + (let (chunk-done item next-pair file-buf pairs all-pairs) + (lambda (action) + (pcase action + (:next + (when (or xrefs next-pair) + (setq chunk-done nil) + (when next-pair + (setq file-buf (marker-buffer (car next-pair)) + pairs (list next-pair) + next-pair nil)) + (while (and (not chunk-done) + (setq item (pop xrefs))) + (save-excursion + (let* ((loc (xref-item-location item)) + (beg (xref-location-marker loc)) + (end (move-marker (make-marker) + (+ beg (xref-match-length item)) + (marker-buffer beg)))) + (let ((pair (cons beg end))) + (push pair all-pairs) + ;; Perform sanity check first. + (xref--goto-location loc) + (if (xref--outdated-p item + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + (message "Search result out of date, skipping") + (cond + ((null file-buf) + (setq file-buf (marker-buffer beg)) + (push pair pairs)) + ((equal file-buf (marker-buffer beg)) + (push pair pairs)) + (t + (setq chunk-done t + next-pair pair)))))))) + (cons file-buf (nreverse pairs)))) + (:cleanup + (dolist (pair all-pairs) + (move-marker (car pair) nil) + (move-marker (cdr pair) nil))))))) + +(defun xref--outdated-p (item line-text) + ;; FIXME: The check should probably be a generic function instead of + ;; the assumption that all matches contain the full line as summary. + (let ((summary (xref-item-summary item)) + (strip (lambda (s) (if (string-match "\r\\'" s) + (substring-no-properties s 0 -1) + s)))) + (not + ;; Sometimes buffer contents include ^M, and sometimes Grep + ;; output includes it, and they don't always match. + (equal (funcall strip line-text) + (funcall strip summary))))) ;; FIXME: Write a nicer UI. -(defun xref--query-replace-1 (from to pairs) +(defun xref--query-replace-1 (from to iter) (let* ((query-replace-lazy-highlight nil) - current-beg current-end current-buf + (continue t) + did-it-once buf-pairs pairs + current-beg current-end ;; Counteract the "do the next match now" hack in ;; `perform-replace'. And still, it'll report that those ;; matches were "filtered out" at the end. (isearch-filter-predicate (lambda (beg end) (and current-beg - (eq (current-buffer) current-buf) (>= beg current-beg) (<= end current-end)))) (replace-re-search-function @@ -579,19 +609,24 @@ references displayed in the current *xref* buffer." (while (and (not found) pairs) (setq pair (pop pairs) current-beg (car pair) - current-end (cdr pair) - current-buf (marker-buffer current-beg)) - (xref--with-dedicated-window - (pop-to-buffer current-buf)) + current-end (cdr pair)) (goto-char current-beg) (when (re-search-forward from current-end noerror) (setq found t))) found)))) - ;; FIXME: Despite this being a multi-buffer replacement, `N' - ;; doesn't work, because we're not using - ;; `multi-query-replace-map', and it would expect the below - ;; function to be called once per buffer. - (perform-replace from to t t nil))) + (while (and continue (setq buf-pairs (funcall iter :next))) + (if did-it-once + ;; Reuse the same window for subsequent buffers. + (switch-to-buffer (car buf-pairs)) + (xref--with-dedicated-window + (pop-to-buffer (car buf-pairs))) + (setq did-it-once t)) + (setq pairs (cdr buf-pairs)) + (setq continue + (perform-replace from to t t nil nil multi-query-replace-map))) + (unless did-it-once (user-error "No suitable matches here")) + (when (and continue (not buf-pairs)) + (message "All results processed")))) (defvar xref--xref-buffer-mode-map (let ((map (make-sparse-keymap))) @@ -624,9 +659,6 @@ references displayed in the current *xref* buffer." (t (error "No %s xref" (if backward "previous" "next")))))) -(defconst xref-buffer-name "*xref*" - "The name of the buffer to show xrefs.") - (defvar xref--button-map (let ((map (make-sparse-keymap))) (define-key map [(control ?m)] #'xref-goto-xref) @@ -688,7 +720,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--show-xref-buffer (xrefs alist) (let ((xref-alist (xref--analyze xrefs))) (with-current-buffer (get-buffer-create xref-buffer-name) - (let ((inhibit-read-only t)) + (setq buffer-undo-list nil) + (let ((inhibit-read-only t) + (buffer-undo-list t)) (erase-buffer) (xref--insert-xrefs xref-alist) (xref--xref-buffer-mode) @@ -840,16 +874,16 @@ and just use etags." (kill-local-variable 'xref-backend-functions)) (setq-local xref-backend-functions xref-etags-mode--saved))) -(declare-function semantic-symref-find-references-by-name "semantic/symref") -(declare-function semantic-find-file-noselect "semantic/fw") +(declare-function semantic-symref-instantiate "semantic/symref") +(declare-function semantic-symref-perform-search "semantic/symref") (declare-function grep-expand-template "grep") (defvar ede-minor-mode) ;; ede.el (defun xref-collect-references (symbol dir) "Collect references to SYMBOL inside DIR. This function uses the Semantic Symbol Reference API, see -`semantic-symref-find-references-by-name' for details on which -tools are used, and when." +`semantic-symref-tool-alist' for details on which tools are used, +and when." (cl-assert (directory-name-p dir)) (require 'semantic/symref) (defvar semantic-symref-tool) @@ -860,19 +894,19 @@ tools are used, and when." ;; to force the backend to use `default-directory'. (let* ((ede-minor-mode nil) (default-directory dir) + ;; FIXME: Remove CScope and Global from the recognized tools? + ;; The current implementations interpret the symbol search as + ;; "find all calls to the given function", but not function + ;; definition. And they return nothing when passed a variable + ;; name, even a global one. (semantic-symref-tool 'detect) (case-fold-search nil) - (res (semantic-symref-find-references-by-name symbol 'subdirs)) - (hits (and res (oref res hit-lines))) - (orig-buffers (buffer-list))) - (unwind-protect - (cl-mapcan (lambda (hit) (xref--collect-matches - hit (format "\\_<%s\\_>" (regexp-quote symbol)))) - hits) - ;; TODO: Implement "lightweight" buffer visiting, so that we - ;; don't have to kill them. - (mapc #'kill-buffer - (cl-set-difference (buffer-list) orig-buffers))))) + (inst (semantic-symref-instantiate :searchfor symbol + :searchtype 'symbol + :searchscope 'subdirs + :resulttype 'line-and-text))) + (xref--convert-hits (semantic-symref-perform-search inst) + (format "\\_<%s\\_>" (regexp-quote symbol))))) ;;;###autoload (defun xref-collect-matches (regexp files dir ignores) @@ -891,39 +925,26 @@ IGNORES is a list of glob patterns." files (expand-file-name dir) ignores)) - (orig-buffers (buffer-list)) (buf (get-buffer-create " *xref-grep*")) (grep-re (caar grep-regexp-alist)) - (counter 0) - reporter hits) (with-current-buffer buf (erase-buffer) (call-process-shell-command command nil t) (goto-char (point-min)) (while (re-search-forward grep-re nil t) - (push (cons (string-to-number (match-string 2)) - (match-string 1)) + (push (list (string-to-number (match-string 2)) + (match-string 1) + (buffer-substring-no-properties (point) (line-end-position))) hits))) - (setq reporter (make-progress-reporter - (format "Collecting search results...") - 0 (length hits))) - (unwind-protect - (cl-mapcan (lambda (hit) - (prog1 - (progress-reporter-update reporter counter) - (cl-incf counter)) - (xref--collect-matches hit regexp)) - (nreverse hits)) - (progress-reporter-done reporter) - ;; TODO: Same as above. - (mapc #'kill-buffer - (cl-set-difference (buffer-list) orig-buffers))))) + (xref--convert-hits (nreverse hits) regexp))) (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' (defvar grep-find-template) (defvar find-name-arg) + ;; `shell-quote-argument' quotes the tilde as well. + (cl-assert (not (string-match-p "\\`~" dir))) (grep-expand-template grep-find-template regexp @@ -935,14 +956,13 @@ IGNORES is a list of glob patterns." (concat " -o " find-name-arg " ")) " " (shell-quote-argument ")")) - dir + (shell-quote-argument dir) (xref--find-ignores-arguments ignores dir))) (defun xref--find-ignores-arguments (ignores dir) "Convert IGNORES and DIR to a list of arguments for 'find'. IGNORES is a list of glob patterns. DIR is an absolute directory, used as the root of the ignore globs." - ;; `shell-quote-argument' quotes the tilde as well. (cl-assert (not (string-match-p "\\`~" dir))) (when ignores (concat @@ -981,30 +1001,75 @@ directory, used as the root of the ignore globs." (match-string 1 str))))) str t t)) -(defun xref--collect-matches (hit regexp) - (pcase-let* ((`(,line . ,file) hit) - (buf (or (find-buffer-visiting file) - (semantic-find-file-noselect file)))) - (with-current-buffer buf - (save-excursion +(defvar xref--last-visiting-buffer nil) +(defvar xref--temp-buffer-file-name nil) + +(defun xref--convert-hits (hits regexp) + (let (xref--last-visiting-buffer + (tmp-buffer (generate-new-buffer " *xref-temp*"))) + (unwind-protect + (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer)) + hits) + (kill-buffer tmp-buffer)))) + +(defun xref--collect-matches (hit regexp tmp-buffer) + (pcase-let* ((`(,line ,file ,text) hit) + (buf (xref--find-buffer-visiting file))) + (if buf + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (xref--collect-matches-1 regexp file line + (line-beginning-position) + (line-end-position)))) + ;; Using the temporary buffer is both a performance and a buffer + ;; management optimization. + (with-current-buffer tmp-buffer + (erase-buffer) + (unless (equal file xref--temp-buffer-file-name) + (insert-file-contents file nil 0 200) + ;; Can't (setq-local delay-mode-hooks t) because of + ;; bug#23272, but the performance penalty seems minimal. + (let ((buffer-file-name file) + (inhibit-message t) + message-log-max) + (ignore-errors + (set-auto-mode t))) + (setq-local xref--temp-buffer-file-name file) + (setq-local inhibit-read-only t) + (erase-buffer)) + (insert text) (goto-char (point-min)) - (forward-line (1- line)) - (let ((line-end (line-end-position)) - (line-beg (line-beginning-position)) - matches) - (syntax-propertize line-end) - ;; FIXME: This results in several lines with the same - ;; summary. Solve with composite pattern? - (while (re-search-forward regexp line-end t) - (let* ((beg-column (- (match-beginning 0) line-beg)) - (end-column (- (match-end 0) line-beg)) - (loc (xref-make-file-location file line beg-column)) - (summary (buffer-substring line-beg line-end))) - (add-face-text-property beg-column end-column 'highlight - t summary) - (push (xref-make-match summary loc (- end-column beg-column)) - matches))) - (nreverse matches)))))) + (xref--collect-matches-1 regexp file line + (point) + (point-max)))))) + +(defun xref--collect-matches-1 (regexp file line line-beg line-end) + (let (matches) + (syntax-propertize line-end) + ;; FIXME: This results in several lines with the same + ;; summary. Solve with composite pattern? + (while (and + ;; REGEXP might match an empty string. Or line. + (or (null matches) + (> (point) line-beg)) + (re-search-forward regexp line-end t)) + (let* ((beg-column (- (match-beginning 0) line-beg)) + (end-column (- (match-end 0) line-beg)) + (loc (xref-make-file-location file line beg-column)) + (summary (buffer-substring line-beg line-end))) + (add-face-text-property beg-column end-column 'highlight + t summary) + (push (xref-make-match summary loc (- end-column beg-column)) + matches))) + (nreverse matches))) + +(defun xref--find-buffer-visiting (file) + (unless (equal (car xref--last-visiting-buffer) file) + (setq xref--last-visiting-buffer + (cons file (find-buffer-visiting file)))) + (cdr xref--last-visiting-buffer)) (provide 'xref) diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 60016285e7c..fbb61b53e73 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -1,4 +1,4 @@ -;;; ps-def.el --- XEmacs and Emacs definitions for ps-print +;;; ps-def.el --- XEmacs and Emacs definitions for ps-print -*- lexical-binding: t -*- ;; Copyright (C) 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 2ea0919c686..71523a90db6 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1,4 +1,4 @@ -;;; ps-print.el --- print text from the buffer as PostScript +;;; ps-print.el --- print text from the buffer as PostScript -*- lexical-binding: t -*- ;; Copyright (C) 1993-2016 Free Software Foundation, Inc. @@ -1495,7 +1495,7 @@ Please send all bug fixes and enhancements to :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el") :prefix "ps-" :version "20" - :group 'wp + :group 'text :group 'postscript) (defgroup ps-print-horizontal nil @@ -5828,7 +5828,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-default-background (ps-rgb-color (cond ((or (member ps-print-color-p - '(nil back-white)) + '(nil black-white)) (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-bg 'frame-parameter) @@ -5842,7 +5842,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-default-foreground (ps-rgb-color (cond ((or (member ps-print-color-p - '(nil back-white)) + '(nil black-white)) (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-fg 'frame-parameter) @@ -5857,12 +5857,12 @@ XSTART YSTART are the relative position for the first page in a sheet.") #'(lambda (arg) (ps-rgb-color arg "unspecified-fg" 0.0)) (append (and (not (member ps-print-color-p - '(nil back-white))) + '(nil black-white))) ps-fg-list) (list ps-default-foreground "black"))) ps-default-color (and (not (member ps-print-color-p - '(nil back-white))) + '(nil black-white))) ps-default-foreground) ps-current-color ps-default-color ;; Set up default functions. diff --git a/lisp/recentf.el b/lisp/recentf.el index df7f3e2e565..e30e6468ebb 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1064,7 +1064,6 @@ Go to the beginning of buffer if not found." (define-key km "q" 'recentf-cancel-dialog) (define-key km "n" 'next-line) (define-key km "p" 'previous-line) - (define-key km [follow-link] "\C-m") km) "Keymap used in recentf dialogs.") @@ -1125,8 +1124,9 @@ IGNORE arguments." (recentf-dialog (format "*%s - Edit list*" recentf-menu-title) (set (make-local-variable 'recentf-edit-list) nil) (widget-insert - "Click on OK to delete selected files from the recent list. -Click on Cancel or type `q' to cancel.\n") + (format-message + "Click on OK to delete selected files from the recent list. +Click on Cancel or type `q' to cancel.\n")) ;; Insert the list of files as checkboxes (dolist (item recentf-list) (widget-create 'checkbox @@ -1187,6 +1187,9 @@ IGNORE other arguments." :format "%[%t\n%]" :help-echo ,(concat "Open " (cdr menu-element)) :action recentf-open-files-action + ;; Override the (problematic) follow-link property of the + ;; `link' widget (bug#22434). + :follow-link nil ,(cdr menu-element)))) (defun recentf-open-files-items (files) diff --git a/lisp/rect.el b/lisp/rect.el index 73790f2f92a..f9bebc47fef 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -108,7 +108,7 @@ Point is at the end of the segment of this line within the rectangle." (defun rectangle--col-pos (col kind) (let ((c (move-to-column col))) - (if (= c col) + (if (and (= c col) (not (eolp))) (if (eq kind 'point) (if (window-parameter nil 'rectangle--point-crutches) (setf (window-parameter nil 'rectangle--point-crutches) nil)) @@ -284,7 +284,7 @@ With a prefix (or a FILL) argument, also fill lines where nothing has to be deleted. If the buffer is read-only, Emacs will beep and refrain from deleting -the rectangle, but put it in the kill ring anyway. This means that +the rectangle, but put it in `killed-rectangle' anyway. This means that you can use this command to copy text from a read-only buffer. \(If the variable `kill-read-only-ok' is non-nil, then this won't even beep.)" @@ -295,7 +295,7 @@ even beep.)" (setq deactivate-mark t) (setq killed-rectangle (extract-rectangle start end)) (if kill-read-only-ok - (progn (message "Read only text copied to kill ring") nil) + (progn (message "Read only text copied to `killed-rectangle'") nil) (barf-if-buffer-read-only) (signal 'text-read-only (list (current-buffer))))))) @@ -370,7 +370,7 @@ no text on the right side of the rectangle." "Delete all whitespace following a specified column in each line. The left edge of the rectangle specifies the position in each line at which whitespace deletion should begin. On each line in the -rectangle, all continuous whitespace starting at that column is deleted. +rectangle, all contiguous whitespace starting at that column is deleted. When called from a program the rectangle's corners are START and END. With a prefix (or a FILL) argument, also fill too short lines." @@ -398,49 +398,48 @@ With a prefix (or a FILL) argument, also fill too short lines." (defun rectangle--space-to (col) (propertize " " 'display `(space :align-to ,col))) -(defface rectangle-preview-face '((t :inherit region)) - "The face to use for the `string-rectangle' preview.") +(defface rectangle-preview '((t :inherit region)) + "The face to use for the `string-rectangle' preview." + :version "25.1") (defcustom rectangle-preview t - "If non-nil, `string-rectangle' will show an-the-fly preview." + "If non-nil, `string-rectangle' will show an on-the-fly preview." :version "25.1" :type 'boolean) (defun rectangle--string-preview () - (let ((str (minibuffer-contents))) - (when (equal str "") - (setq str (or (car-safe minibuffer-default) - (if (stringp minibuffer-default) minibuffer-default)))) - (when str (setq str (propertize str 'face 'region))) - (with-selected-window rectangle--string-preview-window - (unless (or (null rectangle--string-preview-state) - (equal str (car rectangle--string-preview-state))) - (rectangle--string-flush-preview) - (apply-on-rectangle - (lambda (startcol endcol) - (let* ((sc (move-to-column startcol)) - (start (if (<= sc startcol) (point) - (forward-char -1) - (setq sc (current-column)) - (point))) - (ec (move-to-column endcol)) - (end (point)) - (ol (make-overlay start end))) - (push ol (nthcdr 3 rectangle--string-preview-state)) - ;; FIXME: The extra spacing doesn't interact correctly with - ;; the extra spacing added by the rectangular-region-highlight. - (when (< sc startcol) - (overlay-put ol 'before-string (rectangle--space-to startcol))) - (let ((as (when (< endcol ec) - ;; (rectangle--space-to ec) - (spaces-string (- ec endcol)) - ))) - (if (= start end) - (overlay-put ol 'after-string (if as (concat str as) str)) - (overlay-put ol 'display str) - (if as (overlay-put ol 'after-string as)))))) - (nth 1 rectangle--string-preview-state) - (nth 2 rectangle--string-preview-state)))))) + (when rectangle-preview + (let ((str (minibuffer-contents))) + (when str (setq str (propertize str 'face 'rectangle-preview))) + (with-selected-window rectangle--string-preview-window + (unless (or (null rectangle--string-preview-state) + (equal str (car rectangle--string-preview-state))) + (rectangle--string-flush-preview) + (apply-on-rectangle + (lambda (startcol endcol) + (let* ((sc (move-to-column startcol)) + (start (if (<= sc startcol) (point) + (forward-char -1) + (setq sc (current-column)) + (point))) + (ec (move-to-column endcol)) + (end (point)) + (ol (make-overlay start end))) + (push ol (nthcdr 3 rectangle--string-preview-state)) + ;; FIXME: The extra spacing doesn't interact correctly with + ;; the extra spacing added by the rectangular-region-highlight. + (when (< sc startcol) + (overlay-put ol 'before-string (rectangle--space-to startcol))) + (let ((as (when (< endcol ec) + ;; (rectangle--space-to ec) + (spaces-string (- ec endcol)) + ))) + (if (= start end) + (overlay-put ol 'after-string (if as (concat str as) str)) + (overlay-put ol 'display str) + (if as (overlay-put ol 'after-string as)))))) + (nth 1 rectangle--string-preview-state) + (nth 2 rectangle--string-preview-state))))))) ;; FIXME: Should this be turned into inhibit-region-highlight and made to apply ;; to non-rectangular regions as well? @@ -474,10 +473,15 @@ Called from a program, takes three args; START, END and STRING." #'rectangle--string-erase-preview nil t) (add-hook 'post-command-hook #'rectangle--string-preview nil t)) - (read-string (format "String rectangle (default %s): " - (or (car string-rectangle-history) "")) - nil 'string-rectangle-history + (read-string (format "String rectangle (default %s): " + (or (car string-rectangle-history) "")) + nil 'string-rectangle-history (car string-rectangle-history))))))) + ;; If we undo this change, we want to have the point back where we + ;; are now, and not after the first line in the rectangle (which is + ;; the first line to be changed by the following command). + (unless (eq buffer-undo-list t) + (push (point) buffer-undo-list)) (goto-char (apply-on-rectangle 'string-rectangle-line start end string t))) diff --git a/lisp/registry.el b/lisp/registry.el index e8bc6f5545a..20f8e8df257 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -35,11 +35,11 @@ ;; tracked: a list of symbols -;; tracker: a hashtable tuned for 100 symbols to track (you should +;; tracker: a hash table tuned for 100 symbols to track (you should ;; only access this with the :lookup2-function and the ;; :lookup2+-function) -;; data: a hashtable with default size 10K and resize threshold 2.0 +;; data: a hash table with default size 10K and resize threshold 2.0 ;; (this reflects the expected usage so override it if you know better) ;; ...plus methods to do all the work: `registry-search', @@ -78,8 +78,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) - +(require 'cl-lib) (require 'eieio) (require 'eieio-base) @@ -124,10 +123,10 @@ :documentation "The precious fields, a list of symbols.") (tracker :initarg :tracker :type hash-table - :documentation "The field tracking hashtable.") + :documentation "The field tracking hash table.") (data :initarg :data :type hash-table - :documentation "The data hashtable."))) + :documentation "The data hash table."))) (cl-defmethod initialize-instance :before ((this registry-db) slots) "Check whether a registry object needs to be upgraded." @@ -171,14 +170,14 @@ Returns an alist of the key followed by the entry in a list, not a cons cell." Returns an alist of the key followed by the entry in a list, not a cons cell." (let ((data (oref db data))) (delq nil - (loop for key in keys - when (gethash key data) - collect (list key (gethash key data)))))) + (cl-loop for key in keys + when (gethash key data) + collect (list key (gethash key data)))))) (cl-defmethod registry-lookup-secondary ((db registry-db) tracksym &optional create) "Search for TRACKSYM in the registry-db THIS. -When CREATE is not nil, create the secondary index hashtable if needed." +When CREATE is not nil, create the secondary index hash table if needed." (let ((h (gethash tracksym (oref db tracker)))) (if h h @@ -207,7 +206,7 @@ When SET is not nil, set it for VAL (use t for an empty list)." (vals (cdr-safe (nth 0 check-list))) found) (while (and key vals (not found)) - (setq found (case mode + (setq found (cl-case mode (:member (member (car-safe vals) (cdr-safe (assoc key entry)))) (:regex @@ -230,16 +229,16 @@ The test order is to check :all first, then :member, then :regex." (let ((all (plist-get spec :all)) (member (plist-get spec :member)) (regex (plist-get spec :regex))) - (loop for k being the hash-keys of (oref db data) - using (hash-values v) - when (or - ;; :all non-nil returns all - all - ;; member matching - (and member (registry--match :member v member)) - ;; regex matching - (and regex (registry--match :regex v regex))) - collect k)))) + (cl-loop for k being the hash-keys of (oref db data) + using (hash-values v) + when (or + ;; :all non-nil returns all + all + ;; member matching + (and member (registry--match :member v member)) + ;; regex matching + (and regex (registry--match :regex v regex))) + collect k)))) (cl-defmethod registry-delete ((db registry-db) keys assert &rest spec) "Delete KEYS from the registry-db THIS. @@ -254,8 +253,7 @@ With assert non-nil, errors out if the key does not exist already." (dolist (key keys) (let ((entry (gethash key data))) (when assert - (assert entry nil - "Key %s does not exist in database" key)) + (cl-assert entry nil "Key %s does not exist in database" key)) ;; clean entry from the secondary indices (dolist (tr tracked) ;; is this tracked symbol indexed? @@ -288,13 +286,10 @@ This is the key count of the `data' slot." "Insert ENTRY under KEY into the registry-db THIS. Updates the secondary ('tracked') indices as well. Errors out if the key exists already." - - (assert (not (gethash key (oref db data))) nil - "Key already exists in database") - - (assert (not (registry-full db)) - nil - "registry max-size limit reached") + (cl-assert (not (gethash key (oref db data))) nil + "Key already exists in database") + (cl-assert (not (registry-full db)) nil + "registry max-size limit reached") ;; store the entry (puthash key entry (oref db data)) @@ -304,7 +299,7 @@ Errors out if the key exists already." ;; for every value in the entry under that key... (dolist (val (cdr-safe (assq tr entry))) (let* ((value-keys (registry-lookup-secondary-value db tr val))) - (pushnew key value-keys :test 'equal) + (cl-pushnew key value-keys :test 'equal) (registry-lookup-secondary-value db tr val value-keys)))) entry) @@ -316,7 +311,7 @@ Errors out if the key exists already." (let (values) (maphash (lambda (key v) - (incf count) + (cl-incf count) (when (and (< 0 expected) (= 0 (mod count 1000))) (message "reindexing: %d of %d (%.2f%%)" @@ -367,7 +362,7 @@ entries first and return candidates from beginning of list." (data (oref db data)) (candidates (cl-loop for k being the hash-keys of data using (hash-values v) - when (notany precious-p v) + when (cl-notany precious-p v) collect (cons k v)))) ;; We want the full entries for sorting, but should only return a ;; list of entry keys. diff --git a/lisp/replace.el b/lisp/replace.el index a2ce78a8bb2..a1721746330 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1,4 +1,4 @@ -;;; replace.el --- replace commands for Emacs +;;; replace.el --- replace commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2016 Free ;; Software Foundation, Inc. @@ -28,12 +28,14 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defcustom case-replace t "Non-nil means `query-replace' should preserve case in replacements." :type 'boolean :group 'matching) -(defcustom replace-character-fold nil +(defcustom replace-char-fold nil "Non-nil means replacement commands should do character folding in matches. This means, for instance, that \\=' will match a large variety of unicode quotes. @@ -167,14 +169,12 @@ wants to replace FROM with TO." ;; unavailable while preparing to dump. (custom-reevaluate-setting 'query-replace-from-to-separator) (let* ((history-add-new-input nil) - (text-property-default-nonsticky - (cons '(separator . t) text-property-default-nonsticky)) (separator (when query-replace-from-to-separator (propertize "\0" 'display query-replace-from-to-separator 'separator t))) - (query-replace-from-to-history + (minibuffer-history (append (when separator (mapcar (lambda (from-to) @@ -186,18 +186,22 @@ wants to replace FROM with TO." (minibuffer-allow-text-properties t) ; separator uses text-properties (prompt (if (and query-replace-defaults separator) - (format "%s (default %s): " prompt (car query-replace-from-to-history)) + (format "%s (default %s): " prompt (car minibuffer-history)) (format "%s: " prompt))) (from ;; The save-excursion here is in case the user marks and copies ;; a region in order to specify the minibuffer input. ;; That should not clobber the region for the query-replace itself. (save-excursion - (if regexp-flag - (read-regexp prompt nil 'query-replace-from-to-history) - (read-from-minibuffer - prompt nil nil nil 'query-replace-from-to-history - (car (if regexp-flag regexp-search-ring search-ring)) t)))) + (minibuffer-with-setup-hook + (lambda () + (setq-local text-property-default-nonsticky + (cons '(separator . t) text-property-default-nonsticky))) + (if regexp-flag + (read-regexp prompt nil 'minibuffer-history) + (read-from-minibuffer + prompt nil nil nil nil + (car (if regexp-flag regexp-search-ring search-ring)) t))))) (to)) (if (and (zerop (length from)) query-replace-defaults) (cons (caar query-replace-defaults) @@ -293,7 +297,12 @@ As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. 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. +of the region. Otherwise, operate from point to the end of the buffer's +accessible portion. + +In interactive use, the prefix arg (non-nil DELIMITED in +non-interactive use), means replace only matches surrounded by +word boundaries. A negative prefix arg means replace backward. Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search string to the minibuffer @@ -317,14 +326,10 @@ 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'. -If `replace-character-fold' is non-nil, matching uses character folding, +If `replace-char-fold' is non-nil, matching uses character folding, i.e. it ignores diacritics and other differences between equivalent character strings. -Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. A negative prefix arg means -replace backward. - Fourth and fifth arg START and END specify the region to operate on. To customize possible responses, change the bindings in `query-replace-map'." @@ -355,7 +360,8 @@ As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. 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. +of the region. Otherwise, operate from point to the end of the buffer's +accessible portion. Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search regexp to the minibuffer @@ -379,7 +385,7 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. -This function is not affected by `replace-character-fold'. +This function is not affected by `replace-char-fold'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. A negative prefix arg means @@ -387,9 +393,10 @@ replace backward. Fourth and fifth arg START and END specify the region to operate on. -In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, -and `\\=\\N' (where N is a digit) stands for -whatever what matched the Nth `\\(...\\)' in REGEXP. +In TO-STRING, `\\&' or `\\0' stands for whatever matched the whole of +REGEXP, and `\\=\\N' (where N is a digit) stands for whatever matched +the Nth `\\(...\\)' (1-based) in REGEXP. The `\\(...\\)' groups are +counted from 1. `\\?' lets you edit the replacement text in the minibuffer at the given position for each replacement. @@ -447,12 +454,15 @@ If the result of TO-EXPR is not a string, it is converted to one using For convenience, when entering TO-EXPR interactively, you can use `\\&' or `\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where -N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP. +N is a digit) to stand for whatever matched the Nth `\\(...\\)' (1-based) +in REGEXP. + Use `\\#&' or `\\#N' if you want a number instead of a string. In interactive use, `\\#' in itself stands for `replace-count'. 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. +of the region. Otherwise, operate from point to the end of the buffer's +accessible portion. Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search regexp to the minibuffer @@ -469,7 +479,7 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. -This function is not affected by `replace-character-fold'. +This function is not affected by `replace-char-fold'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches that are surrounded by word boundaries. @@ -507,7 +517,8 @@ each successive replacement uses the next successive replacement string, wrapping around from the last such string to the first. 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. +of the region. Otherwise, operate from point to the end of the buffer's +accessible portion. Non-interactively, TO-STRINGS may be a list of replacement strings. @@ -562,7 +573,7 @@ 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'. -If `replace-character-fold' is non-nil, matching uses character folding, +If `replace-char-fold' is non-nil, matching uses character folding, i.e. it ignores diacritics and other differences between equivalent character strings. @@ -573,7 +584,7 @@ replace backward. 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. +otherwise from point to the end of the buffer's accessible portion. Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search string to the minibuffer @@ -617,10 +628,11 @@ If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp to be replaced will match a sequence of whitespace chars defined by the regexp in `search-whitespace-regexp'. -This function is not affected by `replace-character-fold' +This function is not affected by `replace-char-fold' 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. +of the region. Otherwise, operate from point to the end of the buffer's +accessible portion. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches surrounded by word boundaries. A negative prefix arg means @@ -628,9 +640,9 @@ replace backward. Fourth and fifth arg START and END specify the region to operate on. -In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, -and `\\=\\N' (where N is a digit) stands for -whatever what matched the Nth `\\(...\\)' in REGEXP. +In TO-STRING, `\\&' or `\\0' stands for whatever matched the whole of +REGEXP, and `\\=\\N' (where N is a digit) stands for +whatever matched the Nth `\\(...\\)' (1-based) in REGEXP. `\\?' lets you edit the replacement text in the minibuffer at the given position for each replacement. @@ -1398,7 +1410,7 @@ See also `multi-occur-in-matching-buffers'." "Next buffer to search (RET to end): ") nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) (nreverse (mapcar #'get-buffer bufs))) (occur-read-primary-args))) @@ -1935,7 +1947,6 @@ type them using Lisp syntax." (defun replace-eval-replacement (expression count) (let* ((replace-count count) - err (replacement (condition-case err (eval expression) @@ -1991,7 +2002,9 @@ but coerced to the correct value of INTEGERS." FIXEDCASE, LITERAL are passed to `replace-match' (which see). After possibly editing it (if `\\?' is present), NEWTEXT is also passed to `replace-match'. If NOEDIT is true, no check for `\\?' -is made (to save time). MATCH-DATA is used for the replacement. +is made (to save time). +MATCH-DATA is used for the replacement, and is a data structure +as returned from the `match-data' function. In case editing is done, it is changed to use markers. BACKWARD is used to reverse the replacement direction. @@ -2034,7 +2047,7 @@ It is called with three arguments, as if it were `re-search-forward'.") (defun replace-search (search-string limit regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) "Search for the next occurrence of SEARCH-STRING to replace." ;; Let-bind global isearch-* variables to values used ;; to search the next replacement. These let-bindings @@ -2046,14 +2059,14 @@ It is called with three arguments, as if it were ;; used after `recursive-edit' might override them. (let* ((isearch-regexp regexp-flag) (isearch-regexp-function (or delimited-flag - (and replace-character-fold + (and replace-char-fold (not regexp-flag) - #'character-fold-to-regexp))) + #'char-fold-to-regexp))) (isearch-lax-whitespace replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-adjusted nil) (isearch-nonincremental t) ; don't use lax word mode (isearch-forward (not backward)) @@ -2068,7 +2081,7 @@ It is called with three arguments, as if it were (defun replace-highlight (match-beg match-end range-beg range-end search-string regexp-flag delimited-flag - case-fold-search &optional backward) + case-fold &optional backward) (if query-replace-highlight (if replace-overlay (move-overlay replace-overlay match-beg match-end (current-buffer)) @@ -2083,7 +2096,7 @@ It is called with three arguments, as if it were replace-lax-whitespace) (isearch-regexp-lax-whitespace replace-regexp-lax-whitespace) - (isearch-case-fold-search case-fold-search) + (isearch-case-fold-search case-fold) (isearch-forward (not backward)) (isearch-other-end match-beg) (isearch-error nil)) @@ -2631,4 +2644,6 @@ It must return a string." ""))) (or (and keep-going stack) multi-buffer))) +(provide 'replace) + ;;; replace.el ends here diff --git a/lisp/rot13.el b/lisp/rot13.el index ee4f51d7ff3..d0e4048ad61 100644 --- a/lisp/rot13.el +++ b/lisp/rot13.el @@ -1,4 +1,4 @@ -;;; rot13.el --- display a buffer in ROT13 +;;; rot13.el --- display a buffer in ROT13 -*- lexical-binding: t -*- ;; Copyright (C) 1988, 2001-2016 Free Software Foundation, Inc. @@ -63,7 +63,10 @@ ;;;###autoload (defun rot13 (object &optional start end) - "Return ROT13 encryption of OBJECT, a buffer or string." + "ROT13 encrypt OBJECT, a buffer or string. +If OBJECT is a buffer, encrypt the region between START and END. +If OBJECT is a string, encrypt it in its entirety, ignoring START +and END, and return the encrypted string." (if (bufferp object) (with-current-buffer object (rot13-region start end)) diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 5cfa2c4353b..e5fe31675da 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -148,8 +148,7 @@ created in the future." "Return non-nil when horizontal scroll bars are available on this system." (and (display-graphic-p) (boundp 'x-toolkit-scroll-bars) - x-toolkit-scroll-bars - (not (eq (window-system) 'ns)))) + x-toolkit-scroll-bars)) (define-minor-mode horizontal-scroll-bar-mode "Toggle horizontal scroll bars on all frames (Horizontal Scroll Bar mode). @@ -184,9 +183,7 @@ when they are turned on; if it is nil, they go on the left." (interactive "P") (if (null arg) (setq arg - (if (cdr (assq 'vertical-scroll-bars - (frame-parameters (selected-frame)))) - -1 1)) + (if (frame-parameter nil 'vertical-scroll-bars) -1 1)) (setq arg (prefix-numeric-value arg))) (modify-frame-parameters (selected-frame) @@ -200,9 +197,7 @@ With ARG, turn vertical scroll bars on if and only if ARG is positive." (interactive "P") (if (null arg) (setq arg - (if (cdr (assq 'horizontal-scroll-bars - (frame-parameters (selected-frame)))) - -1 1)) + (if (frame-parameter nil 'horizontal-scroll-bars) -1 1)) (setq arg (prefix-numeric-value arg))) (modify-frame-parameters (selected-frame) diff --git a/lisp/server.el b/lisp/server.el index 524382073f8..85d51c8ba07 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -255,6 +255,7 @@ This means that the server should not kill the buffer when you say you are done with it in the server.") (make-variable-buffer-local 'server-existing-buffer) +;;;###autoload (defcustom server-name "server" "The name of the Emacs server, if this Emacs process creates one. The command `server-start' makes use of this. It should not be @@ -647,7 +648,12 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) (add-hook 'delete-frame-functions 'server-handle-delete-frame) (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) - (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit. + ;; We put server's kill-emacs-hook after the others, so that + ;; frames are not deleted too early, because doing that + ;; would severely degrade our abilities to communicate with + ;; the user, while some hooks may wish to ask the user + ;; questions (e.g., desktop-kill). + (add-hook 'kill-emacs-hook 'server-force-stop t) ;Cleanup upon exit. (setq server-process (apply #'make-network-process :name server-name @@ -655,6 +661,7 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) :noquery t :sentinel #'server-sentinel :filter #'server-process-filter + :use-external-socket t ;; We must receive file names without being decoded. ;; Those are decoded by server-process-filter according ;; to file-name-coding-system. Also don't get @@ -782,7 +789,7 @@ This handles splitting the command if it would be bigger than ;; We have to split the string (setq part (substring qtext 0 (- server-msg-size (length prefix) 1))) ;; Don't split in the middle of a quote sequence - (if (string-match "\\(^\\|[^&]\\)\\(&&\\)+$" part) + (if (string-match "\\(^\\|[^&]\\)&\\(&&\\)*$" part) ;; There is an uneven number of & at the end (setq part (substring part 0 -1))) (setq qtext (substring qtext (length part))) diff --git a/lisp/ses.el b/lisp/ses.el index a87386e1730..c80415e1e15 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,3 +1,4 @@ + ;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*- ;; Copyright (C) 2002-2016 Free Software Foundation, Inc. @@ -275,12 +276,15 @@ Each function is called with ARG=1." "Display properties to create a raised box for cells in the header line.") (defconst ses-standard-printer-functions - '(ses-center ses-center-span ses-dashfill ses-dashfill-span - ses-tildefill-span) - "List of print functions to be included in initial history of printer -functions. None of these standard-printer functions is suitable for use as a -column printer or a global-default printer because they invoke the column or -default printer and then modify its output.") + '(ses-center + ses-center-span ses-dashfill ses-dashfill-span + ses-tildefill-span + ses-prin1) + "List of print functions to be included in initial history of +printer functions. None of these standard-printer functions, +except function `ses-prin1', is suitable for use as a column +printer or a global-default printer because they invoke the +column or default printer and then modify its output.") ;;---------------------------------------------------------------------------- @@ -561,7 +565,14 @@ definition." (cond ((functionp printer) printer) ((stringp printer) - `(lambda (x) (format ,printer x))) + `(lambda (x) + (if (null x) "" + (format ,printer x)))) + ((stringp (car-safe printer)) + `(lambda (x) + (if (null x) "" + (setq ses-call-printer-return t) + (format ,(car printer) x)))) (t (error "Invalid printer %S" printer)))) (defun ses--local-printer (name def) @@ -1328,7 +1339,7 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (car value)))) (error (setq ses-call-printer-return signal) - (prin1-to-string value t)))) + (ses-prin1 value)))) (defun ses-adjust-print-width (col change) "Insert CHANGE spaces in front of column COL, or at end of line if @@ -2201,7 +2212,17 @@ Based on the current set of columns and `window-hscroll' position." (defun ses-jump (sym) "Move point to cell SYM." - (interactive "SJump to cell: ") + (interactive (let* (names + (s (completing-read + "Jump to cell: " + (and ses--named-cell-hashmap + (progn (maphash (lambda (key val) (push (symbol-name key) names)) + ses--named-cell-hashmap) + names))))) + (if + (string= s "") + (error "Invalid cell name") + (list (intern s))))) (let ((rowcol (ses-sym-rowcol sym))) (or rowcol (error "Invalid cell name")) (if (eq (symbol-value sym) '*skip*) @@ -3222,7 +3243,7 @@ is non-nil. Newlines and tabs in the export text are escaped." (when (eq (car-safe item) 'quote) (push "'" result) (setq item (cadr item))) - (setq item (prin1-to-string item t)) + (setq item (ses-prin1 item)) (setq item (replace-regexp-in-string "\t" "\\\\t" item)) (push item result) (cond @@ -3455,9 +3476,18 @@ highlighted range in the spreadsheet." (setq cell (or cell (ses-get-cell row col)) old-name (ses-cell-symbol cell) new-rowcol (ses-decode-cell-symbol (symbol-name new-name))) + ;; when ses-rename-cell is called interactively, then 'sym' is the + ;; 'cursor-intangible' property of text at cursor position, while + ;; 'old-name' is the symbol stored in array cell at coordinate + ;; 'rowcol' corresponding to 'ses-cell' property of symbol + ;; 'sym'. Both must be the same. + (unless (eq sym old-name) + (error "Spreadsheet is broken, both symbols %S and %S refering to cell (%d,%d)" sym old-name row col)) (if new-rowcol + ;; the new name is of A1 type, so we test that the coordinate + ;; inferred from new name (if (equal new-rowcol rowcol) - (put new-name 'ses-cell rowcol) + (put new-name 'ses-cell rowcol) (error "Not a valid name for this cell location")) (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) @@ -3471,7 +3501,7 @@ highlighted range in the spreadsheet." (setf (ses-cell-formula xcell) (ses-replace-name-in-formula (ses-cell-formula xcell) - sym + old-name new-name)))) ;; Replace name by new name in reference list of cells to which renamed ;; cell refers to. @@ -3479,11 +3509,14 @@ highlighted range in the spreadsheet." (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) (setf (ses-cell-references xcell) - (cons new-name (delq sym + (cons new-name (delq old-name (ses-cell-references xcell)))))) (set (make-local-variable new-name) (symbol-value sym)) (setf (ses-cell--symbol cell) new-name) - (makunbound sym) + ;; Unbind old name + (if (eq (get old-name 'ses-cell) :ses-named) + (ses--unbind-cell-name old-name) + (kill-local-variable old-name)) (and curcell (setq ses--curcell new-name)) (save-excursion (or curcell (ses-goto-print row col)) @@ -3509,34 +3542,67 @@ Uses the value COMPILED-VALUE for this printer." (ses-begin-change)) (ses-print-cell row col))))))) -(defun ses-define-local-printer (name) - "Define a local printer with name NAME." - (interactive "*SEnter printer name: ") + +(defun ses-define-local-printer (name definition) + "Define a local printer with name NAME and definition DEFINITION. + +NAME shall be a symbol. Use TAB to complete over existing local +printer names. + +DEFINITION shall be either a string formatter, e.g.: + + \"%.2f\" or (\"%.2f\") for left alignment. + +or a lambda expression, e.g. for formatting in ISO format dates +created with a '(calcFunc-date YEAR MONTH DAY)' formula: + + (lambda (x) + (cond + ((null val) \"\") + ((eq (car-safe x) 'date) + (let ((calc-format-date '(X YYYY \"-\" MM \"-\" DD))) + (math-format-date x))) + (t (ses-center-span val ?# 'ses-prin1)))) + +If NAME is already used to name a local printer function, then +the current definition is proposed as default value, and the +function is redefined." + (interactive + (let (name def already-defined-names) + (maphash (lambda (key val) (push (symbol-name key) already-defined-names)) + ses--local-printer-hashmap) + (setq name (completing-read "Enter printer name: " already-defined-names)) + (when (string= name "") + (error "Invalid printer name")) + (setq name (intern name)) + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) + (default (and cur-printer (ses--locprn-def cur-printer)))) + (setq def (ses-read-printer (format "Enter definition of printer %S: " name) + default))) + (list name def))) + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) - (default (and (vectorp cur-printer) (ses--locprn-def cur-printer))) - create-printer - (new-def - (ses-read-printer (format "Enter definition of printer %S: " name) - default))) + (default (and cur-printer (ses--locprn-def cur-printer))) + create-printer) (cond ;; cancelled operation => do nothing - ((eq new-def t)) + ((eq definition t)) ;; no change => do nothing - ((and (vectorp cur-printer) (equal new-def default))) + ((and cur-printer (equal definition default))) ;; re-defined printer - ((vectorp cur-printer) + (cur-printer (setq create-printer 0) - (setf (ses--locprn-def cur-printer) new-def) + (setf (ses--locprn-def cur-printer) definition) (ses-refresh-local-printer name (setf (ses--locprn-compiled cur-printer) - (ses-local-printer-compile new-def)))) + (ses-local-printer-compile definition)))) ;; new definition (t (setq create-printer 1) (puthash name (setq cur-printer - (ses-make-local-printer-info new-def)) + (ses-make-local-printer-info definition)) ses--local-printer-hashmap))) (when create-printer (let ((printer-def-text @@ -3560,8 +3626,17 @@ Uses the value COMPILED-VALUE for this printer." (when (= create-printer 1) (ses-file-format-extend-parameter-list 3) (ses-set-parameter 'ses--numlocprn - (+ ses--numlocprn create-printer)))))))))) + (1+ ses--numlocprn)))))))))) + +(defsubst ses-define-if-new-local-printer (name def) + "Same as function `ses-define-if-new-local-printer', except +that the definition occurs only when the local printer does not +already exists. +Function `ses-define-if-new-local-printer' is not interactive; it +is intended for mode hooks to add local printers automatically." + (unless (gethash name ses--local-printer-hashmap) + (ses-define-local-printer name def))) ;;---------------------------------------------------------------------------- ;; Checking formulas for safety @@ -3731,7 +3806,7 @@ Use `math-format-value' as a printer for Calc objects." "Return ARGS reversed, with the blank elements (nil and *skip*) removed." (let (result) (dolist (cur args) - (unless (memq cur '(nil *skip* *error*)) + (unless (memq cur '(nil *skip*)) (push cur result))) result)) @@ -3772,13 +3847,16 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated." ;; Standard print functions ;;---------------------------------------------------------------------------- -(defun ses-center (value &optional span fill) +(defun ses-center (value &optional span fill printer) "Print VALUE, centered within column. FILL is the fill character for centering (default = space). SPAN indicates how many additional rightward columns to include -in width (default = 0)." - (let ((printer (or (ses-col-printer ses--col) ses--default-printer)) - (width (ses-col-width ses--col)) +in width (default = 0). +PRINTER is the printer to use for printing the value, default is the +column printer if any, or the spreadsheet the spreadsheet default +printer otherwise." + (setq printer (or printer (ses-col-printer ses--col) ses--default-printer)) + (let ((width (ses-col-width ses--col)) half) (or fill (setq fill ?\s)) (or span (setq span 0)) @@ -3793,7 +3871,7 @@ in width (default = 0)." (concat half value half (if (> (% width 2) 0) (char-to-string fill)))))) -(defun ses-center-span (value &optional fill) +(defun ses-center-span (value &optional fill printer) "Print VALUE, centered within the span that starts in the current column and continues until the next nonblank column. FILL specifies the fill character (default = space)." @@ -3801,22 +3879,28 @@ FILL specifies the fill character (default = space)." (while (and (< end ses--numcols) (memq (ses-cell-value ses--row end) '(nil *skip*))) (setq end (1+ end))) - (ses-center value (- end ses--col 1) fill))) + (ses-center value (- end ses--col 1) fill printer))) -(defun ses-dashfill (value &optional span) +(defun ses-dashfill (value &optional span printer) "Print VALUE centered using dashes. SPAN indicates how many rightward columns to include in width (default = 0)." - (ses-center value span ?-)) + (ses-center value span ?- printer)) -(defun ses-dashfill-span (value) +(defun ses-dashfill-span (value &optional printer) "Print VALUE, centered using dashes within the span that starts in the current column and continues until the next nonblank column." - (ses-center-span value ?-)) + (ses-center-span value ?- printer)) -(defun ses-tildefill-span (value) +(defun ses-tildefill-span (value &optional printer) "Print VALUE, centered using tildes within the span that starts in the current column and continues until the next nonblank column." - (ses-center-span value ?~)) + (ses-center-span value ?~ printer)) + +(defun ses-prin1 (value) + "Shorthand for '(prin1-to-string VALUE t)'. +Useful to handle the default behavior in custom lambda based +printer functions." + (prin1-to-string value t)) (defun ses-unsafe (_value) "Substitute for an unsafe formula or printer." diff --git a/lisp/shell.el b/lisp/shell.el index 1f019f20f3a..d1b2e875746 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -384,11 +384,15 @@ Thus, this does not include the shell's current directory.") ((eq (aref qstr match) ?\") (setq dquotes (not dquotes))) ((eq (aref qstr match) ?\') (cond + ;; Treat single quote as text if inside double quotes. (dquotes (funcall push "'" (match-end 0))) - ((< match (1+ (length qstr))) + ((< (1+ match) (length qstr)) (let ((end (string-match "'" qstr (1+ match)))) - (funcall push (substring qstr (1+ match) end) - (or end (length qstr))))) + (unless end + (setq end (length qstr)) + (set-match-data (list match (length qstr)))) + (funcall push (substring qstr (1+ match) end) end))) + ;; Ignore if at the end of string. (t nil))) (t (error "Unexpected case in shell--unquote&requote-argument!"))) (setq qpos (match-end 0))) @@ -710,12 +714,11 @@ Otherwise, one argument `-i' is passed to the shell. (null (getenv "ESHELL"))) (with-current-buffer buffer (set (make-local-variable 'explicit-shell-file-name) - (file-remote-p - (expand-file-name + (expand-file-name + (file-local-name (read-file-name "Remote shell path: " default-directory shell-file-name - t shell-file-name)) - 'localname)))) + t shell-file-name)))))) ;; The buffer's window must be correctly set when we call comint (so ;; that comint sets the COLUMNS env var properly). diff --git a/lisp/simple.el b/lisp/simple.el index e5fb5f031dd..0ee2f060e5e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -37,6 +37,27 @@ (defvar compilation-current-error) (defvar compilation-context-lines) +(defcustom shell-command-dont-erase-buffer nil + "If non-nil, output buffer is not erased between shell commands. +Also, a non-nil value set the point in the output buffer +once the command complete. +The value `beg-last-out' set point at the beginning of the output, +`end-last-out' set point at the end of the buffer, `save-point' +restore the buffer position before the command." + :type '(choice + (const :tag "Erase buffer" nil) + (const :tag "Set point to beginning of last output" beg-last-out) + (const :tag "Set point to end of last output" end-last-out) + (const :tag "Save point" save-point)) + :group 'shell + :version "26.1") + +(defvar shell-command-saved-pos nil + "Point position in the output buffer after command complete. +It is an alist (BUFFER . POS), where BUFFER is the output +buffer, and POS is the point position in BUFFER once the command finish. +This variable is used when `shell-command-dont-erase-buffer' is non-nil.") + (defcustom idle-update-delay 0.5 "Idle time delay before updating various things on the screen. Various Emacs features that update auxiliary information when point moves @@ -145,18 +166,18 @@ nil means use goto-char using the second argument position.") &optional avoid-current extra-test-inclusive extra-test-exclusive) - "Test if BUFFER is a `next-error' capable buffer. - -If AVOID-CURRENT is non-nil, treat the current buffer -as an absolute last resort only. - -The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer -that normally would not qualify. If it returns t, the buffer -in question is treated as usable. - -The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer -that would normally be considered usable. If it returns nil, -that buffer is rejected." + "Return non-nil if BUFFER is a `next-error' capable buffer. +If AVOID-CURRENT is non-nil, and BUFFER is the current buffer, +return nil. + +The function EXTRA-TEST-INCLUSIVE, if non-nil, is called if +BUFFER would not normally qualify. If it returns non-nil, BUFFER +is considered `next-error' capable, anyway, and the function +returns non-nil. + +The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called if the +buffer would normally qualify. If it returns nil, BUFFER is +rejected, and the function returns nil." (and (buffer-name buffer) ;First make sure it's live. (not (and avoid-current (eq buffer (current-buffer)))) (with-current-buffer buffer @@ -408,15 +429,19 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (last-command-event ?\n) ;; Don't auto-fill if we have a numeric argument. (auto-fill-function (if arg nil auto-fill-function)) + (arg (prefix-numeric-value arg)) (postproc ;; Do the rest in post-self-insert-hook, because we want to do it ;; *before* other functions on that hook. (lambda () - (cl-assert (eq ?\n (char-before))) + ;; We are not going to insert any newlines if arg is + ;; non-positive. + (or (and (numberp arg) (<= arg 0)) + (cl-assert (eq ?\n (char-before)))) ;; Mark the newline(s) `hard'. (if use-hard-newlines (set-hard-newline-properties - (- (point) (prefix-numeric-value arg)) (point))) + (- (point) arg) (point))) ;; If the newline leaves the previous line blank, and we ;; have a left margin, delete that from the blank line. (save-excursion @@ -433,19 +458,21 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (move-to-left-margin nil t))))) (unwind-protect (if (not interactive) - ;; FIXME: For non-interactive uses, many calls actually just want - ;; (insert "\n"), so maybe we should do just that, so as to avoid - ;; the risk of filling or running abbrevs unexpectedly. - (let ((post-self-insert-hook (list postproc))) - (self-insert-command (prefix-numeric-value arg))) - (unwind-protect - (progn - (add-hook 'post-self-insert-hook postproc nil t) - (self-insert-command (prefix-numeric-value arg))) - ;; We first used let-binding to protect the hook, but that was naive - ;; since add-hook affects the symbol-default value of the variable, - ;; whereas the let-binding might only protect the buffer-local value. - (remove-hook 'post-self-insert-hook postproc t))) + ;; FIXME: For non-interactive uses, many calls actually + ;; just want (insert "\n"), so maybe we should do just + ;; that, so as to avoid the risk of filling or running + ;; abbrevs unexpectedly. + (let ((post-self-insert-hook (list postproc))) + (self-insert-command arg)) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc nil t) + (self-insert-command arg)) + ;; We first used let-binding to protect the hook, but that + ;; was naive since add-hook affects the symbol-default + ;; value of the variable, whereas the let-binding might + ;; only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc t))) (cl-assert (not (member postproc post-self-insert-hook))) (cl-assert (not (member postproc (default-value 'post-self-insert-hook)))))) nil) @@ -575,6 +602,11 @@ is called on the entire buffer (rather than an active region)." :group 'editing :version "24.3") +(defun region-modifiable-p (start end) + "Return non-nil if the region contains no read-only text." + (and (not (get-text-property start 'read-only)) + (eq end (next-single-property-change start 'read-only nil end)))) + (defun delete-trailing-whitespace (&optional start end) "Delete trailing whitespace between START and END. If called interactively, START and END are the start/end of the @@ -596,24 +628,26 @@ buffer if the variable `delete-trailing-lines' is non-nil." (list nil nil)))) (save-match-data (save-excursion - (let ((end-marker (copy-marker (or end (point-max)))) - (start (or start (point-min)))) - (goto-char start) - (while (re-search-forward "\\s-$" end-marker t) - (skip-syntax-backward "-" (line-beginning-position)) + (let ((end-marker (and end (copy-marker end)))) + (goto-char (or start (point-min))) + (with-syntax-table (make-syntax-table (syntax-table)) ;; Don't delete formfeeds, even if they are considered whitespace. - (if (looking-at-p ".*\f") - (goto-char (match-end 0))) - (delete-region (point) (match-end 0))) - ;; Delete trailing empty lines. - (goto-char end-marker) - (when (and (not end) - delete-trailing-lines - ;; Really the end of buffer. - (= (point-max) (1+ (buffer-size))) - (<= (skip-chars-backward "\n") -2)) - (delete-region (1+ (point)) end-marker)) - (set-marker end-marker nil)))) + (modify-syntax-entry ?\f "_") + ;; Treating \n as non-whitespace makes things easier. + (modify-syntax-entry ?\n "_") + (while (re-search-forward "\\s-+$" end-marker t) + (let ((b (match-beginning 0)) (e (match-end 0))) + (when (region-modifiable-p b e) + (delete-region b e))))) + (if end + (set-marker end-marker nil) + ;; Delete trailing empty lines. + (and delete-trailing-lines + ;; Really the end of buffer. + (= (goto-char (point-max)) (1+ (buffer-size))) + (<= (skip-chars-backward "\n") -2) + (region-modifiable-p (1+ (point)) (point-max)) + (delete-region (1+ (point)) (point-max))))))) ;; Return nil for the benefit of `write-file-functions'. nil) @@ -675,7 +709,7 @@ for numeric input." (let ((message-log-max nil) (help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c)) help-event-list))) - done (first t) (code 0) translated) + done (first t) (code 0) char translated) (while (not done) (let ((inhibit-quit first) ;; Don't let C-h or other help chars get the help @@ -687,15 +721,21 @@ for numeric input." or the octal character code. RET terminates the character code and is discarded; any other non-digit terminates the character code and is then used as input.")) - (setq translated (read-key (and prompt (format "%s-" prompt)))) + (setq char (read-event (and prompt (format "%s-" prompt)) t)) (if inhibit-quit (setq quit-flag nil))) + ;; Translate TAB key into control-I ASCII character, and so on. + ;; Note: `read-char' does it using the `ascii-character' property. + ;; We tried using read-key instead, but that disables the keystroke + ;; echo produced by 'C-q', see bug#24635. + (let ((translation (lookup-key local-function-key-map (vector char)))) + (setq translated (if (arrayp translation) + (aref translation 0) + char))) (if (integerp translated) (setq translated (char-resolve-modifiers translated))) (cond ((null translated)) ((not (integerp translated)) - (setq unread-command-events - (nconc (listify-key-sequence (this-single-command-raw-keys)) - unread-command-events) + (setq unread-command-events (list char) done t)) ((/= (logand translated ?\M-\^@) 0) ;; Turn a meta-character into a character with the 0200 bit set. @@ -714,9 +754,7 @@ any other non-digit terminates the character code and is then used as input.")) ((and (not first) (eq translated ?\C-m)) (setq done t)) ((not first) - (setq unread-command-events - (nconc (listify-key-sequence (this-single-command-raw-keys)) - unread-command-events) + (setq unread-command-events (list char) done t)) (t (setq code translated done t))) @@ -1069,7 +1107,9 @@ that uses or sets the mark." (interactive) (push-mark (point)) (push-mark (point-max) nil t) - (goto-char (point-min))) + ;; This is really `point-min' in most cases, but if we're in the + ;; minibuffer, this is at the end of the prompt. + (goto-char (minibuffer-prompt-end))) ;; Counting lines, one way or another. @@ -1170,7 +1210,7 @@ END, without printing any message." (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (while (forward-word 1) + (while (forward-word-strictly 1) (setq words (1+ words))))) words)) ((use-region-p) @@ -1412,10 +1452,11 @@ If nil, don't change the value of `debug-on-error'." :version "21.1") (defun eval-expression-print-format (value) - "Format VALUE as a result of evaluated expression. -Return a formatted string which is displayed in the echo area -in addition to the value printed by prin1 in functions which -display the result of expression evaluation." + "If VALUE in an integer, return a specially formatted string. +This string will typically look like \" (#o1, #x1, ?\\C-a)\". +If VALUE is not an integer, nil is returned. +This function is used by functions like `prin1' that display the +result of expression evaluation." (if (and (integerp value) (or (eq standard-output t) (zerop (prefix-numeric-value current-prefix-arg)))) @@ -1450,16 +1491,16 @@ display the result of expression evaluation." "Evaluate EXP and print value in the echo area. When called interactively, read an Emacs Lisp expression and evaluate it. Value is also consed on to front of the variable `values'. -Optional argument INSERT-VALUE non-nil (interactively, with prefix -argument) means insert the result into the current buffer instead of -printing it in the echo area. +If the resulting value is an integer, it will be printed in +several additional formats (octal, hexadecimal, and character). +Optional argument INSERT-VALUE non-nil (interactively, with +prefix argument) means insert the result into the current buffer +instead of printing it in the echo area. Normally, this function truncates long output according to the value of the variables `eval-expression-print-length' and `eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). +however, there is no such truncation. Runs the hook `eval-expression-minibuffer-setup-hook' on entering the minibuffer. @@ -1626,6 +1667,12 @@ If the value is non-nil and not a number, we wait 2 seconds." (integer :tag "time" 2) (other :tag "on"))) +(defcustom extended-command-suggest-shorter t + "If non-nil, show a shorter M-x invocation when there is one." + :group 'keyboard + :type 'boolean + :version "26.1") + (defun execute-extended-command--shorter-1 (name length) (cond ((zerop length) (list "")) @@ -1708,7 +1755,8 @@ invoking, give a prefix argument to `execute-extended-command'." ((numberp suggest-key-bindings) suggest-key-bindings) (t 2)))))) (when (and waited (not (consp unread-command-events))) - (unless (or binding executing-kbd-macro (not (symbolp function)) + (unless (or (not extended-command-suggest-shorter) + binding executing-kbd-macro (not (symbolp function)) (<= (length (symbol-name function)) 2)) ;; There's no binding for CMD. Let's try and find the shortest ;; string to use in M-x. @@ -2868,6 +2916,10 @@ REASON describes the reason that the boundary is being added; see "Check recently changed buffers and add a boundary if necessary. REASON describes the reason that the boundary is being added; see `undo-last-boundary' for more information." + ;; (Bug #23785) All commands should ensure that there is an undo + ;; boundary whether they have changed the current buffer or not. + (when (eq cause 'command) + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))) (dolist (b undo-auto--undoably-changed-buffers) (when (buffer-live-p b) (with-current-buffer b @@ -2890,9 +2942,7 @@ REASON describes the reason that the boundary is being added; see This list is maintained by `undo-auto--undoable-change' and `undo-auto--boundaries' and can be affected by changes to their -default values. - -See also `undo-auto--buffer-undoably-changed'.") +default values.") (defun undo-auto--add-boundary () "Add an `undo-boundary' in appropriate buffers." @@ -2941,6 +2991,41 @@ behavior." (undo-auto--boundary-ensure-timer)) ;; End auto-boundary section +(defun undo-amalgamate-change-group (handle) + "Amalgamate changes in change-group since HANDLE. +Remove all undo boundaries between the state of HANDLE and now. +HANDLE is as returned by `prepare-change-group'." + (dolist (elt handle) + (with-current-buffer (car elt) + (setq elt (cdr elt)) + (when (consp buffer-undo-list) + (let ((old-car (car-safe elt)) + (old-cdr (cdr-safe elt))) + (unwind-protect + (progn + ;; Temporarily truncate the undo log at ELT. + (when (consp elt) + (setcar elt t) (setcdr elt nil)) + (when + (or (null elt) ;The undo-log was empty. + ;; `elt' is still in the log: normal case. + (eq elt (last buffer-undo-list)) + ;; `elt' is not in the log any more, but that's because + ;; the log is "all new", so we should remove all + ;; boundaries from it. + (not (eq (last buffer-undo-list) (last old-cdr)))) + (cl-callf (lambda (x) (delq nil x)) + (if (car buffer-undo-list) + buffer-undo-list + ;; Preserve the undo-boundaries at either ends of the + ;; change-groups. + (cdr buffer-undo-list))))) + ;; Reset the modified cons cell ELT to its original content. + (when (consp elt) + (setcar elt old-car) + (setcdr elt old-cdr)))))))) + + (defcustom undo-ask-before-discard nil "If non-nil ask about discarding undo info for the current command. Normally, Emacs discards the undo info for the current command if @@ -3158,6 +3243,53 @@ output buffer and running a new command in the default buffer, :group 'shell :version "24.3") +(defun shell-command--save-pos-or-erase () + "Store a buffer position or erase the buffer. +See `shell-command-dont-erase-buffer'." + (let ((sym shell-command-dont-erase-buffer) + pos) + (setq buffer-read-only nil) + ;; Setting buffer-read-only to nil doesn't suffice + ;; if some text has a non-nil read-only property, + ;; which comint sometimes adds for prompts. + (setq pos + (cond ((eq sym 'save-point) (point)) + ((eq sym 'beg-last-out) (point-max)) + ((not sym) + (let ((inhibit-read-only t)) + (erase-buffer) nil)))) + (when pos + (goto-char (point-max)) + (push (cons (current-buffer) pos) + shell-command-saved-pos)))) + +(defun shell-command--set-point-after-cmd (&optional buffer) + "Set point in BUFFER after command complete. +BUFFER is the output buffer of the command; if nil, then defaults +to the current BUFFER. +Set point to the `cdr' of the element in `shell-command-saved-pos' +whose `car' is BUFFER." + (when shell-command-dont-erase-buffer + (let* ((sym shell-command-dont-erase-buffer) + (buf (or buffer (current-buffer))) + (pos (alist-get buf shell-command-saved-pos))) + (setq shell-command-saved-pos + (assq-delete-all buf shell-command-saved-pos)) + (when (buffer-live-p buf) + (let ((win (car (get-buffer-window-list buf))) + (pmax (with-current-buffer buf (point-max)))) + (unless (and pos (memq sym '(save-point beg-last-out))) + (setq pos pmax)) + ;; Set point in the window displaying buf, if any; otherwise + ;; display buf temporary in selected frame and set the point. + (if win + (set-window-point win pos) + (save-window-excursion + (let ((win (display-buffer + buf + '(nil (inhibit-switch-frame . t))))) + (set-window-point win pos))))))))) + (defun async-shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND asynchronously in background. @@ -3218,11 +3350,12 @@ Noninteractive callers can specify coding systems by binding The optional second argument OUTPUT-BUFFER, if non-nil, says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in current buffer. (This cannot be done asynchronously.) -In either case, the buffer is first erased, and the output is -inserted after point (leaving mark after it). +If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer +and insert the output there; a non-nil value of +`shell-command-dont-erase-buffer' prevent to erase the buffer. +If OUTPUT-BUFFER is not a buffer and not nil, insert the output +in current buffer after point leaving mark after it. +This cannot be done asynchronously. If the command terminates without error, but generates output, and you did not specify \"insert it in the current buffer\", @@ -3236,9 +3369,6 @@ If there is output and an error, and you did not specify \"insert it in the current buffer\", a message about the error goes at the end of the output. -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - If the optional third argument ERROR-BUFFER is non-nil, it is a buffer or buffer name to which to direct the command's standard error output. If it is nil, error output is mingled with regular output. @@ -3311,6 +3441,8 @@ the use of a shell (with its need to quote arguments)." (current-buffer))))) ;; Output goes in a separate buffer. ;; Preserve the match data in case called from a program. + ;; FIXME: It'd be ridiculous for an Elisp function to call + ;; shell-command and assume that it won't mess the match-data! (save-match-data (if (string-match "[ \t]*&[ \t]*\\'" command) ;; Command ending with ampersand means asynchronous. @@ -3357,13 +3489,8 @@ the use of a shell (with its need to quote arguments)." (setq buffer (get-buffer-create (or output-buffer "*Async Shell Command*")))))) (with-current-buffer buffer - (setq buffer-read-only nil) - ;; Setting buffer-read-only to nil doesn't suffice - ;; if some text has a non-nil read-only property, - ;; which comint sometimes adds for prompts. - (let ((inhibit-read-only t)) - (erase-buffer)) (display-buffer buffer '(nil (allow-no-window . t))) + (shell-command--save-pos-or-erase) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name shell-command-switch command)) @@ -3446,12 +3573,14 @@ and are only used if a pop-up buffer is displayed." ;; We have a sentinel to prevent insertion of a termination message -;; in the buffer itself. +;; in the buffer itself, and to set the point in the buffer when +;; `shell-command-dont-erase-buffer' is non-nil. (defun shell-command-sentinel (process signal) - (if (memq (process-status process) '(exit signal)) - (message "%s: %s." - (car (cdr (cdr (process-command process)))) - (substring signal 0 -1)))) + (when (memq (process-status process) '(exit signal)) + (shell-command--set-point-after-cmd (process-buffer process)) + (message "%s: %s." + (car (cdr (cdr (process-command process)))) + (substring signal 0 -1)))) (defun shell-command-on-region (start end command &optional output-buffer replace @@ -3481,16 +3610,15 @@ Otherwise it is displayed in the buffer `*Shell Command Output*'. The output is available in that buffer in both cases. If there is output and an error, a message about the error -appears at the end of the output. If there is no output, or if -output is inserted in the current buffer, the buffer `*Shell -Command Output*' is deleted. +appears at the end of the output. Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, -put the output there. If the value is nil, use the buffer -`*Shell Command Output*'. Any other value, excluding nil, -means to insert the output in the current buffer. In either case, -the output is inserted after point (leaving mark after it). +erase that buffer and insert the output there; a non-nil value of +`shell-command-dont-erase-buffer' prevent to erase the buffer. +If the value is nil, use the buffer `*Shell Command Output*'. +Any other non-nil value means to insert the output in the +current buffer after START. Optional fifth arg REPLACE, if non-nil, means to insert the output in place of text from START to END, putting point and mark @@ -3551,11 +3679,10 @@ interactively, this is t." (goto-char start) (and replace (push-mark (point) 'nomsg)) (setq exit-status - (call-process-region start end shell-file-name replace + (call-shell-region start end command replace (if error-file (list t error-file) - t) - nil shell-command-switch command)) + t))) ;; It is rude to delete a buffer which the command is not using. ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) @@ -3567,7 +3694,10 @@ interactively, this is t." (let ((buffer (get-buffer-create (or output-buffer "*Shell Command Output*")))) (unwind-protect - (if (eq buffer (current-buffer)) + (if (and (eq buffer (current-buffer)) + (or (not shell-command-dont-erase-buffer) + (and (not (eq buffer (get-buffer "*Shell Command Output*"))) + (not (region-active-p))))) ;; If the input is the same buffer as the output, ;; delete everything but the specified region, ;; then replace that region with the output. @@ -3586,16 +3716,14 @@ interactively, this is t." ;; output there. (let ((directory default-directory)) (with-current-buffer buffer - (setq buffer-read-only nil) (if (not output-buffer) (setq default-directory directory)) - (erase-buffer))) + (shell-command--save-pos-or-erase))) (setq exit-status - (call-process-region start end shell-file-name nil + (call-shell-region start end command nil (if error-file (list buffer error-file) - buffer) - nil shell-command-switch command))) + buffer)))) ;; Report the output. (with-current-buffer buffer (setq mode-line-process @@ -3607,8 +3735,10 @@ interactively, this is t." (format " - Exit [%d]" exit-status))))) (if (with-current-buffer buffer (> (point-max) (point-min))) ;; There's some output, display it - (display-message-or-buffer buffer) - ;; No output; error? + (progn + (display-message-or-buffer buffer) + (shell-command--set-point-after-cmd buffer)) + ;; No output; error? (let ((output (if (and error-file (< 0 (nth 7 (file-attributes error-file)))) @@ -3736,6 +3866,7 @@ support pty association, if PROGRAM is nil." (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." (setq tabulated-list-format [("Process" 15 t) + ("PID" 7 t) ("Status" 7 t) ("Buffer" 15 t) ("TTY" 12 t) @@ -3767,6 +3898,7 @@ Also, delete any process that is exited or signaled." (process-query-on-exit-flag p)) (let* ((buf (process-buffer p)) (type (process-type p)) + (pid (if (process-id p) (format "%d" (process-id p)) "--")) (name (process-name p)) (status (symbol-name (process-status p))) (buf-label (if (buffer-live-p buf) @@ -3802,7 +3934,7 @@ Also, delete any process that is exited or signaled." (format " at %s b/s" speed) ""))))) (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name status buf-label tty cmd)) + (push (list p (vector name pid status buf-label tty cmd)) tabulated-list-entries)))))) (defun process-menu-visit-buffer (button) @@ -4001,7 +4133,8 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (defvar filter-buffer-substring-functions nil - "This variable is a wrapper hook around `buffer-substring--filter'.") + "This variable is a wrapper hook around `buffer-substring--filter'. +\(See `with-wrapper-hook' for details about wrapper hooks.)") (make-obsolete-variable 'filter-buffer-substring-functions 'filter-buffer-substring-function "24.4") @@ -4042,10 +4175,12 @@ that are special to a buffer, and should not be copied into other buffers." (defun buffer-substring--filter (beg end &optional delete) "Default function to use for `filter-buffer-substring-function'. Its arguments and return value are as specified for `filter-buffer-substring'. -This respects the wrapper hook `filter-buffer-substring-functions', +Also respects the obsolete wrapper hook `filter-buffer-substring-functions' +\(see `with-wrapper-hook' for details about wrapper hooks), and the abnormal hook `buffer-substring-filters'. No filtering is done unless a hook says to." - (with-wrapper-hook filter-buffer-substring-functions (beg end delete) + (subr--with-wrapper-hook-no-warnings + filter-buffer-substring-functions (beg end delete) (cond ((or delete buffer-substring-filters) (save-excursion @@ -4652,9 +4787,9 @@ If N is negative, this is a more recent kill. The sequence of kills wraps around, so that after the oldest one comes the newest one. -When this command inserts killed text into the buffer, it honors -`yank-excluded-properties' and `yank-handler' as described in the -doc string for `insert-for-yank-1', which see." +This command honors the `yank-handled-properties' and +`yank-excluded-properties' variables, and the `yank-handler' text +property, in the way that `yank' does." (interactive "*p") (if (not (eq last-command 'yank)) (user-error "Previous command was not a yank")) @@ -4687,10 +4822,34 @@ at the end, and set mark at the beginning without activating it. With just \\[universal-argument] as argument, put point at beginning, and mark at end. With argument N, reinsert the Nth most recent kill. -When this command inserts text into the buffer, it honors the -`yank-handled-properties' and `yank-excluded-properties' -variables, and the `yank-handler' text property. See -`insert-for-yank-1' for details. +This command honors the `yank-handled-properties' and +`yank-excluded-properties' variables, and the `yank-handler' text +property, as described below. + +Properties listed in `yank-handled-properties' are processed, +then those listed in `yank-excluded-properties' are discarded. + +If STRING has a non-nil `yank-handler' property anywhere, the +normal insert behavior is altered, and instead, for each contiguous +segment of STRING that has a given value of the `yank-handler' +property, that value is used as follows: + +The value of a `yank-handler' property must be a list of one to four +elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO). +FUNCTION, if non-nil, should be a function of one argument (the + object to insert); FUNCTION is called instead of `insert'. +PARAM, if present and non-nil, is passed to FUNCTION (to be handled + in whatever way is appropriate; e.g. if FUNCTION is `yank-rectangle', + PARAM may be a list of strings to insert as a rectangle). If PARAM + is nil, then the current segment of STRING is used. +If NOEXCLUDE is present and non-nil, the normal removal of + `yank-excluded-properties' is not performed; instead FUNCTION is + responsible for the removal. This may be necessary if FUNCTION + adjusts point before or after inserting the object. +UNDO, if present and non-nil, should be a function to be called + by `yank-pop' to undo the insertion of the current PARAM. It is + given two arguments, the start and end of the region. FUNCTION + may set `yank-undo-function' to override UNDO. See also the command `yank-pop' (\\[yank-pop])." (interactive "*P") @@ -4810,8 +4969,8 @@ To kill a whole line, when point is not at the beginning, type \ \\[move-beginning-of-line] \\[kill-line] \\[kill-line]. If `show-trailing-whitespace' is non-nil, this command will just -kill the rest of the current line, even if there are only -nonblanks there. +kill the rest of the current line, even if there are no nonblanks +there. If option `kill-whole-line' is non-nil, then this command kills the whole line including its terminating newline, when used at the beginning of a line @@ -5202,6 +5361,7 @@ store it in a Lisp variable. Example: (defmacro save-mark-and-excursion (&rest body) "Like `save-excursion', but also save and restore the mark state. This macro does what `save-excursion' did before Emacs 25.1." + (declare (indent 0) (debug t)) (let ((saved-marker-sym (make-symbol "saved-marker"))) `(let ((,saved-marker-sym (save-mark-and-excursion--save))) (unwind-protect @@ -5210,7 +5370,7 @@ This macro does what `save-excursion' did before Emacs 25.1." (defcustom use-empty-active-region nil "Whether \"region-aware\" commands should act on empty regions. -If nil, region-aware commands treat empty regions as inactive. +If nil, region-aware commands treat the empty region as inactive. If non-nil, region-aware commands treat the region as active as long as the mark is active, even if the region is empty. @@ -5369,13 +5529,13 @@ after C-u \\[set-mark-command]." :group 'editing-basics) (defun set-mark-command (arg) - "Set the mark where point is, or jump to the mark. + "Set the mark where point is, and activate it; or jump to the mark. Setting the mark also alters the region, which is the text between point and mark; this is the closest equivalent in Emacs to what some editors call the \"selection\". With no prefix argument, set the mark at point, and push the -old mark position on local mark ring. Also push the old mark on +old mark position on local mark ring. Also push the new mark on global mark ring, if the previous mark was set in another buffer. When Transient Mark Mode is off, immediately repeating this @@ -5633,6 +5793,7 @@ cursor to the end of the buffer. If the variable `line-move-visual' is non-nil, this command moves by display lines. Otherwise, it moves by buffer lines, without taking variable-width characters or continued lines into account. +See \\[next-logical-line] for a command that always moves by buffer lines. The command \\[set-goal-column] can be used to create a semipermanent goal column for this command. @@ -5676,6 +5837,7 @@ column, or at the end of the line if it is not long enough. If the variable `line-move-visual' is non-nil, this command moves by display lines. Otherwise, it moves by buffer lines, without taking variable-width characters or continued lines into account. +See \\[previous-logical-line] for a command that always moves by buffer lines. The command \\[set-goal-column] can be used to create a semipermanent goal column for this command. @@ -5821,7 +5983,7 @@ The value is a floating-point number." (/ (float (- (nth 3 edges) (nth 1 edges))) dlh))) ;; Returns non-nil if partial move was done. -(defun line-move-partial (arg noerror to-end) +(defun line-move-partial (arg noerror &optional _to-end) (if (< arg 0) ;; Move backward (up). ;; If already vscrolled, reduce vscroll @@ -5919,7 +6081,7 @@ The value is a floating-point number." ;; discrepancies between that and DLH. (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1)) (set-window-vscroll nil dlh t)) - (line-move-1 arg noerror to-end) + (line-move-1 arg noerror) t) ;; If there are lines above the last line, scroll-up one line. ((and vpos (> vpos 0)) @@ -5936,7 +6098,7 @@ The value is a floating-point number." ;; scrolling with cursor motion. But so far we don't have ;; a cleaner solution to the problem of making C-n do something ;; useful given a tall image. -(defun line-move (arg &optional noerror to-end try-vscroll) +(defun line-move (arg &optional noerror _to-end try-vscroll) "Move forward ARG lines. If NOERROR, don't signal an error if we can't move ARG lines. TO-END is unused. @@ -5944,7 +6106,7 @@ TRY-VSCROLL controls whether to vscroll tall lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this function will not vscroll." (if noninteractive - (line-move-1 arg noerror to-end) + (line-move-1 arg noerror) (unless (and auto-window-vscroll try-vscroll ;; Only vscroll for single line moves (= (abs arg) 1) @@ -5954,7 +6116,7 @@ not vscroll." ;; But don't vscroll in a keyboard macro. (not defining-kbd-macro) (not executing-kbd-macro) - (line-move-partial arg noerror to-end)) + (line-move-partial arg noerror)) (set-window-vscroll nil 0 t) (if (and line-move-visual ;; Display-based column are incompatible with goal-column. @@ -5986,7 +6148,7 @@ not vscroll." (set-window-vscroll nil (- lh dlh) t)))) - (line-move-1 arg noerror to-end))))) + (line-move-1 arg noerror))))) ;; Display-based alternative to line-move-1. ;; Arg says how many lines to move. The value is t if we can move the @@ -6024,7 +6186,13 @@ If NOERROR, don't signal an error if we can't move that many lines." (setq temporary-goal-column (cons (/ (float x-pos) (frame-char-width)) - hscroll)))))) + hscroll))) + (executing-kbd-macro + ;; When we move beyond the first/last character visible in + ;; the window, posn-at-point will return nil, so we need to + ;; approximate the goal column as below. + (setq temporary-goal-column + (mod (current-column) (window-text-width))))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) ;; vertical-motion can move more than it was asked to if it moves @@ -6405,7 +6573,8 @@ Those commands will move to this position in the line moved to rather than trying to keep the same horizontal position. With a non-nil argument ARG, clears out the goal column so that \\[next-line] and \\[previous-line] resume vertical motion. -The goal column is stored in the variable `goal-column'." +The goal column is stored in the variable `goal-column'. +This is a buffer-local setting." (interactive "P") (if arg (progn @@ -6626,9 +6795,13 @@ are interchanged." (transpose-subr 'forward-word arg)) (defun transpose-sexps (arg) - "Like \\[transpose-words] but applies to sexps. -Does not work on a sexp that point is in the middle of -if it is a list or string." + "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps. +Unlike `transpose-words', point must be between the two sexps and not +in the middle of a sexp to be transposed. +With non-zero prefix arg ARG, effect is to take the sexp before point +and drag it forward past ARG other sexps (backward if ARG is negative). +If ARG is zero, the sexps ending at or after point and at or after mark +are interchanged." (interactive "*p") (transpose-subr (lambda (arg) @@ -6791,13 +6964,18 @@ With argument ARG, do this that many times." (kill-word (- arg))) (defun current-word (&optional strict really-word) - "Return the symbol or word that point is on (or a nearby one) as a string. + "Return the word at or near point, as a string. The return value includes no text properties. -If optional arg STRICT is non-nil, return nil unless point is within -or adjacent to a symbol or word. In all cases the value can be nil -if there is no word nearby. -The function, belying its name, normally finds a symbol. -If optional arg REALLY-WORD is non-nil, it finds just a word." + +If optional arg STRICT is non-nil, return nil unless point is +within or adjacent to a word, otherwise look for a word within +point's line. If there is no word anywhere on point's line, the +value is nil regardless of STRICT. + +By default, this function treats as a single word any sequence of +characters that have either word or symbol syntax. If optional +arg REALLY-WORD is non-nil, only characters of word syntax can +constitute a word." (save-excursion (let* ((oldpoint (point)) (start (point)) (end (point)) (syntaxes (if really-word "w" "w_")) @@ -8288,7 +8466,7 @@ Returns the newly created indirect buffer." (with-current-buffer buffer (run-hooks 'clone-indirect-buffer-hook)) (when display-flag - (pop-to-buffer buffer norecord)) + (pop-to-buffer buffer nil norecord)) buffer)) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index b9c1bb506d1..0e81e2d74c6 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -244,7 +244,8 @@ When done with skeleton, but before going back to `_'-point call (setq skeleton-regions (if (> skeleton-regions 0) (list (copy-marker (point) t) - (save-excursion (forward-word skeleton-regions) + (save-excursion (forward-word-strictly + skeleton-regions) (point-marker))) (setq skeleton-regions (- skeleton-regions)) ;; copy skeleton-regions - 1 elements from `mark-ring' diff --git a/lisp/sort.el b/lisp/sort.el index 4d7311f1e51..7f8acfc9b83 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -1,4 +1,4 @@ -;;; sort.el --- commands to sort text in an Emacs buffer +;;; sort.el --- commands to sort text in an Emacs buffer -*- lexical-binding: t -*- ;; Copyright (C) 1986-1987, 1994-1995, 2001-2016 Free Software ;; Foundation, Inc. @@ -596,7 +596,7 @@ is non-nil, it also prints a message describing the number of deletions." (equal current-prefix-arg '(64)) t))) (let ((lines (unless adjacent (make-hash-table :test 'equal))) - line prev-line + line prev-line first-line (count 0) (beg (copy-marker beg)) (end (copy-marker end))) @@ -604,8 +604,9 @@ is non-nil, it also prints a message describing the number of deletions." (goto-char (if reverse end beg)) (if (and reverse (bolp)) (forward-char -1)) (while (if reverse - (and (> (point) beg) (not (bobp))) + (not first-line) (and (< (point) end) (not (eobp)))) + (setq first-line (and reverse (or (<= (point) beg) (bobp)))) (setq line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (if (and keep-blanks (string= "" line)) diff --git a/lisp/startup.el b/lisp/startup.el index 15a79f6f5bf..4a04f9c2d1b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -439,7 +439,7 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :initialize #'custom-initialize-delay) (defun normal-top-level-add-subdirs-to-load-path () - "Add all subdirectories of `default-directory' to `load-path'. + "Recursively add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names start with letters or digits; it excludes any subdirectory named `RCS' or `CVS', and any subdirectory that contains a file named `.nosearch'." @@ -870,7 +870,7 @@ If STYLE is nil, display appropriately for the terminal." (if repl (aset (or standard-display-table (setq standard-display-table (make-display-table))) - char (vector (make-glyph-code repl 'escape-glyph))) + char (vector (make-glyph-code repl 'homoglyph))) (when standard-display-table (aset standard-display-table char nil))))))) @@ -1890,10 +1890,12 @@ we put it on this frame." (when frame (let* ((img (create-image (fancy-splash-image-file))) (image-height (and img (cdr (image-size img nil frame)))) - ;; We test frame-height so that, if the frame is split - ;; by displaying a warning, that doesn't cause the normal - ;; splash screen to be used. - (frame-height (1- (frame-height frame)))) + ;; We test frame-height and not window-height so that, + ;; if the frame is split by displaying a warning, that + ;; doesn't cause the normal splash screen to be used. + ;; We subtract 2 from frame-height to account for the + ;; echo area and the mode line. + (frame-height (- (frame-height frame) 2))) (> frame-height (+ image-height 19))))))) @@ -2358,7 +2360,14 @@ nil default-directory" name) ((member argi '("-eval" "-execute")) (setq inhibit-startup-screen t) - (eval (read (or argval (pop command-line-args-left))))) + (let* ((str-expr (or argval (pop command-line-args-left))) + (read-data (read-from-string str-expr)) + (expr (car read-data)) + (end (cdr read-data))) + (unless (= end (length str-expr)) + (error "Trailing garbage following expression: %s" + (substring str-expr end))) + (eval expr))) ((member argi '("-L" "-directory")) ;; -L :/foo adds /foo to the _end_ of load-path. @@ -2384,7 +2393,7 @@ nil default-directory" name) ;; Take file from default dir if it exists there; ;; otherwise let `load' search for it. (file-ex (expand-file-name file))) - (when (file-exists-p file-ex) + (when (file-regular-p file-ex) (setq file file-ex)) (load file nil t))) diff --git a/lisp/subr.el b/lisp/subr.el index fb1e0291a7a..7d4409e3167 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -22,20 +22,18 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;; Commentary: - -;;; Code: - ;; Beware: while this file has tag `utf-8', before it's compiled, it gets ;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap. -(defmacro declare-function (_fn _file &optional _arglist _fileonly) + +;; declare-function's args use &rest, not &optional, for compatibility +;; with byte-compile-macroexpand-declare-function. + +(defmacro declare-function (_fn _file &rest _args) "Tell the byte-compiler that function FN is defined, in FILE. -Optional ARGLIST is the argument list used by the function. The FILE argument is not used by the byte-compiler, but by the `check-declare' package, which checks that FILE contains a -definition for FN. ARGLIST is used by both the byte-compiler -and `check-declare' to check for consistency. +definition for FN. FILE can be either a Lisp file (in which case the \".el\" extension is optional), or a C file. C files are expanded @@ -46,19 +44,22 @@ declaration. A FILE with an \"ext:\" prefix is an external file. `check-declare' will check such files if they are found, and skip them without error if they are not. -FILEONLY non-nil means that `check-declare' will only check that -FILE exists, not that it defines FN. This is intended for -function-definitions that `check-declare' does not recognize, e.g. -`defstruct'. +Optional ARGLIST specifies FN's arguments, or is t to not specify +FN's arguments. An omitted ARGLIST defaults to t, not nil: a nil +ARGLIST specifies an empty argument list, and an explicit t +ARGLIST is a placeholder that allows supplying a later arg. -To specify a value for FILEONLY without passing an argument list, -set ARGLIST to t. This is necessary because nil means an -empty argument list, rather than an unspecified one. +Optional FILEONLY non-nil means that `check-declare' will check +only that FILE exists, not that it defines FN. This is intended +for function definitions that `check-declare' does not recognize, +e.g., `defstruct'. Note that for the purposes of `check-declare', this statement must be the first non-whitespace on a line. For more information, see Info node `(elisp)Declaring Functions'." + (declare (advertised-calling-convention + (fn file &optional arglist fileonly) nil)) ;; Does nothing - byte-compile-declare-function does the work. nil) @@ -66,6 +67,7 @@ For more information, see Info node `(elisp)Declaring Functions'." ;;;; Basic Lisp macros. (defalias 'not 'null) +(defalias 'sxhash 'sxhash-equal) (defmacro noreturn (form) "Evaluate FORM, expecting it not to return. @@ -290,21 +292,27 @@ This function accepts any number of arguments, but ignores them." ;; Signal a compile-error if the first arg is missing. (defun error (&rest args) - "Signal an error, making error message by passing all args to `format'. + "Signal an error, making a message by passing args to `format-message'. In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention -for the sake of consistency." +for the sake of consistency. + +Note: (error \"%s\" VALUE) makes the message VALUE without +interpreting format characters like `%', `\\=`', and `\\=''." (declare (advertised-calling-convention (string &rest args) "23.1")) (signal 'error (list (apply #'format-message args)))) (defun user-error (format &rest args) - "Signal a pilot error, making error message by passing all args to `format'. + "Signal a pilot error, making a message by passing args to `format-message'. In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention for the sake of consistency. This is just like `error' except that `user-error's are expected to be the result of an incorrect manipulation on the part of the user, rather than the -result of an actual problem." +result of an actual problem. + +Note: (user-error \"%s\" VALUE) makes the message VALUE without +interpreting format characters like `%', `\\=`', and `\\=''." (signal 'user-error (list (apply #'format-message format args)))) (defun define-error (name message &optional parent) @@ -478,13 +486,16 @@ of course, also replace TO with a slightly larger value (list from) (or inc (setq inc 1)) (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) + (let (seq (n 0) (next from) (last from)) (if (> inc 0) - (while (<= next to) + ;; The (>= next last) condition protects against integer + ;; overflow in computing NEXT. + (while (and (>= next last) (<= next to)) (setq seq (cons next seq) n (1+ n) + last next next (+ from (* n inc)))) - (while (>= next to) + (while (and (<= next last) (>= next to)) (setq seq (cons next seq) n (1+ n) next (+ from (* n inc))))) @@ -503,7 +514,8 @@ argument VECP, this copies vectors as well as conses." (setq newcar (copy-tree (car tree) vecp))) (push newcar result)) (setq tree (cdr tree))) - (nconc (nreverse result) tree)) + (nconc (nreverse result) + (if (and vecp (vectorp tree)) (copy-tree tree vecp) tree))) (if (and vecp (vectorp tree)) (let ((i (length (setq tree (copy-sequence tree))))) (while (>= (setq i (1- i)) 0) @@ -589,10 +601,12 @@ Elements of ALIST that are not conses are ignored." alist) (defun alist-get (key alist &optional default remove) - "Get the value associated to KEY in ALIST. -DEFAULT is the value to return if KEY is not found in ALIST. -REMOVE, if non-nil, means that when setting this element, we should -remove the entry if the new value is `eql' to DEFAULT." + "Return the value associated with KEY in ALIST, using `assq'. +If KEY is not found in ALIST, return DEFAULT. + +This is a generalized variable suitable for use with `setf'. +When using it to set a value, optional argument REMOVE non-nil +means to remove KEY from ALIST if the new value is `eql' to DEFAULT." (ignore remove) ;;Silence byte-compiler. (let ((x (assq key alist))) (if x (cdr x) default))) @@ -619,8 +633,10 @@ side-effects, and the argument LIST is not modified." (defun kbd (keys) "Convert KEYS to the internal Emacs key representation. -KEYS should be a string constant in the format used for -saving keyboard macros (see `edmacro-mode')." +KEYS should be a string in the format returned by commands such +as `C-h k' (`describe-key'). +This is the same format used for saving keyboard macros (see +`edmacro-mode')." ;; Don't use a defalias, since the `pure' property is only true for ;; the calling convention of `kbd'. (read-kbd-macro keys)) @@ -846,7 +862,12 @@ above 127 (such as ISO Latin-1) can be included if you use a vector. Note that if KEY has a local binding in the current buffer, that local binding will continue to shadow any global binding that you make with this function." - (interactive "KSet key globally: \nCSet key %s to command: ") + (interactive + (let* ((menu-prompting nil) + (key (read-key-sequence "Set key globally: "))) + (list key + (read-command (format "Set key %s to command: " + (key-description key)))))) (or (vectorp key) (stringp key) (signal 'wrong-type-argument (list 'arrayp key))) (define-key (current-global-map) key command)) @@ -890,7 +911,7 @@ KEY is a string or vector representing a sequence of keystrokes." (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. -In other words, OLDDEF is replaced with NEWDEF where ever it appears. +In other words, OLDDEF is replaced with NEWDEF wherever it appears. Alternatively, if optional fourth argument OLDMAP is specified, we redefine in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. @@ -1115,6 +1136,7 @@ The return value is a positive integer." (defun posnp (obj) "Return non-nil if OBJ appears to be a valid `posn' object specifying a window. +A `posn' object is returned from functions such as `event-start'. If OBJ is a valid `posn' object, but specifies a frame rather than a window, return nil." ;; FIXME: Correct the behavior of this function so that all valid @@ -1269,27 +1291,14 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescent names for functions. -(define-obsolete-function-alias 'window-dot 'window-point "22.1") -(define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1") -(define-obsolete-function-alias 'read-input 'read-string "22.1") -(define-obsolete-function-alias 'show-buffer 'set-window-buffer "22.1") -(define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1") -(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1") - (make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") (make-obsolete 'buffer-has-markers-at nil "24.3") -(defun insert-string (&rest args) - "Mocklisp-compatibility insert function. -Like the function `insert' except that any argument that is a number -is converted into a string by expressing it in decimal." - (declare (obsolete insert "22.1")) - (dolist (el args) - (insert (if (integerp el) (number-to-string el) el)))) - -(defun makehash (&optional test) - (declare (obsolete make-hash-table "22.1")) - (make-hash-table :test (or test 'eql))) +;; bug#23850 +(make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") +(make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") +(make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") +(make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") (defun log10 (x) "Return (log X 10), the log base 10 of X." @@ -1308,48 +1317,9 @@ is converted into a string by expressing it in decimal." (set-advertised-calling-convention 'unintern '(name obarray) "23.3") (set-advertised-calling-convention 'indirect-function '(object) "25.1") (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") -(set-advertised-calling-convention 'decode-char '(ch charset) "21.4") -(set-advertised-calling-convention 'encode-char '(ch charset) "21.4") ;;;; Obsolescence declarations for variables, and aliases. -;; Special "default-FOO" variables which contain the default value of -;; the "FOO" variable are nasty. Their implementation is brittle, and -;; slows down several unrelated variable operations; furthermore, they -;; can lead to really odd behavior if you decide to make them -;; buffer-local. - -;; Not used at all in Emacs, last time I checked: -(make-obsolete-variable 'default-mode-line-format 'mode-line-format "23.2") -(make-obsolete-variable 'default-header-line-format 'header-line-format "23.2") -(make-obsolete-variable 'default-line-spacing 'line-spacing "23.2") -(make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2") -(make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2") -(make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2") -(make-obsolete-variable 'default-left-margin 'left-margin "23.2") -(make-obsolete-variable 'default-tab-width 'tab-width "23.2") -(make-obsolete-variable 'default-case-fold-search 'case-fold-search "23.2") -(make-obsolete-variable 'default-left-margin-width 'left-margin-width "23.2") -(make-obsolete-variable 'default-right-margin-width 'right-margin-width "23.2") -(make-obsolete-variable 'default-left-fringe-width 'left-fringe-width "23.2") -(make-obsolete-variable 'default-right-fringe-width 'right-fringe-width "23.2") -(make-obsolete-variable 'default-fringes-outside-margins 'fringes-outside-margins "23.2") -(make-obsolete-variable 'default-scroll-bar-width 'scroll-bar-width "23.2") -(make-obsolete-variable 'default-vertical-scroll-bar 'vertical-scroll-bar "23.2") -(make-obsolete-variable 'default-indicate-empty-lines 'indicate-empty-lines "23.2") -(make-obsolete-variable 'default-indicate-buffer-boundaries 'indicate-buffer-boundaries "23.2") -(make-obsolete-variable 'default-fringe-indicator-alist 'fringe-indicator-alist "23.2") -(make-obsolete-variable 'default-fringe-cursor-alist 'fringe-cursor-alist "23.2") -(make-obsolete-variable 'default-scroll-up-aggressively 'scroll-up-aggressively "23.2") -(make-obsolete-variable 'default-scroll-down-aggressively 'scroll-down-aggressively "23.2") -(make-obsolete-variable 'default-fill-column 'fill-column "23.2") -(make-obsolete-variable 'default-cursor-type 'cursor-type "23.2") -(make-obsolete-variable 'default-cursor-in-non-selected-windows 'cursor-in-non-selected-windows "23.2") -(make-obsolete-variable 'default-buffer-file-coding-system 'buffer-file-coding-system "23.2") -(make-obsolete-variable 'default-major-mode 'major-mode "23.2") -(make-obsolete-variable 'default-enable-multibyte-characters - "use enable-multibyte-characters or set-buffer-multibyte instead" "23.2") - (make-obsolete-variable 'define-key-rebound-commands nil "23.2") (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") (make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") @@ -1361,6 +1331,9 @@ is converted into a string by expressing it in decimal." (make-obsolete 'process-filter-multibyte-p nil "23.1") (make-obsolete 'set-process-filter-multibyte nil "23.1") +(make-obsolete-variable 'command-debug-status + "expect it to be removed in a future version." "25.2") + ;; Lisp manual only updated in 22.1. (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro "before 19.34") @@ -1529,6 +1502,10 @@ FUN is then called once." (declare (indent 2) (debug (form sexp body)) (obsolete "use a <foo>-function variable modified by `add-function'." "24.4")) + `(subr--with-wrapper-hook-no-warnings ,hook ,args ,@body)) + +(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body) + "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings." ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -1604,7 +1581,7 @@ can do the job." ;; FIXME: We should also emit a warning for let-bound ;; variables with dynamic binding. (when (assq sym byte-compile--lexical-environment) - (byte-compile-log-warning msg t :error)))) + (byte-compile-report-error msg :fill)))) (code (macroexp-let2 macroexp-copyable-p x element `(if ,(if compare-fn @@ -1719,6 +1696,11 @@ if it is empty or a duplicate." (make-variable-buffer-local 'delayed-mode-hooks) (put 'delay-mode-hooks 'permanent-local t) +(defvar delayed-after-hook-forms nil + "List of delayed :after-hook forms waiting to be run. +These forms come from `define-derived-mode'.") +(make-variable-buffer-local 'delayed-after-hook-forms) + (defvar change-major-mode-after-body-hook nil "Normal hook run in major mode functions, before the mode hooks.") @@ -1727,12 +1709,19 @@ if it is empty or a duplicate." (defun run-mode-hooks (&rest hooks) "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS. -If the variable `delay-mode-hooks' is non-nil, does not run any hooks, +Call `hack-local-variables' to set up file local and directory local +variables. + +If the variable `delay-mode-hooks' is non-nil, does not do anything, just adds the HOOKS to the list `delayed-mode-hooks'. Otherwise, runs hooks in the sequence: `change-major-mode-after-body-hook', -`delayed-mode-hooks' (in reverse order), HOOKS, and finally -`after-change-major-mode-hook'. Major mode functions should use -this instead of `run-hooks' when running their FOO-mode-hook." +`delayed-mode-hooks' (in reverse order), HOOKS, then runs +`hack-local-variables', runs the hook `after-change-major-mode-hook', and +finally evaluates the forms in `delayed-after-hook-forms' (see +`define-derived-mode'). + +Major mode functions should use this instead of `run-hooks' when +running their FOO-mode-hook." (if delay-mode-hooks ;; Delaying case. (dolist (hook hooks) @@ -1741,7 +1730,13 @@ this instead of `run-hooks' when running their FOO-mode-hook." (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) (setq delayed-mode-hooks nil) (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks)) - (run-hooks 'after-change-major-mode-hook))) + (if (buffer-file-name) + (with-demoted-errors "File local-variables error: %s" + (hack-local-variables 'no-mode))) + (run-hooks 'after-change-major-mode-hook) + (dolist (form (nreverse delayed-after-hook-forms)) + (eval form)) + (setq delayed-after-hook-forms nil))) (defmacro delay-mode-hooks (&rest body) "Execute BODY, but delay any `run-mode-hooks'. @@ -1884,7 +1879,7 @@ definition, variable definition, or face definition only." (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) (let ((files load-history) - file) + file match) (while files (if (if type (if (eq type 'defvar) @@ -1895,7 +1890,8 @@ definition, variable definition, or face definition only." ;; We accept all types, so look for variable def ;; and then for any other kind. (or (member symbol (cdr (car files))) - (rassq symbol (cdr (car files))))) + (and (setq match (rassq symbol (cdr (car files)))) + (not (eq 'require (car match)))))) (setq file (car (car files)) files nil)) (setq files (cdr files))) file))) @@ -1947,7 +1943,7 @@ this process is not associated with any buffer. PROGRAM is the program file name. It is searched for in `exec-path' \(which see). If nil, just associate a pty with the buffer. Remaining -arguments are strings to give program as arguments. +arguments PROGRAM-ARGS are strings to give program as arguments. If you want to separate standard output from standard error, use `make-process' or invoke the command through a shell and redirect @@ -2086,6 +2082,10 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (aref keys 1) key))) (cancel-timer timer) + ;; For some reason, `read-key(-sequence)' leaves the prompt in the echo + ;; area, whereas `read-event' seems to empty it just before returning + ;; (bug#22714). So, let's mimic the behavior of `read-event'. + (message nil) (use-global-map old-global-map)))) (defvar read-passwd-map @@ -2233,171 +2233,6 @@ keyboard-quit events while waiting for a valid input." (message "%s%s" prompt (char-to-string char)) char)) -(defun read-multiple-choice (prompt choices) - "Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is an alist where the first element in each entry is a -character to be entered, the second element is a short name for -the entry to be displayed while prompting (if there's room, it -might be shortened), and the third, optional entry is a longer -explanation that will be displayed in a help buffer if the user -requests more help. - -This function translates user input into responses by consulting -the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', and `scroll-down'. If the -user enters `recenter', `scroll-up', or `scroll-down' responses, -perform the requested window recentering or scrolling and ask -again. - -The return value is the matching entry from the CHOICES list. - -Usage example: - -\(read-multiple-choice \"Continue connecting?\" - '((?a \"always\") - (?s \"session only\") - (?n \"no\")))" - (let* ((altered-names nil) - (full-prompt - (format - "%s (%s): " - prompt - (mapconcat - (lambda (elem) - (let* ((name (cadr elem)) - (pos (seq-position name (car elem))) - (altered-name - (cond - ;; Not in the name string. - ((not pos) - (format "[%c] %s" (car elem) name)) - ;; The prompt character is in the name, so highlight - ;; it on graphical terminals... - ((display-supports-face-attributes-p - '(:underline t) (window-frame)) - (setq name (copy-sequence name)) - (put-text-property pos (1+ pos) - 'face 'read-multiple-choice-face - name) - name) - ;; And put it in [bracket] on non-graphical terminals. - (t - (concat - (substring name 0 pos) - "[" - (upcase (substring name pos (1+ pos))) - "]" - (substring name (1+ pos))))))) - (push (cons (car elem) altered-name) - altered-names) - altered-name)) - (append choices '((?? "?"))) - ", "))) - tchar buf wrong-char answer) - (save-window-excursion - (save-excursion - (while (not tchar) - (message "%s%s" - (if wrong-char - "Invalid choice. " - "") - full-prompt) - (setq tchar - (if (and (display-popup-menus-p) - last-input-event ; not during startup - (listp last-nonmenu-event) - use-dialog-box) - (x-popup-dialog - t - (cons prompt - (mapcar - (lambda (elem) - (cons (capitalize (cadr elem)) - (car elem))) - choices))) - (condition-case nil - (let ((cursor-in-echo-area t)) - (read-char)) - (error nil)))) - (setq answer (lookup-key query-replace-map (vector tchar) t)) - (setq tchar - (cond - ((eq answer 'recenter) - (recenter) t) - ((eq answer 'scroll-up) - (ignore-errors (scroll-up-command)) t) - ((eq answer 'scroll-down) - (ignore-errors (scroll-down-command)) t) - ((eq answer 'scroll-other-window) - (ignore-errors (scroll-other-window)) t) - ((eq answer 'scroll-other-window-down) - (ignore-errors (scroll-other-window-down)) t) - (t tchar))) - (when (eq tchar t) - (setq wrong-char nil - tchar nil)) - ;; The user has entered an invalid choice, so display the - ;; help messages. - (when (and (not (eq tchar nil)) - (not (assq tchar choices))) - (setq wrong-char (not (memq tchar '(?? ?\C-h))) - tchar nil) - (when wrong-char - (ding)) - (with-help-window (setq buf (get-buffer-create - "*Multiple Choice Help*")) - (with-current-buffer buf - (erase-buffer) - (pop-to-buffer buf) - (insert prompt "\n\n") - (let* ((columns (/ (window-width) 25)) - (fill-column 21) - (times 0) - (start (point))) - (dolist (elem choices) - (goto-char start) - (unless (zerop times) - (if (zerop (mod times columns)) - ;; Go to the next "line". - (goto-char (setq start (point-max))) - ;; Add padding. - (while (not (eobp)) - (end-of-line) - (insert (make-string (max (- (* (mod times columns) - (+ fill-column 4)) - (current-column)) - 0) - ?\s)) - (forward-line 1)))) - (setq times (1+ times)) - (let ((text - (with-temp-buffer - (insert (format - "%c: %s\n" - (car elem) - (cdr (assq (car elem) altered-names)))) - (fill-region (point-min) (point-max)) - (when (nth 2 elem) - (let ((start (point))) - (insert (nth 2 elem)) - (unless (bolp) - (insert "\n")) - (fill-region start (point-max)))) - (buffer-string)))) - (goto-char start) - (dolist (line (split-string text "\n")) - (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) - (forward-line 1))))))))))) - (when (buffer-live-p buf) - (kill-buffer buf)) - (assq tchar choices))) - (defun sit-for (seconds &optional nodisp obsolete) "Redisplay, then wait for SECONDS seconds. Stop when input is available. SECONDS may be a floating-point value. @@ -2471,7 +2306,8 @@ floating point support." (declare-function x-popup-dialog "menu.c" (position contents &optional header)) (defun y-or-n-p (prompt) - "Ask user a \"y or n\" question. Return t if answer is \"y\". + "Ask user a \"y or n\" question. +Return t if answer is \"y\" and nil if it is \"n\". PROMPT is the string to display to ask the question. It should end in a space; `y-or-n-p' adds \"(y or n) \" to it. @@ -2646,26 +2482,27 @@ This finishes the change group by reverting all of its changes." ;; Widen buffer temporarily so if the buffer was narrowed within ;; the body of `atomic-change-group' all changes can be undone. (widen) - (let ((old-car - (if (consp elt) (car elt))) - (old-cdr - (if (consp elt) (cdr elt)))) - ;; Temporarily truncate the undo log at ELT. - (when (consp elt) - (setcar elt nil) (setcdr elt nil)) - (unless (eq last-command 'undo) (undo-start)) - ;; Make sure there's no confusion. - (when (and (consp elt) (not (eq elt (last pending-undo-list)))) - (error "Undoing to some unrelated state")) - ;; Undo it all. - (save-excursion - (while (listp pending-undo-list) (undo-more 1))) - ;; Reset the modified cons cell ELT to its original content. - (when (consp elt) - (setcar elt old-car) - (setcdr elt old-cdr)) - ;; Revert the undo info to what it was when we grabbed the state. - (setq buffer-undo-list elt)))))) + (let ((old-car (car-safe elt)) + (old-cdr (cdr-safe elt))) + (unwind-protect + (progn + ;; Temporarily truncate the undo log at ELT. + (when (consp elt) + (setcar elt nil) (setcdr elt nil)) + (unless (eq last-command 'undo) (undo-start)) + ;; Make sure there's no confusion. + (when (and (consp elt) (not (eq elt (last pending-undo-list)))) + (error "Undoing to some unrelated state")) + ;; Undo it all. + (save-excursion + (while (listp pending-undo-list) (undo-more 1))) + ;; Revert the undo info to what it was when we grabbed + ;; the state. + (setq buffer-undo-list elt)) + ;; Reset the modified cons cell ELT to its original content. + (when (consp elt) + (setcar elt old-car) + (setcdr elt old-cdr)))))))) ;;;; Display-related functions. @@ -3003,9 +2840,11 @@ remove properties specified by `yank-excluded-properties'." (defvar yank-undo-function) (defun insert-for-yank (string) - "Call `insert-for-yank-1' repetitively for each `yank-handler' segment. + "Insert STRING at point for the `yank' command. -See `insert-for-yank-1' for more details." +This function is like `insert', except it honors the variables +`yank-handled-properties' and `yank-excluded-properties', and the +`yank-handler' text property, in the way that `yank' does." (let (to) (while (setq to (next-single-property-change 0 'yank-handler string)) (insert-for-yank-1 (substring string 0 to)) @@ -3013,31 +2852,7 @@ See `insert-for-yank-1' for more details." (insert-for-yank-1 string)) (defun insert-for-yank-1 (string) - "Insert STRING at point for the `yank' command. -This function is like `insert', except it honors the variables -`yank-handled-properties' and `yank-excluded-properties', and the -`yank-handler' text property. - -Properties listed in `yank-handled-properties' are processed, -then those listed in `yank-excluded-properties' are discarded. - -If STRING has a non-nil `yank-handler' property on its first -character, the normal insert behavior is altered. The value of -the `yank-handler' property must be a list of one to four -elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO). -FUNCTION, if non-nil, should be a function of one argument, an - object to insert; it is called instead of `insert'. -PARAM, if present and non-nil, replaces STRING as the argument to - FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM - may be a list of strings to insert as a rectangle. -If NOEXCLUDE is present and non-nil, the normal removal of - `yank-excluded-properties' is not performed; instead FUNCTION is - responsible for the removal. This may be necessary if FUNCTION - adjusts point before or after inserting the object. -UNDO, if present and non-nil, should be a function to be called - by `yank-pop' to undo the insertion of the current object. It is - given two arguments, the start and end of the region. FUNCTION - may set `yank-undo-function' to override UNDO." + "Helper for `insert-for-yank', which see." (let* ((handler (and (stringp string) (get-text-property 0 'yank-handler string))) (param (or (nth 1 handler) string)) @@ -3188,6 +3003,28 @@ Similar to `call-process-shell-command', but calls `process-file'." infile buffer display (if (file-remote-p default-directory) "-c" shell-command-switch) (mapconcat 'identity (cons command args) " "))) + +(defun call-shell-region (start end command &optional delete buffer) + "Send text from START to END as input to an inferior shell running COMMAND. +Delete the text if fourth arg DELETE is non-nil. + +Insert output in BUFFER before point; t means current buffer; nil for + BUFFER means discard it; 0 means discard and don't wait; and `(:file + FILE)', where FILE is a file name string, means that it should be + written to that file (if the file already exists it is overwritten). +BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, +REAL-BUFFER says what to do with standard output, as above, +while STDERR-FILE says what to do with standard error in the child. +STDERR-FILE may be nil (discard standard error output), +t (mix it with ordinary output), or a file name string. + +If BUFFER is 0, `call-shell-region' returns immediately with value nil. +Otherwise it waits for COMMAND to terminate +and returns a numeric exit status or a signal description string. +If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." + (call-process-region start end + shell-file-name delete buffer nil + shell-command-switch command)) ;;;; Lisp macros to do various things temporarily. @@ -3447,6 +3284,8 @@ See also `with-temp-file' and `with-output-to-string'." (defmacro with-silent-modifications (&rest body) "Execute BODY, pretending it does not modify the buffer. +This macro is Typically used around modifications of +text-properties which do not really affect the buffer's content. If BODY performs real modifications to the buffer's text, other than cosmetic ones, undo data may become corrupted. @@ -3454,10 +3293,7 @@ This macro will run BODY normally, but doesn't count its buffer modifications as being buffer modifications. This affects things like `buffer-modified-p', checking whether the file is locked by someone else, running buffer modification hooks, and other things -of that nature. - -Typically used around modifications of text-properties which do -not really affect the buffer's content." +of that nature." (declare (debug t) (indent 0)) (let ((modified (make-symbol "modified"))) `(let* ((,modified (buffer-modified-p)) @@ -3500,6 +3336,11 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; that intends to handle the quit signal next time. (eval '(ignore nil))))) +;; Don't throw `throw-on-input' on those events by default. +(setq while-no-input-ignore-events + '(focus-in focus-out help-echo iconify-frame + make-frame-visible selection-request)) + (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. If input arrives, that ends the execution of BODY, @@ -3851,7 +3692,10 @@ Modifies the match data; use `save-match-data' if necessary." "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). This tries to quote the strings to avoid ambiguity such that (split-string-and-unquote (combine-and-quote-strings strs)) == strs -Only some SEPARATORs will work properly." +Only some SEPARATORs will work properly. + +Note that this is not intended to protect STRINGS from +interpretation by shells, use `shell-quote-argument' for that." (let* ((sep (or separator " ")) (re (concat "[\\\"]" "\\|" (regexp-quote sep)))) (mapconcat @@ -3907,9 +3751,9 @@ the match data are the result of matching REGEXP against a substring of STRING, the same substring that is the actual text of the match which is passed to REP as its argument. -To replace only the first match (if any), make REGEXP match up to \\' +To replace only the first match (if any), make REGEXP match up to \\\\=' and replace a sub-expression, e.g. - (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) + (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\\\='\" \"bar\" \" foo foo\" nil nil 1) => \" bar foo\"" ;; To avoid excessive consing from multiple matches in long strings, @@ -4106,7 +3950,8 @@ This function makes or adds to an entry on `after-load-alist'." (defmacro with-eval-after-load (file &rest body) "Execute BODY after FILE is loaded. FILE is normally a feature name, but it can also be a file name, -in case that file does not provide any feature." +in case that file does not provide any feature. See `eval-after-load' +for more details about the different forms of FILE and their semantics." (declare (indent 1) (debug t)) `(eval-after-load ,file (lambda () ,@body))) @@ -4143,7 +3988,7 @@ This function is called directly from the C code." (expand-file-name byte-compile-current-file byte-compile-root-dir))) - (byte-compile-log-warning msg)) + (byte-compile-warn "%s" msg)) (run-with-timer 0 nil (lambda (msg) (message "%s" msg)) @@ -4267,6 +4112,39 @@ If SYNTAX is nil, return nil." ;; Utility motion commands +(defvar word-move-empty-char-table nil + "Used in `forward-word-strictly' and `backward-word-strictly' +to countermand the effect of `find-word-boundary-function-table'.") + +(defun forward-word-strictly (&optional arg) + "Move point forward ARG words (backward if ARG is negative). +If ARG is omitted or nil, move point forward one word. +Normally returns t. +If an edge of the buffer or a field boundary is reached, point is left there +and the function returns nil. Field boundaries are not noticed if +`inhibit-field-text-motion' is non-nil. + +This function is like `forward-word', but it is not affected +by `find-word-boundary-function-table'. It is also not interactive." + (let ((find-word-boundary-function-table + (if (char-table-p word-move-empty-char-table) + word-move-empty-char-table + (setq word-move-empty-char-table (make-char-table nil))))) + (forward-word (or arg 1)))) + +(defun backward-word-strictly (&optional arg) + "Move backward until encountering the beginning of a word. +With argument ARG, do this that many times. +If ARG is omitted or nil, move point backward one word. + +This function is like `forward-word', but it is not affected +by `find-word-boundary-function-table'. It is also not interactive." + (let ((find-word-boundary-function-table + (if (char-table-p word-move-empty-char-table) + word-move-empty-char-table + (setq word-move-empty-char-table (make-char-table nil))))) + (forward-word (- (or arg 1))))) + ;; Whitespace (defun forward-whitespace (arg) @@ -4619,7 +4497,8 @@ to deactivate this transient map, regardless of KEEP-PRED." (with-demoted-errors "set-transient-map PCH: %S" (unless (cond ((null keep-pred) nil) - ((not (eq map (cadr overriding-terminal-local-map))) + ((and (not (eq map (cadr overriding-terminal-local-map))) + (memq map (cddr overriding-terminal-local-map))) ;; There's presumably some other transient-map in ;; effect. Wait for that one to terminate before we ;; remove ourselves. @@ -4632,8 +4511,10 @@ to deactivate this transient map, regardless of KEEP-PRED." ;; exit C-u. t) ((eq t keep-pred) - (eq this-command - (lookup-key map (this-command-keys-vector)))) + (let ((mc (lookup-key map (this-command-keys-vector)))) + ;; If the key is unbound `this-command` is + ;; nil and so is `mc`. + (and mc (eq this-command mc)))) (t (funcall keep-pred))) (funcall exitfun))))) (add-hook 'pre-command-hook clearfun) @@ -5073,6 +4954,26 @@ as a list.") ;;; Misc. + +(defvar definition-prefixes (make-hash-table :test 'equal) + "Hash table mapping prefixes to the files in which they're used. +This can be used to automatically fetch not-yet-loaded definitions. +More specifically, if there is a value of the form (FILES...) for a string PREFIX +it means that the FILES define variables or functions with names that start +with PREFIX. + +Note that it does not imply that all definitions starting with PREFIX can +be found in those files. E.g. if prefix is \"gnus-article-\" there might +still be definitions of the form \"gnus-article-toto-titi\" in other files, which would +presumably appear in this table under another prefix such as \"gnus-\" +or \"gnus-article-toto-\".") + +(defun register-definition-prefixes (file prefixes) + "Register that FILE uses PREFIXES." + (dolist (prefix prefixes) + (puthash prefix (cons file (gethash prefix definition-prefixes)) + definition-prefixes))) + (defconst menu-bar-separator '("--") "Separator for menus.") diff --git a/lisp/svg.el b/lisp/svg.el index b6beaadc032..a92c6dfb610 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -27,16 +27,17 @@ (require 'cl-lib) (require 'xml) (require 'dom) +(require 'subr-x) (defun svg-create (width height &rest args) - "Create a new, empty SVG image with dimentions WIDTHxHEIGHT. + "Create a new, empty SVG image with dimensions WIDTHxHEIGHT. ARGS can be used to provide `stroke' and `stroke-width' parameters to any further elements added." (dom-node 'svg `((width . ,width) (height . ,height) (version . "1.1") - (xmlsn . "http://www.w3.org/2000/svg") + (xmlns . "http://www.w3.org/2000/svg") ,@(svg--arguments nil args)))) (defun svg-gradient (svg id type stops) @@ -137,16 +138,48 @@ POINTS is a list of x/y pairs." ", ")) ,@(svg--arguments svg args))))) +(defun svg-embed (svg image image-type datap &rest args) + "Insert IMAGE into the SVG structure. +IMAGE should be a file name if DATAP is nil, and a binary string +otherwise. IMAGE-TYPE should be a MIME image type, like +\"image/jpeg\" or the like." + (svg--append + svg + (dom-node + 'image + `((xlink:href . ,(svg--image-data image image-type datap)) + ,@(svg--arguments svg args))))) + +(defun svg-text (svg text &rest args) + "Add TEXT to SVG." + (svg--append + svg + (dom-node + 'text + `(,@(svg--arguments svg args)) + text))) + (defun svg--append (svg node) (let ((old (and (dom-attr node 'id) (dom-by-id svg (concat "\\`" (regexp-quote (dom-attr node 'id)) "\\'"))))) (if old - (dom-set-attributes old (dom-attributes node)) + (setcdr (car old) (cdr node)) (dom-append-child svg node))) (svg-possibly-update-image svg)) +(defun svg--image-data (image image-type datap) + (with-temp-buffer + (set-buffer-multibyte nil) + (if datap + (insert image) + (insert-file-contents image)) + (base64-encode-region (point-min) (point-max) t) + (goto-char (point-min)) + (insert "data:" image-type ";base64,") + (buffer-string))) + (defun svg--arguments (svg args) (let ((stroke-width (or (plist-get args :stroke-width) (dom-attr svg 'stroke-width))) @@ -214,16 +247,26 @@ If the SVG is later changed, the image will also be updated." (defun svg-print (dom) "Convert DOM into a string containing the xml representation." - (insert (format "<%s" (car dom))) - (dolist (attr (nth 1 dom)) - ;; Ignore attributes that start with a colon. - (unless (= (aref (format "%s" (car attr)) 0) ?:) - (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) - (insert ">") - (dolist (elem (nthcdr 2 dom)) - (insert " ") - (svg-print elem)) - (insert (format "</%s>" (car dom)))) + (if (stringp dom) + (insert dom) + (insert (format "<%s" (car dom))) + (dolist (attr (nth 1 dom)) + ;; Ignore attributes that start with a colon. + (unless (= (aref (format "%s" (car attr)) 0) ?:) + (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) + (insert ">") + (dolist (elem (nthcdr 2 dom)) + (insert " ") + (svg-print elem)) + (insert (format "</%s>" (car dom))))) + +(defun svg-remove (svg id) + "Remove the element identified by ID from SVG." + (when-let ((node (car (dom-by-id + svg + (concat "\\`" (regexp-quote id) + "\\'"))))) + (dom-remove-node svg node))) (provide 'svg) diff --git a/lisp/term.el b/lisp/term.el index c1e827875d1..a4c652bad7f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -849,6 +849,7 @@ is buffer-local." (define-key map [S-insert] 'term-paste) (define-key map [prior] 'term-send-prior) (define-key map [next] 'term-send-next) + (define-key map [xterm-paste] #'term--xterm-paste) map) "Keyboard map for sending characters directly to the inferior process.") @@ -919,19 +920,6 @@ is buffer-local." (term-set-escape-char (or term-escape-char ?\C-c)) -(defvar overflow-newline-into-fringe) - -(defun term-window-width () - (if (and (not (featurep 'xemacs)) - (display-graphic-p) - overflow-newline-into-fringe - ;; Subtract 1 from the width when any fringe has zero width, - ;; not just the right fringe. Bug#18601. - (/= (frame-parameter nil 'left-fringe) 0) - (/= (frame-parameter nil 'right-fringe) 0)) - (window-body-width) - (1- (window-body-width)))) - (put 'term-mode 'mode-class 'special) @@ -1018,7 +1006,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq buffer-display-table term-display-table) (set (make-local-variable 'term-home-marker) (copy-marker 0)) (set (make-local-variable 'term-height) (1- (window-height))) - (set (make-local-variable 'term-width) (term-window-width)) + (set (make-local-variable 'term-width) (window-max-chars-per-line)) (set (make-local-variable 'term-last-input-start) (make-marker)) (set (make-local-variable 'term-last-input-end) (make-marker)) (set (make-local-variable 'term-last-input-match) "") @@ -1122,12 +1110,16 @@ Entry to this mode runs the hooks on `term-mode-hook'." (term-update-mode-line)) (defun term-reset-size (height width) - (setq term-height height) - (setq term-width width) - (setq term-start-line-column nil) - (setq term-current-row nil) - (setq term-current-column nil) - (term-set-scroll-region 0 height)) + (when (or (/= height term-height) + (/= width term-width)) + (let ((point (point))) + (setq term-height height) + (setq term-width width) + (setq term-start-line-column nil) + (setq term-current-row nil) + (setq term-current-column nil) + (term-set-scroll-region 0 height) + (goto-char point)))) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. @@ -1213,6 +1205,13 @@ without any interpretation." (interactive) (term-send-raw-string (current-kill 0))) +(defun term--xterm-paste () + "Insert the text pasted in an XTerm bracketed paste operation." + (interactive) + (term-send-raw-string (xterm--pasted-text))) + +(declare-function xterm--pasted-text "term/xterm" ()) + ;; Which would be better: "\e[A" or "\eOA"? readline accepts either. ;; For my configuration it's definitely better \eOA but YMMV. -mm ;; For example: vi works with \eOA while elm wants \e[A ... @@ -1462,6 +1461,13 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.") (format "TERMINFO=%s" data-directory) (format term-termcap-format "TERMCAP=" term-term-name term-height term-width) + + ;; This is for backwards compatibility with Bash 4.3 and earlier. + ;; Remove this hack once Bash 4.4-or-later is common, because + ;; it breaks './configure' of some packages that expect it to + ;; say where to find EMACS. + (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) + (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version) (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) @@ -3253,6 +3259,10 @@ See `term-prompt-regexp'." ;; \E[D - cursor left (terminfo: cub) ((eq char ?D) (term-move-columns (- (max 1 term-terminal-parameter)))) + ;; \E[G - cursor motion to absolute column (terminfo: hpa) + ((eq char ?G) + (term-move-columns (- (max 0 (min term-width term-terminal-parameter)) + (term-current-column)))) ;; \E[J - clear to end of screen (terminfo: ed, clear) ((eq char ?J) (term-erase-in-display term-terminal-parameter)) diff --git a/lisp/term/internal.el b/lisp/term/internal.el index f73a107df87..0fd0f2237a5 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -233,13 +233,13 @@ "U*!" "U*'" "R*;" "!:" ":'" "!*" nil nil nil "w*j" nil nil "w*?" nil "O*!" "O*'" "W*!" "W*'" "W*J" "/*" ";;" nil nil nil "1N" "1M" "3M" "4M" "6M" nil ; Gen Punct - nil "1T" "1H" nil nil nil "LRM" "RLM" "-1" nil - nil "--" "---" "===" "!2" "=2" "6`" "'9" ".9" "9'" - "``" "''" ":9" "9``" "/-" "/=" "sb" "3b" nil ".." + nil "1T" "1H" nil nil nil "LRM" "RLM" "-" "-" + "-" "--" "---" "===" "!2" "=2" "'" "'" ".9" "9'" + "\"" "\"" ":9" "9``" "/-" "/=" "sb" "3b" nil ".." "..." ".-" "LSep" "PSep" "LR[" "RL[" "PDF" "LRO" "RLO" 255 "%o" "%oo" "'" "''" "\"'" "`" "``" "```" ".^" "<," ",>" ":X" "!!" "?!" "'-" nil nil nil nil "-b" - "/f" nil nil nil nil nil nil nil nil nil + "/f" nil nil "??" "?!" "!?" nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil @@ -265,17 +265,17 @@ "oK" "AO" nil nil "Est" nil nil nil nil nil nil "Aleph" "Bet" "Gimel" "Dalet" "=i=" nil nil nil nil nil nil nil nil nil nil nil nil nil nil - nil nil nil nil nil nil nil nil nil nil - nil "1/3" "2/3" "1/5" "2/5" "3/5" "4/5" "1/6" "5/6" "1/8" + nil nil nil nil nil nil nil nil "1/7" "1/9" + "1/10" "1/3" "2/3" "1/5" "2/5" "3/5" "4/5" "1/6" "5/6" "1/8" "3/8" "5/8" "7/8" "1/" ".I" "II" "III" "IV" ".V" "VI" "VII" "VIII" "IX" "X" "XI" "XII" ".L" ".C" ".D" ".M" ".i" "ii" "iii" "iv" ".v" "vi" "vii" "viii" "ix" ".x" - "xi" ".l" ".c" ".d" ".m" "CD" "DD" "CoD" "CI" nil + "xi" "xii" ".l" ".c" ".d" ".m" "CD" "DD" "CoD" "CI" nil nil nil nil nil nil nil nil nil nil - nil "<-" "|^" "->" "|v" "<->" "v|^" "^\\" "/^" "\\v" - "v/" "<-/" "/->" "<~" "~>" "<<-" "|^^" "->>" "|vv" "<-<" - ">->" "<-|" "_|^" "|->" "-|v" "_v|^" "<-?" "?->" "<-o" "o->" - "<~>" "<-/>" nil nil nil nil nil nil nil nil + nil nil "<-" "|^" "->" "|v" "<->" "v|^" "^\\" "/^" + "\\v" "v/" "<-/" "/->" "<~" "~>" "<<-" "|^^" "->>" "|vv" + "<-<" ">->" "<-|" "_|^" "|->" "-|v" "_v|^" "<-?" "?->" "<-o" + "o->" "<~>" "<-/>" nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil "<=/" "<=/>" "/=>" "<=" "||^" "=>" "||v" @@ -299,7 +299,7 @@ "~<'" "`>~" "/<'" "/`>" "(C" ")C" "/(C" "/)C" "(_" ")_" "/(_" "/)_" nil nil nil nil nil nil nil nil nil nil nil "0+" "0-" "0x" "0/" "0." "0o" "0*" - "0=" "0_" nil nil nil nil "|T" "T|" "-T" "_T" + "0=" "0_" nil nil nil nil "|-" "-|" "-T" "_T" nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil "-,-" nil "XOR" "NAND" "NOR" nil nil nil nil nil nil @@ -357,8 +357,10 @@ "M-o" "N-o" "O-o" "P-o" "Q-o" "R-o" "S-o" "T-o" "U-o" "V-o" "W-o" "X-o" "Y-o" "Z-o" "a-o" "b-o" "c-o" "d-o" "e-o" "f-o" "g-o" "h-o" "i-o" "j-o" "k-o" "l-o" "m-o" "n-o" "o-o" "p-o" - "q-o" "r-o" "s-o" "t-o" "u-o" "v-o" "w-o" "x-o" "y-o" "z-o" - "0-o" ] + "q-o" "r-o" "s-o" "t-o" "u-o" "v-o" "w-o" "x-o" "y-o" "z-o" "0-o" ] + ) + (9733 9734 + ["-!-" "-*-"] ) ) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 452c68d0176..41d6d72812b 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -1,4 +1,4 @@ -;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*- +;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/macOS window system -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 2005-2016 Free Software Foundation, Inc. @@ -41,7 +41,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) (or (featurep 'ns) - (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" + (error "%s: Loading ns-win.el but not compiled for GNUstep/macOS" (invocation-name))) ;; Documentation-purposes only: actually loaded in loadup.el. @@ -54,7 +54,7 @@ (require 'ucs-normalize) (defgroup ns nil - "GNUstep/Mac OS X specific features." + "GNUstep/macOS specific features." :group 'environment) ;;;; Command line argument handling. @@ -338,7 +338,7 @@ See `ns-insert-working-text'." (setq ns-working-overlay nil)) -;; OS X file system Unicode UTF-8 NFD (decomposed form) support. +;; macOS file system Unicode UTF-8 NFD (decomposed form) support. (when (eq system-type 'darwin) ;; Used prior to Emacs 25. (define-coding-system-alias 'utf-8-nfd 'utf-8-hfs) @@ -641,7 +641,7 @@ This function has been overloaded in Nextstep.") (set-frame-font ns-input-font)) -;; Default fontset for Mac OS X. This is mainly here to show how a fontset +;; Default fontset for macOS. This is mainly here to show how a fontset ;; can be set up manually. Ordinarily, fontsets are auto-created whenever ;; a font is chosen by (defvar ns-standard-fontset-spec @@ -655,7 +655,7 @@ This function has been overloaded in Nextstep.") ",") "String of fontset spec of the standard fontset. This defines a fontset consisting of the Courier and other fonts that -come with OS X. +come with macOS. See the documentation of `create-fontset-from-fontset-spec' for the format.") (defvar ns-reg-to-script) ; nsfont.m @@ -717,60 +717,12 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;;;; Scrollbar handling. -(global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) +(global-set-key [vertical-scroll-bar down-mouse-1] 'scroll-bar-toolkit-scroll) +(global-set-key [horizontal-scroll-bar down-mouse-1] 'scroll-bar-toolkit-horizontal-scroll) (global-unset-key [vertical-scroll-bar mouse-1]) (global-unset-key [vertical-scroll-bar drag-mouse-1]) - -(declare-function scroll-bar-scale "scroll-bar" (num-denom whole)) - -(defun ns-scroll-bar-move (event) - "Scroll the frame according to a Nextstep scroller event." - (interactive "e") - (let* ((pos (event-end event)) - (window (nth 0 pos)) - (scale (nth 2 pos))) - (with-current-buffer (window-buffer window) - (cond - ((eq (car scale) (cdr scale)) - (goto-char (point-max))) - ((= (car scale) 0) - (goto-char (point-min))) - (t - (goto-char (+ (point-min) 1 - (scroll-bar-scale scale (- (point-max) (point-min))))))) - (beginning-of-line) - (set-window-start window (point)) - (vertical-motion (/ (window-height window) 2) window)))) - -(defun ns-handle-scroll-bar-event (event) - "Handle scroll bar EVENT to emulate Nextstep style scrolling." - (interactive "e") - (let* ((position (event-start event)) - (bar-part (nth 4 position)) - (window (nth 0 position)) - (old-window (selected-window))) - (cond - ((eq bar-part 'ratio) - (ns-scroll-bar-move event)) - ((eq bar-part 'handle) - (if (eq window (selected-window)) - (track-mouse (ns-scroll-bar-move event)) - ;; track-mouse faster for selected window, slower for unselected. - (ns-scroll-bar-move event))) - (t - (select-window window) - (cond - ((eq bar-part 'up) - (goto-char (window-start window)) - (scroll-down 1)) - ((eq bar-part 'above-handle) - (scroll-down)) - ((eq bar-part 'below-handle) - (scroll-up)) - ((eq bar-part 'down) - (goto-char (window-start window)) - (scroll-up 1))) - (select-window old-window))))) +(global-unset-key [horizontal-scroll-bar mouse-1]) +(global-unset-key [horizontal-scroll-bar drag-mouse-1]) ;;;; Color support. @@ -892,7 +844,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (setq default-process-coding-system '(utf-8-unix . utf-8-unix))))) - ;; OS X Lion introduces PressAndHold, which is unsupported by this port. + ;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port. ;; See this thread for more details: ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html (ns-set-resource nil "ApplePressAndHoldEnabled" "NO") diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 8f3eaa2c029..d8cf5efcfab 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -177,12 +177,15 @@ the last file dropped is selected." ;;; make f10 activate the real menubar rather than the mini-buffer menu ;;; navigation feature. - (defun w32-menu-bar-open (&optional frame) +(defun w32-menu-bar-open (&optional frame) "Start key navigation of the menu bar in FRAME. This initially activates the first menu-bar item, and you can then navigate with the arrow keys, select a menu entry with the Return key or cancel with -the Escape key. If FRAME has no menu bar, this function does nothing. +one or two Escape keypresses. (Two Escape keypresses are needed when a +menu was already dropped down by pressing Return.) + +If FRAME has no menu bar, this function does nothing. If FRAME is nil or not given, use the selected frame. If FRAME does not have the menu bar enabled, display a text menu using @@ -397,11 +400,15 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (put 'x-selections (or type 'PRIMARY) value))) (defun w32--get-selection (&optional type data-type) - (if (and (eq type 'CLIPBOARD) - (eq data-type 'STRING)) - (with-demoted-errors "w32-get-clipboard-data:%S" - (w32-get-clipboard-data)) - (get 'x-selections (or type 'PRIMARY)))) + (cond ((and (eq type 'CLIPBOARD) + (eq data-type 'STRING)) + (with-demoted-errors "w32-get-clipboard-data:%S" + (w32-get-clipboard-data))) + ((eq data-type 'TARGETS) + (if (eq type 'CLIPBOARD) + (w32-selection-targets type) + (if (get 'x-selections (or type 'PRIMARY)) '[STRING]))) + (t (get 'x-selections (or type 'PRIMARY))))) (defun w32--selection-owner-p (selection) (and (memq selection '(nil PRIMARY SECONDARY)) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 5a38ebe8e45..5fc6056ca23 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -71,28 +71,29 @@ string bytes that can be copied is 3/4 of this value." (defconst xterm-paste-ending-sequence "\e[201~" "Characters send by the terminal to end a bracketed paste.") +(defun xterm--pasted-text () + "Handle the rest of a terminal paste operation. +Return the pasted text as a string." + (let ((end-marker-length (length xterm-paste-ending-sequence))) + (with-temp-buffer + (set-buffer-multibyte nil) + (while (not (search-backward xterm-paste-ending-sequence + (- (point) end-marker-length) t)) + (let ((event (read-event nil nil + ;; Use finite timeout to avoid glomming the + ;; event onto this-command-keys. + most-positive-fixnum))) + (when (eql event ?\r) + (setf event ?\n)) + (insert event))) + (let ((last-coding-system-used)) + (decode-coding-region (point-min) (point) (keyboard-coding-system) + t))))) + (defun xterm-paste () "Handle the start of a terminal paste operation." (interactive) - (let* ((end-marker-length (length xterm-paste-ending-sequence)) - (pasted-text (with-temp-buffer - (set-buffer-multibyte nil) - (while (not (search-backward - xterm-paste-ending-sequence - (- (point) end-marker-length) t)) - (let ((event (read-event - nil nil - ;; Use finite timeout to avoid - ;; glomming the event onto - ;; this-command-keys. - most-positive-fixnum))) - (when (eql event ?\r) - (setf event ?\n)) - (insert event))) - (let ((last-coding-system-used)) - (decode-coding-region - (point-min) (point) - (keyboard-coding-system) t)))) + (let* ((pasted-text (xterm--pasted-text)) (interprogram-paste-function (lambda () pasted-text))) (yank))) @@ -783,7 +784,7 @@ We run the first FUNCTION whose STRING matches the input events." ;; Try to find out the type of terminal by sending a "Secondary ;; Device Attributes (DA)" query. (xterm--query "\e[>0c" - ;; Some terminals (like OS X's Terminal.app) respond to + ;; Some terminals (like macOS's Terminal.app) respond to ;; this query as if it were a "Primary Device Attributes" ;; query instead, so we should handle that too. '(("\e[?" . xterm--version-handler) diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 62b666b2524..8b40558e3a4 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -35,7 +35,7 @@ "Major mode for editing bib files." :prefix "bib-" :group 'external - :group 'wp) + :group 'text) (defcustom bib-file "~/my-bibliography.bib" "Default name of file used by `addbib'." diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 93a8dceec18..9e36a881a3e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -29,11 +29,14 @@ ;; - electric ; and } ;; - filling code with auto-fill-mode -;; - attribute value completion ;; - fix font-lock errors with multi-line selectors ;;; Code: +(require 'seq) +(require 'sgml-mode) +(require 'smie) + (defgroup css nil "Cascading Style Sheets (CSS) editing mode." :group 'languages) @@ -51,9 +54,20 @@ "Identifiers for pseudo-elements.") (defconst css-at-ids - '("charset" "font-face" "import" "media" "namespace" "page") + '("charset" "font-face" "import" "keyframes" "media" "namespace" + "page" "supports") "Identifiers that appear in the form @foo.") +(defconst scss-at-ids + '("at-root" "content" "debug" "each" "else" "else if" "error" "extend" + "for" "function" "if" "import" "include" "mixin" "return" "warn" + "while") + "Additional identifiers that appear in the form @foo in SCSS.") + +(defvar css--at-ids css-at-ids + "List of at-rules for the current mode.") +(make-variable-buffer-local 'css--at-ids) + (defconst css-bang-ids '("important") "Identifiers that appear in the form !foo.") @@ -62,6 +76,10 @@ '("default" "global" "optional") "Additional identifiers that appear in the form !foo in SCSS.") +(defvar css--bang-ids css-bang-ids + "List of bang-rules for the current mode.") +(make-variable-buffer-local 'css--bang-ids) + (defconst css-descriptor-ids '("ascent" "baseline" "bbox" "cap-height" "centerline" "definition-src" "descent" "font-family" "font-size" "font-stretch" "font-style" @@ -74,124 +92,504 @@ "visual") "Identifiers for types of media.") -(defconst css-property-ids - '(;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html). - ;; - ;; Properties duplicated by any of the CSS3 modules below have - ;; been removed. - "azimuth" "border-collapse" "border-spacing" "bottom" - "caption-side" "clear" "clip" "content" "counter-increment" - "counter-reset" "cue" "cue-after" "cue-before" "direction" "display" - "elevation" "empty-cells" "float" "height" "left" "line-height" - "list-style" "list-style-image" "list-style-position" - "list-style-type" "margin" "margin-bottom" "margin-left" - "margin-right" "margin-top" "max-height" "max-width" "min-height" - "min-width" "padding" "padding-bottom" "padding-left" - "padding-right" "padding-top" "page-break-after" - "page-break-before" "page-break-inside" "pause" "pause-after" - "pause-before" "pitch" "pitch-range" "play-during" "position" - "quotes" "richness" "right" "speak" "speak-header" "speak-numeral" - "speak-punctuation" "speech-rate" "stress" "table-layout" "top" - "unicode-bidi" "vertical-align" "visibility" "voice-family" "volume" - "width" "z-index" +(defconst css-property-alist + ;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html). + ;; + ;; Properties duplicated by any of the CSS3 modules below have been + ;; removed. + '(("azimuth" angle "left-side" "far-left" "left" "center-left" + "center" "center-right" "right" "far-right" "right-side" "behind" + "leftwards" "rightwards") + ("border-collapse" "collapse" "separate") + ("border-spacing" length) + ("bottom" length percentage "auto") + ("caption-side" "top" "bottom") + ("clear" "none" "left" "right" "both") + ("clip" shape "auto") + ("content" "normal" "none" string uri counter "attr()" + "open-quote" "close-quote" "no-open-quote" "no-close-quote") + ("counter-increment" identifier integer "none") + ("counter-reset" identifier integer "none") + ("cue" cue-before cue-after) + ("cue-after" uri "none") + ("cue-before" uri "none") + ("direction" "ltr" "rtl") + ("display" "inline" "block" "list-item" "inline-block" "table" + "inline-table" "table-row-group" "table-header-group" + "table-footer-group" "table-row" "table-column-group" + "table-column" "table-cell" "table-caption" "none" + ;; CSS Flexible Box Layout Module Level 1 + ;; (https://www.w3.org/TR/css3-flexbox/#valdef-display-flex) + "flex" "inline-flex") + ("elevation" angle "below" "level" "above" "higher" "lower") + ("empty-cells" "show" "hide") + ("float" "left" "right" "none") + ("height" length percentage "auto") + ("left" length percentage "auto") + ("line-height" "normal" number length percentage) + ("list-style" list-style-type list-style-position + list-style-image) + ("list-style-image" uri "none") + ("list-style-position" "inside" "outside") + ("list-style-type" "disc" "circle" "square" "decimal" + "decimal-leading-zero" "lower-roman" "upper-roman" "lower-greek" + "lower-latin" "upper-latin" "armenian" "georgian" "lower-alpha" + "upper-alpha" "none") + ("margin" margin-width) + ("margin-bottom" margin-width) + ("margin-left" margin-width) + ("margin-right" margin-width) + ("margin-top" margin-width) + ("max-height" length percentage "none") + ("max-width" length percentage "none") + ("min-height" length percentage) + ("min-width" length percentage) + ("padding" padding-width) + ("padding-bottom" padding-width) + ("padding-left" padding-width) + ("padding-right" padding-width) + ("padding-top" padding-width) + ("page-break-after" "auto" "always" "avoid" "left" "right") + ("page-break-before" "auto" "always" "avoid" "left" "right") + ("page-break-inside" "avoid" "auto") + ("pause" time percentage) + ("pause-after" time percentage) + ("pause-before" time percentage) + ("pitch" frequency "x-low" "low" "medium" "high" "x-high") + ("pitch-range" number) + ("play-during" uri "mix" "repeat" "auto" "none") + ("position" "static" "relative" "absolute" "fixed") + ("quotes" string "none") + ("richness" number) + ("right" length percentage "auto") + ("speak" "normal" "none" "spell-out") + ("speak-header" "once" "always") + ("speak-numeral" "digits" "continuous") + ("speak-punctuation" "code" "none") + ("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" + "faster" "slower") + ("stress" number) + ("table-layout" "auto" "fixed") + ("top" length percentage "auto") + ("unicode-bidi" "normal" "embed" "bidi-override") + ("vertical-align" "baseline" "sub" "super" "top" "text-top" + "middle" "bottom" "text-bottom" percentage length) + ("visibility" "visible" "hidden" "collapse") + ("voice-family" specific-voice generic-voice specific-voice + generic-voice) + ("volume" number percentage "silent" "x-soft" "soft" "medium" + "loud" "x-loud") + ("width" length percentage "auto") + ("z-index" "auto" integer) ;; CSS Animations ;; (http://www.w3.org/TR/css3-animations/#property-index) - "animation" "animation-delay" "animation-direction" - "animation-duration" "animation-fill-mode" - "animation-iteration-count" "animation-name" - "animation-play-state" "animation-timing-function" + ("animation" single-animation-name time single-timing-function + single-animation-iteration-count single-animation-direction + single-animation-fill-mode single-animation-play-state) + ("animation-delay" time) + ("animation-direction" single-animation-direction) + ("animation-duration" time) + ("animation-fill-mode" single-animation-fill-mode) + ("animation-iteration-count" single-animation-iteration-count) + ("animation-name" single-animation-name) + ("animation-play-state" single-animation-play-state) + ("animation-timing-function" single-timing-function) ;; CSS Backgrounds and Borders Module Level 3 ;; (http://www.w3.org/TR/css3-background/#property-index) - "background" "background-attachment" "background-clip" - "background-color" "background-image" "background-origin" - "background-position" "background-repeat" "background-size" - "border" "border-bottom" "border-bottom-color" - "border-bottom-left-radius" "border-bottom-right-radius" - "border-bottom-style" "border-bottom-width" "border-color" - "border-image" "border-image-outset" "border-image-repeat" - "border-image-slice" "border-image-source" "border-image-width" - "border-left" "border-left-color" "border-left-style" - "border-left-width" "border-radius" "border-right" - "border-right-color" "border-right-style" "border-right-width" - "border-style" "border-top" "border-top-color" - "border-top-left-radius" "border-top-right-radius" - "border-top-style" "border-top-width" "border-width" "box-shadow" + ("background" bg-layer final-bg-layer) + ("background-attachment" attachment) + ("background-clip" box) + ("background-color" color) + ("background-image" bg-image) + ("background-origin" box) + ("background-position" position) + ("background-repeat" repeat-style) + ("background-size" bg-size) + ("border" line-width line-style color) + ("border-bottom" line-width line-style color) + ("border-bottom-color" color) + ("border-bottom-left-radius" length percentage) + ("border-bottom-right-radius" length percentage) + ("border-bottom-style" line-style) + ("border-bottom-width" line-width) + ("border-color" color) + ("border-image" border-image-source border-image-slice + border-image-width border-image-outset border-image-repeat) + ("border-image-outset" length number) + ("border-image-repeat" "stretch" "repeat" "round" "space") + ("border-image-slice" number percentage "fill") + ("border-image-source" "none" image) + ("border-image-width" length percentage number "auto") + ("border-left" line-width line-style color) + ("border-left-color" color) + ("border-left-style" line-style) + ("border-left-width" line-width) + ("border-radius" length percentage) + ("border-right" line-width line-style color) + ("border-right-color" color) + ("border-right-style" line-style) + ("border-right-width" line-width) + ("border-style" line-style) + ("border-top" line-width line-style color) + ("border-top-color" color) + ("border-top-left-radius" length percentage) + ("border-top-right-radius" length percentage) + ("border-top-style" line-style) + ("border-top-width" line-width) + ("border-width" line-width) + ("box-shadow" "none" shadow) ;; CSS Basic User Interface Module Level 3 (CSS3 UI) ;; (http://www.w3.org/TR/css3-ui/#property-index) - "box-sizing" "caret-color" "cursor" "nav-down" "nav-left" - "nav-right" "nav-up" "outline" "outline-color" "outline-offset" - "outline-style" "outline-width" "resize" "text-overflow" + ("box-sizing" "content-box" "border-box") + ("caret-color" "auto" color) + ("cursor" uri x y "auto" "default" "none" "context-menu" "help" + "pointer" "progress" "wait" "cell" "crosshair" "text" + "vertical-text" "alias" "copy" "move" "no-drop" "not-allowed" + "grab" "grabbing" "e-resize" "n-resize" "ne-resize" "nw-resize" + "s-resize" "se-resize" "sw-resize" "w-resize" "ew-resize" + "ns-resize" "nesw-resize" "nwse-resize" "col-resize" "row-resize" + "all-scroll" "zoom-in" "zoom-out") + ("nav-down" "auto" id "current" "root" target-name) + ("nav-left" "auto" id "current" "root" target-name) + ("nav-right" "auto" id "current" "root" target-name) + ("nav-up" "auto" id "current" "root" target-name) + ("outline" outline-color outline-style outline-width) + ("outline-color" color "invert") + ("outline-offset" length) + ("outline-style" "auto" border-style) + ("outline-width" border-width) + ("resize" "none" "both" "horizontal" "vertical") + ("text-overflow" "clip" "ellipsis" string) ;; CSS Color Module Level 3 ;; (http://www.w3.org/TR/css3-color/#property) - "color" "opacity" + ("color" color) + ("opacity" alphavalue) ;; CSS Flexible Box Layout Module Level 1 ;; (http://www.w3.org/TR/css-flexbox-1/#property-index) - "align-content" "align-items" "align-self" "flex" "flex-basis" - "flex-direction" "flex-flow" "flex-grow" "flex-shrink" "flex-wrap" - "justify-content" "order" + ("align-content" "flex-start" "flex-end" "center" "space-between" + "space-around" "stretch") + ("align-items" "flex-start" "flex-end" "center" "baseline" + "stretch") + ("align-self" "auto" "flex-start" "flex-end" "center" "baseline" + "stretch") + ("flex" "none" flex-grow flex-shrink flex-basis) + ("flex-basis" "auto" "content" width) + ("flex-direction" "row" "row-reverse" "column" "column-reverse") + ("flex-flow" flex-direction flex-wrap) + ("flex-grow" number) + ("flex-shrink" number) + ("flex-wrap" "nowrap" "wrap" "wrap-reverse") + ("justify-content" "flex-start" "flex-end" "center" + "space-between" "space-around") + ("order" integer) ;; CSS Fonts Module Level 3 ;; (http://www.w3.org/TR/css3-fonts/#property-index) - "font" "font-family" "font-feature-settings" "font-kerning" - "font-language-override" "font-size" "font-size-adjust" - "font-stretch" "font-style" "font-synthesis" "font-variant" - "font-variant-alternates" "font-variant-caps" - "font-variant-east-asian" "font-variant-ligatures" - "font-variant-numeric" "font-variant-position" "font-weight" + ("font" font-style font-variant-css21 font-weight font-stretch + font-size line-height font-family "caption" "icon" "menu" + "message-box" "small-caption" "status-bar") + ("font-family" family-name generic-family) + ("font-feature-settings" "normal" feature-tag-value) + ("font-kerning" "auto" "normal" "none") + ("font-language-override" "normal" string) + ("font-size" absolute-size relative-size length percentage) + ("font-size-adjust" "none" number) + ("font-stretch" "normal" "ultra-condensed" "extra-condensed" + "condensed" "semi-condensed" "semi-expanded" "expanded" + "extra-expanded" "ultra-expanded") + ("font-style" "normal" "italic" "oblique") + ("font-synthesis" "none" "weight" "style") + ("font-variant" "normal" "none" common-lig-values + discretionary-lig-values historical-lig-values + contextual-alt-values "stylistic()" "historical-forms" + "styleset()" "character-variant()" "swash()" "ornaments()" + "annotation()" "small-caps" "all-small-caps" "petite-caps" + "all-petite-caps" "unicase" "titling-caps" numeric-figure-values + numeric-spacing-values numeric-fraction-values "ordinal" + "slashed-zero" east-asian-variant-values east-asian-width-values + "ruby") + ("font-variant-alternates" "normal" "stylistic()" + "historical-forms" "styleset()" "character-variant()" "swash()" + "ornaments()" "annotation()") + ("font-variant-caps" "normal" "small-caps" "all-small-caps" + "petite-caps" "all-petite-caps" "unicase" "titling-caps") + ("font-variant-east-asian" "normal" east-asian-variant-values + east-asian-width-values "ruby") + ("font-variant-ligatures" "normal" "none" common-lig-values + discretionary-lig-values historical-lig-values + contextual-alt-values) + ("font-variant-numeric" "normal" numeric-figure-values + numeric-spacing-values numeric-fraction-values "ordinal" + "slashed-zero") + ("font-variant-position" "normal" "sub" "super") + ("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" + "300" "400" "500" "600" "700" "800" "900") ;; CSS Fragmentation Module Level 3 ;; (https://www.w3.org/TR/css-break-3/#property-index) - "box-decoration-break" "break-after" "break-before" "break-inside" - "orphans" "widows" + ("box-decoration-break" "slice" "clone") + ("break-after" "auto" "avoid" "avoid-page" "page" "left" "right" + "recto" "verso" "avoid-column" "column" "avoid-region" "region") + ("break-before" "auto" "avoid" "avoid-page" "page" "left" "right" + "recto" "verso" "avoid-column" "column" "avoid-region" "region") + ("break-inside" "auto" "avoid" "avoid-page" "avoid-column" + "avoid-region") + ("orphans" integer) + ("widows" integer) ;; CSS Multi-column Layout Module ;; (https://www.w3.org/TR/css3-multicol/#property-index) ;; "break-after", "break-before", and "break-inside" are left out ;; below, because they're already included in CSS Fragmentation ;; Module Level 3. - "column-count" "column-fill" "column-gap" "column-rule" - "column-rule-color" "column-rule-style" "column-rule-width" - "column-span" "column-width" "columns" + ("column-count" integer "auto") + ("column-fill" "auto" "balance") + ("column-gap" length "normal") + ("column-rule" column-rule-width column-rule-style + column-rule-color "transparent") + ("column-rule-color" color) + ("column-rule-style" border-style) + ("column-rule-width" border-width) + ("column-span" "none" "all") + ("column-width" length "auto") + ("columns" column-width column-count) ;; CSS Overflow Module Level 3 ;; (http://www.w3.org/TR/css-overflow-3/#property-index) - "max-lines" "overflow" "overflow-x" "overflow-y" + ("max-lines" "none" integer) + ("overflow" "visible" "hidden" "scroll" "auto" "paged-x" "paged-y" + "paged-x-controls" "paged-y-controls" "fragments") + ("overflow-x" "visible" "hidden" "scroll" "auto" "paged-x" + "paged-y" "paged-x-controls" "paged-y-controls" "fragments") + ("overflow-y" "visible" "hidden" "scroll" "auto" "paged-x" + "paged-y" "paged-x-controls" "paged-y-controls" "fragments") ;; CSS Text Decoration Module Level 3 ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index) - "text-decoration" "text-decoration-color" "text-decoration-line" - "text-decoration-skip" "text-decoration-style" "text-emphasis" - "text-emphasis-color" "text-emphasis-position" "text-emphasis-style" - "text-shadow" "text-underline-position" + ("text-decoration" text-decoration-line text-decoration-style + text-decoration-color) + ("text-decoration-color" color) + ("text-decoration-line" "none" "underline" "overline" + "line-through" "blink") + ("text-decoration-skip" "none" "objects" "spaces" "ink" "edges" + "box-decoration") + ("text-decoration-style" "solid" "double" "dotted" "dashed" + "wavy") + ("text-emphasis" text-emphasis-style text-emphasis-color) + ("text-emphasis-color" color) + ("text-emphasis-position" "over" "under" "right" "left") + ("text-emphasis-style" "none" "filled" "open" "dot" "circle" + "double-circle" "triangle" "sesame" string) + ("text-shadow" "none" length color) + ("text-underline-position" "auto" "under" "left" "right") ;; CSS Text Module Level 3 ;; (http://www.w3.org/TR/css3-text/#property-index) - "hanging-punctuation" "hyphens" "letter-spacing" "line-break" - "overflow-wrap" "tab-size" "text-align" "text-align-last" - "text-indent" "text-justify" "text-transform" "white-space" - "word-break" "word-spacing" "word-wrap" + ("hanging-punctuation" "none" "first" "force-end" "allow-end" + "last") + ("hyphens" "none" "manual" "auto") + ("letter-spacing" "normal" length) + ("line-break" "auto" "loose" "normal" "strict") + ("overflow-wrap" "normal" "break-word") + ("tab-size" integer length) + ("text-align" "start" "end" "left" "right" "center" "justify" + "match-parent") + ("text-align-last" "auto" "start" "end" "left" "right" "center" + "justify") + ("text-indent" length percentage) + ("text-justify" "auto" "none" "inter-word" "distribute") + ("text-transform" "none" "capitalize" "uppercase" "lowercase" + "full-width") + ("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line") + ("word-break" "normal" "keep-all" "break-all") + ("word-spacing" "normal" length percentage) + ("word-wrap" "normal" "break-word") ;; CSS Transforms Module Level 1 ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index) - "backface-visibility" "perspective" "perspective-origin" - "transform" "transform-origin" "transform-style" + ("backface-visibility" "visible" "hidden") + ("perspective" "none" length) + ("perspective-origin" "left" "center" "right" "top" "bottom" + percentage length) + ("transform" "none" transform-list) + ("transform-origin" "left" "center" "right" "top" "bottom" + percentage length) + ("transform-style" "flat" "preserve-3d") ;; CSS Transitions ;; (http://www.w3.org/TR/css3-transitions/#property-index) - "transition" "transition-delay" "transition-duration" - "transition-property" "transition-timing-function" + ("transition" single-transition) + ("transition-delay" time) + ("transition-duration" time) + ("transition-property" "none" single-transition-property "all") + ("transition-timing-function" single-transition-timing-function) + + ;; CSS Will Change Module Level 1 + ;; (https://www.w3.org/TR/css-will-change-1/#property-index) + ("will-change" "auto" animateable-feature) ;; Filter Effects Module Level 1 ;; (http://www.w3.org/TR/filter-effects/#property-index) - "color-interpolation-filters" "filter" "flood-color" - "flood-opacity" "lighting-color") + ("color-interpolation-filters" "auto" "sRGB" "linearRGB") + ("filter" "none" filter-function-list) + ("flood-color" color) + ("flood-opacity" number percentage) + ("lighting-color" color)) + "Identifiers for properties and their possible values. +The CAR of each entry is the name of a property, while the CDR is +a list of possible values for that property. String values in +the CDRs represent literal values, while symbols represent one of +the value classes found in `css-value-class-alist'. If a symbol +is not found in `css-value-class-alist', it's interpreted as a +reference back to one of the properties in this list. Some +symbols, such as `number' or `identifier', don't produce any +further value candidates, since that list would be infinite.") + +(defconst css-property-ids + (mapcar #'car css-property-alist) "Identifiers for properties.") +(defconst css-value-class-alist + '((absolute-size + "xx-small" "x-small" "small" "medium" "large" "x-large" + "xx-large") + (alphavalue number) + (angle "calc()") + (animateable-feature "scroll-position" "contents" custom-ident) + (attachment "scroll" "fixed" "local") + (bg-image image "none") + (bg-layer bg-image position repeat-style attachment box) + (bg-size length percentage "auto" "cover" "contain") + (box "border-box" "padding-box" "content-box") + (color + "rgb()" "rgba()" "hsl()" "hsla()" named-color "transparent" + "currentColor") + (common-lig-values "common-ligatures" "no-common-ligatures") + (contextual-alt-values "contextual" "no-contextual") + (counter "counter()" "counters()") + (discretionary-lig-values + "discretionary-ligatures" "no-discretionary-ligatures") + (east-asian-variant-values + "jis78" "jis83" "jis90" "jis04" "simplified" "traditional") + (east-asian-width-values "full-width" "proportional-width") + (family-name "Courier" "Helvetica" "Times") + (feature-tag-value string integer "on" "off") + (filter-function + "blur()" "brightness()" "contrast()" "drop-shadow()" + "grayscale()" "hue-rotate()" "invert()" "opacity()" "sepia()" + "saturate()") + (filter-function-list filter-function uri) + (final-bg-layer + bg-image position repeat-style attachment box color) + (font-variant-css21 "normal" "small-caps") + (frequency "calc()") + (generic-family + "serif" "sans-serif" "cursive" "fantasy" "monospace") + (generic-voice "male" "female" "child") + (gradient + linear-gradient radial-gradient repeating-linear-gradient + repeating-radial-gradient) + (historical-lig-values + "historical-ligatures" "no-historical-ligatures") + (image uri image-list element-reference gradient) + (image-list "image()") + (integer "calc()") + (length "calc()" number) + (line-height "normal" number length percentage) + (line-style + "none" "hidden" "dotted" "dashed" "solid" "double" "groove" + "ridge" "inset" "outset") + (line-width length "thin" "medium" "thick") + (linear-gradient "linear-gradient()") + (margin-width "auto" length percentage) + (named-color + "aliceblue" "antiquewhite" "aqua" "aquamarine" "azure" "beige" + "bisque" "black" "blanchedalmond" "blue" "blueviolet" "brown" + "burlywood" "cadetblue" "chartreuse" "chocolate" "coral" + "cornflowerblue" "cornsilk" "crimson" "cyan" "darkblue" + "darkcyan" "darkgoldenrod" "darkgray" "darkgreen" "darkkhaki" + "darkmagenta" "darkolivegreen" "darkorange" "darkorchid" + "darkred" "darksalmon" "darkseagreen" "darkslateblue" + "darkslategray" "darkturquoise" "darkviolet" "deeppink" + "deepskyblue" "dimgray" "dodgerblue" "firebrick" "floralwhite" + "forestgreen" "fuchsia" "gainsboro" "ghostwhite" "gold" + "goldenrod" "gray" "green" "greenyellow" "honeydew" "hotpink" + "indianred" "indigo" "ivory" "khaki" "lavender" "lavenderblush" + "lawngreen" "lemonchiffon" "lightblue" "lightcoral" "lightcyan" + "lightgoldenrodyellow" "lightgray" "lightgreen" "lightpink" + "lightsalmon" "lightseagreen" "lightskyblue" "lightslategray" + "lightsteelblue" "lightyellow" "lime" "limegreen" "linen" + "magenta" "maroon" "mediumaquamarine" "mediumblue" "mediumorchid" + "mediumpurple" "mediumseagreen" "mediumslateblue" + "mediumspringgreen" "mediumturquoise" "mediumvioletred" + "midnightblue" "mintcream" "mistyrose" "moccasin" "navajowhite" + "navy" "oldlace" "olive" "olivedrab" "orange" "orangered" + "orchid" "palegoldenrod" "palegreen" "paleturquoise" + "palevioletred" "papayawhip" "peachpuff" "peru" "pink" "plum" + "powderblue" "purple" "rebeccapurple" "red" "rosybrown" + "royalblue" "saddlebrown" "salmon" "sandybrown" "seagreen" + "seashell" "sienna" "silver" "skyblue" "slateblue" "slategray" + "snow" "springgreen" "steelblue" "tan" "teal" "thistle" "tomato" + "turquoise" "violet" "wheat" "white" "whitesmoke" "yellow" + "yellowgreen") + (number "calc()") + (numeric-figure-values "lining-nums" "oldstyle-nums") + (numeric-fraction-values "diagonal-fractions" "stacked-fractions") + (numeric-spacing-values "proportional-nums" "tabular-nums") + (padding-width length percentage) + (position + "left" "center" "right" "top" "bottom" percentage length) + (radial-gradient "radial-gradient()") + (relative-size "larger" "smaller") + (repeat-style + "repeat-x" "repeat-y" "repeat" "space" "round" "no-repeat") + (repeating-linear-gradient "repeating-linear-gradient()") + (repeating-radial-gradient "repeating-radial-gradient()") + (shadow "inset" length color) + (shape "rect()") + (single-animation-direction + "normal" "reverse" "alternate" "alternate-reverse") + (single-animation-fill-mode "none" "forwards" "backwards" "both") + (single-animation-iteration-count "infinite" number) + (single-animation-name "none" identifier) + (single-animation-play-state "running" "paused") + (single-timing-function single-transition-timing-function) + (single-transition + "none" single-transition-property time + single-transition-timing-function) + (single-transition-property "all" identifier) + (single-transition-timing-function + "ease" "linear" "ease-in" "ease-out" "ease-in-out" "step-start" + "step-end" "steps()" "cubic-bezier()") + (specific-voice identifier) + (target-name string) + (time "calc()") + (transform-list + "matrix()" "translate()" "translateX()" "translateY()" "scale()" + "scaleX()" "scaleY()" "rotate()" "skew()" "skewX()" "skewY()" + "matrix3d()" "translate3d()" "translateZ()" "scale3d()" + "scaleZ()" "rotate3d()" "rotateX()" "rotateY()" "rotateZ()" + "perspective()") + (uri "url()") + (width length percentage "auto") + (x number) + (y number)) + "Property value classes and their values. +The format is similar to that of `css-property-alist', except +that the CARs aren't actual CSS properties, but rather a name for +a class of values, and that symbols in the CDRs always refer to +other entries in this list, not to properties. + +The following classes have been left out above because they +cannot be completed sensibly: `custom-ident', +`element-reference', `id', `identifier', `percentage', and +`string'.") + (defcustom css-electric-keys '(?\} ?\;) ;; '() "Self inserting keys which should trigger re-indentation." :version "22.2" @@ -257,9 +655,7 @@ "Face to use for vendor-specific properties.") (defun css--font-lock-keywords (&optional sassy) - `((,(concat "!\\s-*" - (regexp-opt (append (if sassy scss-bang-ids) - css-bang-ids))) + `((,(concat "!\\s-*" (regexp-opt css--bang-ids)) (0 font-lock-builtin-face)) ;; Atrules keywords. IDs not in css-at-ids are valid (ignored). ;; In fact the regexp should probably be @@ -335,8 +731,6 @@ :type 'integer :safe 'integerp) -(require 'smie) - (defconst css-smie-grammar (smie-prec2->grammar (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) @@ -391,6 +785,14 @@ (when (memq (char-before) '(?\{ ?\;)) (list start pos css-property-ids)))))) +(defun css--complete-bang-rule () + "Complete bang-rule at point." + (save-excursion + (let ((pos (point))) + (skip-chars-backward "-[:alnum:]") + (when (eq (char-before) ?\!) + (list (point) pos css--bang-ids))))) + (defun css--complete-pseudo-element-or-class () "Complete pseudo-element or pseudo-class at point." (save-excursion @@ -408,15 +810,121 @@ (let ((pos (point))) (skip-chars-backward "-[:alnum:]") (when (eq (char-before) ?\@) - (list (point) pos css-at-ids))))) + (list (point) pos css--at-ids))))) + +(defvar css--property-value-cache + (make-hash-table :test 'equal :size (length css-property-alist)) + "Cache of previously completed property values.") + +(defun css--value-class-lookup (value-class) + "Return a list of value completion candidates for VALUE-CLASS. +Completion candidates are looked up in `css-value-class-alist' by +the symbol VALUE-CLASS." + (seq-uniq + (seq-mapcat + (lambda (value) + (if (stringp value) + (list value) + (css--value-class-lookup value))) + (cdr (assq value-class css-value-class-alist))))) + +(defun css--property-values (property) + "Return a list of value completion candidates for PROPERTY. +Completion candidates are looked up in `css-property-alist' by +the string PROPERTY." + (or (gethash property css--property-value-cache) + (let ((values + (seq-uniq + (seq-mapcat + (lambda (value) + (if (stringp value) + (list value) + (or (css--value-class-lookup value) + (css--property-values (symbol-name value))))) + (cdr (assoc property css-property-alist)))))) + (puthash property values css--property-value-cache)))) + +(defun css--complete-property-value () + "Complete property value at point." + (let ((property + (save-excursion + (re-search-backward ":[^/]" (line-beginning-position) t) + (let ((property-end (point))) + (skip-chars-backward "-[:alnum:]") + (let ((property (buffer-substring (point) property-end))) + (car (member property css-property-ids))))))) + (when property + (let ((end (point))) + (save-excursion + (skip-chars-backward "[:graph:]") + (list (point) end + (append '("inherit" "initial" "unset") + (css--property-values property)))))))) + +(defvar css--html-tags (mapcar #'car html-tag-alist) + "List of HTML tags. +Used to provide completion of HTML tags in selectors.") + +(defvar css--nested-selectors-allowed nil + "Non-nil if nested selectors are allowed in the current mode.") +(make-variable-buffer-local 'css--nested-selectors-allowed) + +(defvar css-class-list-function #'ignore + "Called to provide completions of class names. +This can be bound by buffers that are able to suggest class name +completions, such as HTML mode buffers.") + +(defvar css-id-list-function #'ignore + "Called to provide completions of IDs. +This can be bound by buffers that are able to suggest ID +completions, such as HTML mode buffers.") + +(defun css--foreign-completions (extractor) + "Return a list of completions provided by other buffers. +EXTRACTOR should be the name of a function that may be defined in +one or more buffers. In each of the buffers where EXTRACTOR is +defined, EXTRACTOR is called and the results are accumulated into +a list of completions." + (delete-dups + (seq-mapcat + (lambda (buf) + (with-current-buffer buf + (funcall (symbol-value extractor)))) + (buffer-list)))) + +(defun css--complete-selector () + "Complete part of a CSS selector at point." + (when (or (= (nth 0 (syntax-ppss)) 0) css--nested-selectors-allowed) + (let ((end (point))) + (save-excursion + (skip-chars-backward "-[:alnum:]") + (let ((start-char (char-before))) + (list + (point) end + (completion-table-dynamic + (lambda (_) + (cond + ((eq start-char ?.) + (css--foreign-completions 'css-class-list-function)) + ((eq start-char ?#) + (css--foreign-completions 'css-id-list-function)) + (t css--html-tags)))))))))) (defun css-completion-at-point () "Complete current symbol at point. -Currently supports completion of CSS properties, pseudo-elements, -pseudo-classes, and at-rules." - (or (css--complete-property) +Currently supports completion of CSS properties, property values, +pseudo-elements, pseudo-classes, at-rules, and bang-rules." + (or (css--complete-bang-rule) + (css--complete-property-value) (css--complete-pseudo-element-or-class) - (css--complete-at-rule))) + (css--complete-at-rule) + (seq-let (prop-beg prop-end prop-table) (css--complete-property) + (seq-let (sel-beg sel-end sel-table) (css--complete-selector) + (when (or prop-table sel-table) + `(,@(if prop-table + (list prop-beg prop-end) + (list sel-beg sel-end)) + ,(completion-table-merge prop-table sel-table))))))) ;;;###autoload (define-derived-mode css-mode prog-mode "CSS" @@ -551,7 +1059,7 @@ pseudo-classes, and at-rules." (modify-syntax-entry ?$ "'" st) st)) -(defvar scss-font-lock-keywords +(defun scss-font-lock-keywords () (append `((,(concat "$" css-ident-re) (0 font-lock-variable-name-face))) (css--font-lock-keywords 'sassy) `((,(concat "@mixin[ \t]+\\(" css-ident-re "\\)[ \t]*(") @@ -572,7 +1080,11 @@ pseudo-classes, and at-rules." (setq-local comment-continue " *") (setq-local comment-start-skip "/[*/]+[ \t]*") (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)") - (setq-local font-lock-defaults '(scss-font-lock-keywords nil t))) + (setq-local css--at-ids (append css-at-ids scss-at-ids)) + (setq-local css--bang-ids (append css-bang-ids scss-bang-ids)) + (setq-local css--nested-selectors-allowed t) + (setq-local font-lock-defaults + (list (scss-font-lock-keywords) nil t))) (provide 'css-mode) ;;; css-mode.el ends here diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 124be27f4f3..5562a75340a 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -46,7 +46,7 @@ (defgroup enriched nil "Read and save files in text/enriched format." - :group 'wp) + :group 'text) (defcustom enriched-verbose t "If non-nil, give status messages when reading and writing files." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 100e2a24367..173d1c9d196 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -804,65 +804,75 @@ region, instead of just filling the current paragraph." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'full) t))) - (or - ;; 1. Fill the region if it is active when called interactively. - (and region transient-mark-mode mark-active - (not (eq (region-beginning) (region-end))) - (or (fill-region (region-beginning) (region-end) justify) t)) - ;; 2. Try fill-paragraph-function. - (and (not (eq fill-paragraph-function t)) - (or fill-paragraph-function - (and (minibufferp (current-buffer)) - (= 1 (point-min)))) - (let ((function (or fill-paragraph-function - ;; In the minibuffer, don't count the width - ;; of the prompt. - 'fill-minibuffer-function)) - ;; If fill-paragraph-function is set, it probably takes care - ;; of comments and stuff. If not, it will have to set - ;; fill-paragraph-handle-comment back to t explicitly or - ;; return nil. - (fill-paragraph-handle-comment nil) - (fill-paragraph-function t)) - (funcall function justify))) - ;; 3. Try our syntax-aware filling code. - (and fill-paragraph-handle-comment - ;; Our code only handles \n-terminated comments right now. - comment-start (equal comment-end "") - (let ((fill-paragraph-handle-comment nil)) - (fill-comment-paragraph justify))) - ;; 4. If it all fails, default to the good ol' text paragraph filling. - (let ((before (point)) - (paragraph-start paragraph-start) - ;; Fill prefix used for filling the paragraph. - fill-pfx) - ;; Try to prevent code sections and comment sections from being - ;; filled together. - (when (and fill-paragraph-handle-comment comment-start-skip) - (setq paragraph-start - (concat paragraph-start "\\|[ \t]*\\(?:" - comment-start-skip "\\)"))) - (save-excursion - ;; To make sure the return value of forward-paragraph is meaningful, - ;; we have to start from the beginning of line, otherwise skipping - ;; past the last few chars of a paragraph-separator would count as - ;; a paragraph (and not skipping any chars at EOB would not count - ;; as a paragraph even if it is). - (move-to-left-margin) - (if (not (zerop (fill-forward-paragraph 1))) - ;; There's no paragraph at or after point: give up. - (setq fill-pfx "") - (let ((end (point)) - (beg (progn (fill-forward-paragraph -1) (point)))) - (goto-char before) - (setq fill-pfx - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this - ;; paragraph may still contain hard newlines. See - ;; fill-region. - (fill-region beg end justify) - (fill-region-as-paragraph beg end justify)))))) - fill-pfx))) + (let ((hash (and (not (buffer-modified-p)) + (buffer-hash)))) + (prog1 + (or + ;; 1. Fill the region if it is active when called interactively. + (and region transient-mark-mode mark-active + (not (eq (region-beginning) (region-end))) + (or (fill-region (region-beginning) (region-end) justify) t)) + ;; 2. Try fill-paragraph-function. + (and (not (eq fill-paragraph-function t)) + (or fill-paragraph-function + (and (minibufferp (current-buffer)) + (= 1 (point-min)))) + (let ((function (or fill-paragraph-function + ;; In the minibuffer, don't count + ;; the width of the prompt. + 'fill-minibuffer-function)) + ;; If fill-paragraph-function is set, it probably + ;; takes care of comments and stuff. If not, it + ;; will have to set fill-paragraph-handle-comment + ;; back to t explicitly or return nil. + (fill-paragraph-handle-comment nil) + (fill-paragraph-function t)) + (funcall function justify))) + ;; 3. Try our syntax-aware filling code. + (and fill-paragraph-handle-comment + ;; Our code only handles \n-terminated comments right now. + comment-start (equal comment-end "") + (let ((fill-paragraph-handle-comment nil)) + (fill-comment-paragraph justify))) + ;; 4. If it all fails, default to the good ol' text paragraph filling. + (let ((before (point)) + (paragraph-start paragraph-start) + ;; Fill prefix used for filling the paragraph. + fill-pfx) + ;; Try to prevent code sections and comment sections from being + ;; filled together. + (when (and fill-paragraph-handle-comment comment-start-skip) + (setq paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)"))) + (save-excursion + ;; To make sure the return value of forward-paragraph is + ;; meaningful, we have to start from the beginning of + ;; line, otherwise skipping past the last few chars of a + ;; paragraph-separator would count as a paragraph (and + ;; not skipping any chars at EOB would not count as a + ;; paragraph even if it is). + (move-to-left-margin) + (if (not (zerop (fill-forward-paragraph 1))) + ;; There's no paragraph at or after point: give up. + (setq fill-pfx "") + (let ((end (point)) + (beg (progn (fill-forward-paragraph -1) (point)))) + (goto-char before) + (setq fill-pfx + (if use-hard-newlines + ;; Can't use fill-region-as-paragraph, since this + ;; paragraph may still contain hard newlines. See + ;; fill-region. + (fill-region beg end justify) + (fill-region-as-paragraph beg end justify)))))) + fill-pfx)) + ;; If we didn't change anything in the buffer (and the buffer + ;; was previously unmodified), then flip the modification status + ;; back to "unchanged". + (when (and hash + (equal hash (buffer-hash))) + (set-buffer-modified-p nil))))) (declare-function comment-search-forward "newcomment" (limit &optional noerror)) (declare-function comment-string-strip "newcomment" (str beforep afterp)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 5db0d987a0f..29aa2312521 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -102,7 +102,7 @@ This only happens if `flyspell-sort-corrections' is non-nil. The function takes three parameters -- the two correction candidates to be sorted, and the third parameter is the word that's being corrected." - :version "25.2" + :version "26.1" :type 'function :group 'flyspell) @@ -368,7 +368,7 @@ property of the major mode name.") (defun texinfo-mode-flyspell-verify () "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode." (save-excursion - (forward-word -1) + (forward-word-strictly -1) (not (looking-at "@")))) ;;*--- tex mode --------------------------------------------------------*/ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index db03a3244a4..5d5d422937b 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,4 +1,4 @@ -;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 +;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*- ;; Copyright (C) 1994-1995, 1997-2016 Free Software Foundation, Inc. @@ -46,9 +46,9 @@ ;; your own dictionaries. ;; Depending on the mail system you use, you may want to include these: -;; (add-hook 'news-inews-hook 'ispell-message) -;; (add-hook 'mail-send-hook 'ispell-message) -;; (add-hook 'mh-before-send-letter-hook 'ispell-message) +;; (add-hook 'news-inews-hook #'ispell-message) +;; (add-hook 'mail-send-hook #'ispell-message) +;; (add-hook 'mh-before-send-letter-hook #'ispell-message) ;; Ispell has a TeX parser and a nroff parser (the default). ;; The parsing is controlled by the variable ispell-parser. Currently @@ -196,54 +196,46 @@ ;; Fixed bug in returning to nroff mode from tex mode. ;;; Compatibility code for XEmacs and (not too) older emacsen: - -(eval-and-compile ;; Protect against declare-function undefined in XEmacs - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(declare-function ispell-check-minver "ispell" (v1 v2)) -(declare-function ispell-looking-back "ispell" - (regexp &optional limit &rest ignored)) - -(if (fboundp 'version<=) - (defalias 'ispell-check-minver 'version<=) - (defun ispell-check-minver (minver version) - "Check if string VERSION is at least string MINVER. +(defalias 'ispell-check-minver + (if (fboundp 'version<=) 'version<= + (lambda (minver version) + "Check if string VERSION is at least string MINVER. Both must be in [0-9]+.[0-9]+... format. This is a fallback compatibility function in case `version<=' is not available." - (let ((pending t) - (return t) - start-ver start-mver) - ;; Loop until an absolute greater or smaller condition is reached - ;; or until no elements are left in any of version and minver. In - ;; this case version is exactly the minimal, so return OK. - (while pending - (let (ver mver) - (if (string-match "[0-9]+" version start-ver) - (setq start-ver (match-end 0) - ver (string-to-number (match-string 0 version)))) - (if (string-match "[0-9]+" minver start-mver) - (setq start-mver (match-end 0) - mver (string-to-number (match-string 0 minver)))) - - (if (or ver mver) - (progn - (or ver (setq ver 0)) - (or mver (setq mver 0)) - ;; If none of below conditions match, this element is the - ;; same. Go checking next element. - (if (> ver mver) - (setq pending nil) - (if (< ver mver) - (setq pending nil - return nil)))) - (setq pending nil)))) - return))) + (let ((pending t) + (return t) + start-ver start-mver) + ;; Loop until an absolute greater or smaller condition is reached + ;; or until no elements are left in any of version and minver. In + ;; this case version is exactly the minimal, so return OK. + (while pending + (let (ver mver) + (if (string-match "[0-9]+" version start-ver) + (setq start-ver (match-end 0) + ver (string-to-number (match-string 0 version)))) + (if (string-match "[0-9]+" minver start-mver) + (setq start-mver (match-end 0) + mver (string-to-number (match-string 0 minver)))) + + (if (or ver mver) + (progn + (or ver (setq ver 0)) + (or mver (setq mver 0)) + ;; If none of below conditions match, this element is the + ;; same. Go checking next element. + (if (> ver mver) + (setq pending nil) + (if (< ver mver) + (setq pending nil + return nil)))) + (setq pending nil)))) + return)))) ;; XEmacs does not have looking-back -(if (fboundp 'looking-back) - (defalias 'ispell-looking-back 'looking-back) - (defun ispell-looking-back (regexp &optional limit &rest ignored) - "Return non-nil if text before point matches regular expression REGEXP. +(defalias 'ispell-looking-back + (if (fboundp 'looking-back) 'looking-back + (lambda (regexp &optional limit &rest ignored) + "Return non-nil if text before point matches regular expression REGEXP. Like `looking-at' except matches before point, and is slower. LIMIT if non-nil speeds up the search by specifying a minimum starting position, to avoid checking matches that would start @@ -251,8 +243,8 @@ before LIMIT. This is a stripped down compatibility function for use when full featured `looking-back' function is missing." - (save-excursion - (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))) + (save-excursion + (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))) ;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode. (defmacro ispell-with-no-warnings (&rest body) @@ -260,6 +252,8 @@ full featured `looking-back' function is missing." ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar mail-yank-prefix) (defgroup ispell nil @@ -402,19 +396,15 @@ Always stores Fcc copy of message when nil." (defcustom ispell-grep-command - ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they - ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options - ;; below). - (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep") + "grep" "Name of the grep command for search processes." :type 'string :group 'ispell) (defcustom ispell-grep-options - (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i") + "-Ei" "String of options to use when running the program in `ispell-grep-command'. -Should probably be \"-i\" or \"-e\". -Some machines (like the NeXT) don't support \"-i\"." +Should probably be \"-Ei\"." :type 'string :group 'ispell) @@ -848,7 +838,12 @@ Otherwise returns the library directory name, if that is defined." (let ((default-directory (or (and (boundp 'temporary-file-directory) temporary-file-directory) default-directory)) - result status ispell-program-version) + (get-config-var + (lambda (var) + (when (re-search-forward + (concat var " = \\\"\\(.+?\\)\\\"") nil t) + (match-string 1)))) + result libvar status ispell-program-version) (with-temp-buffer (setq status (ispell-call-process @@ -870,9 +865,13 @@ Otherwise returns the library directory name, if that is defined." ", " ispell-version)) (message "%s" result)) - ;; return library directory. - (if (re-search-forward "LIBDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t) - (setq result (match-string 1)))) + ;; return LIBDIR or LIBRARYVAR (overrides LIBDIR) env. + (progn + (setq result (funcall get-config-var "LIBDIR") + libvar (funcall get-config-var "LIBRARYVAR")) + (when libvar + (setq libvar (getenv libvar)) + (unless (member libvar '(nil "")) (setq result libvar))))) (goto-char (point-min)) (if (not (memq status '(0 nil))) (error "%s exited with %s %s" ispell-program-name @@ -942,6 +941,8 @@ Otherwise returns the library directory name, if that is defined." (setq default-directory (expand-file-name "~/"))) (apply 'call-process-region args))) +(defvar ispell-debug-buffer) + (defun ispell-create-debug-buffer (&optional append) "Create an ispell debug buffer for debugging output. If APPEND is non-nil, append the info to previous buffer if exists, @@ -1000,7 +1001,7 @@ and added as a submenu of the \"Edit\" menu.") (defvar ispell-async-processp (and (fboundp 'delete-process) (fboundp 'process-send-string) (fboundp 'accept-process-output) - ;;(fboundp 'start-process) + ;;(fboundp 'make-process) ;;(fboundp 'set-process-filter) ;;(fboundp 'process-kill-without-query) ) @@ -1182,15 +1183,15 @@ all uninitialized dicts using that affix file." (if (cadr (assoc tmp-dict ispell-dictionary-alist)) (ispell-print-if-debug "ispell-hfde: %s already expanded; skipping.\n" tmp-dict) - (add-to-list 'use-for-dicts tmp-dict)))))) + (cl-pushnew tmp-dict use-for-dicts :test #'equal)))))) (ispell-print-if-debug "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts) ;; The final loop. (dolist (entry ispell-dictionary-alist) - (if (member (car entry) use-for-dicts) - (add-to-list 'newlist - (append (list (car entry)) dict-args-cdr)) - (add-to-list 'newlist entry))) + (cl-pushnew (if (member (car entry) use-for-dicts) + (cons (car entry) dict-args-cdr) + entry) + newlist :test #'equal)) (setq ispell-dictionary-alist newlist)))) (defun ispell-parse-hunspell-affix-file (dict-key) @@ -1235,7 +1236,7 @@ did." (chars-list (append otherchars-string nil))) (setq chars-list (delq ?\ chars-list)) (dolist (ch chars-list) - (add-to-list 'otherchars-list ch))))) + (cl-pushnew ch otherchars-list :test #'equal))))) ;; Cons the argument for the -d switch. (setq dict-arg (concat dict-arg (if (> (length dict-arg) 0) ",") @@ -1246,7 +1247,7 @@ did." "[[:alpha:]]" "[^[:alpha:]]" (if otherchars-list - (regexp-opt (mapcar 'char-to-string otherchars-list)) + (regexp-opt (mapcar #'char-to-string otherchars-list)) "") t ; many-otherchars-p: We can't tell, set to t. (list "-d" dict-arg) @@ -1268,7 +1269,7 @@ in the list must have an affix file where Hunspell affix files are kept." (or (assoc first-dict ispell-local-dictionary-alist) (assoc first-dict ispell-dictionary-alist) (error "Unknown dictionary: %s" first-dict))) - (add-to-list 'ispell-dictionary-alist (list dict '())) + (cl-pushnew (list dict '()) ispell-dictionary-alist :test #'equal) (ispell-hunspell-fill-dictionary-entry dict)) (defun ispell-find-hunspell-dictionaries () @@ -1308,8 +1309,8 @@ entries if a specific dictionary was found." (ispell-print-if-debug "++ ispell-fhd: dict-entry:%s name:%s basename:%s affix-file:%s\n" dict full-name basename affix-file) - (add-to-list 'ispell-hunspell-dict-paths-alist - (list basename affix-file))) + (cl-pushnew (list basename affix-file) + ispell-hunspell-dict-paths-alist :test #'equal)) (ispell-print-if-debug "-- ispell-fhd: Skipping entry: %s\n" dict))))) ;; Remove entry from aliases alist if explicit dict was found. @@ -1319,7 +1320,7 @@ entries if a specific dictionary was found." (ispell-print-if-debug "-- ispell-fhd: Excluding %s alias. Standalone dict found.\n" (car dict)) - (add-to-list 'newlist dict))) + (cl-pushnew dict newlist :test #'equal))) (setq ispell-dicts-name2locale-equivs-alist newlist)) ;; Add known hunspell aliases (dolist (dict-equiv ispell-dicts-name2locale-equivs-alist) @@ -1337,22 +1338,20 @@ entries if a specific dictionary was found." ispell-hunspell-dict-paths-alist)))) (ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n" dict-equiv-key affix-file) - (add-to-list - 'ispell-hunspell-dict-paths-alist - (list dict-equiv-key affix-file)))))) + (cl-pushnew (list dict-equiv-key affix-file) + ispell-hunspell-dict-paths-alist :test #'equal))))) ;; Parse and set values for default dictionary. (setq hunspell-default-dict (car hunspell-default-dict)) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. (setq ispell-hunspell-dictionary-alist - (list (append (list nil) (cdr hunspell-default-dict-entry)))) - (dolist (dict (mapcar 'car ispell-hunspell-dict-paths-alist)) - (if (string= dict hunspell-default-dict) - (add-to-list 'ispell-hunspell-dictionary-alist - hunspell-default-dict-entry) - (add-to-list 'ispell-hunspell-dictionary-alist - (list dict)))))) + (list (cons nil (cdr hunspell-default-dict-entry)))) + (dolist (dict (mapcar #'car ispell-hunspell-dict-paths-alist)) + (cl-pushnew (if (string= dict hunspell-default-dict) + hunspell-default-dict-entry + (list dict)) + ispell-hunspell-dictionary-alist :test #'equal)))) ;; Set params according to the selected spellchecker @@ -1443,17 +1442,17 @@ aspell is used along with Emacs).") (setq skip-dict t))) (unless skip-dict - (add-to-list 'tmp-dicts-alist - (list - dict-name ; dict name - (nth 1 adict) ; casechars - (nth 2 adict) ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - ispell-args ; ispell-args - (nth 6 adict) ; extended-character-mode - (nth 7 adict) ; dict encoding - )))) + (cl-pushnew (list + dict-name ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + ispell-args ; ispell-args + (nth 6 adict) ; extended-character-mode + (nth 7 adict) ; dict encoding + ) + tmp-dicts-alist :test #'equal))) (setq ispell-dictionary-base-alist tmp-dicts-alist)))) (run-hooks 'ispell-initialize-spellchecker-hook) @@ -1463,7 +1462,7 @@ aspell is used along with Emacs).") ispell-base-dicts-override-alist ispell-dictionary-base-alist)) (unless (assoc (car dict) all-dicts-alist) - (add-to-list 'all-dicts-alist dict))) + (push dict all-dicts-alist))) (setq ispell-dictionary-alist all-dicts-alist)) ;; If Emacs flavor supports [:alpha:] use it for global dicts. If @@ -1473,20 +1472,20 @@ aspell is used along with Emacs).") (if ispell-emacs-alpha-regexp (let (tmp-dicts-alist) (dolist (adict ispell-dictionary-alist) - (if (cadr adict) ;; Do not touch hunspell uninitialized entries - (add-to-list 'tmp-dicts-alist - (list - (nth 0 adict) ; dict name - "[[:alpha:]]" ; casechars - "[^[:alpha:]]" ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - (nth 5 adict) ; ispell-args - (nth 6 adict) ; extended-character-mode - (if ispell-encoding8-command - 'utf-8 - (nth 7 adict)))) - (add-to-list 'tmp-dicts-alist adict))) + (cl-pushnew (if (cadr adict) ;; Do not touch hunspell uninitialized entries + (list + (nth 0 adict) ; dict name + "[[:alpha:]]" ; casechars + "[^[:alpha:]]" ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + (nth 5 adict) ; ispell-args + (nth 6 adict) ; extended-character-mode + (if ispell-encoding8-command + 'utf-8 + (nth 7 adict))) + adict) + tmp-dicts-alist :test #'equal)) (setq ispell-dictionary-alist tmp-dicts-alist))))) (defun ispell-valid-dictionary-list () @@ -1500,23 +1499,29 @@ The variable `ispell-library-directory' defines their location." (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist)) (dict-list (cons "default" nil)) - name dict-bname) + (dict-locate + (lambda (dict &optional dir) + (locate-file (file-name-nondirectory dict) + `(,(or dir (file-name-directory dict))) + (unless (file-name-extension dict) '(".hash" ".has"))))) + name dict-explt dict-bname) (dolist (dict dicts) (setq name (car dict) - dict-bname (or (car (cdr (member "-d" (nth 5 dict)))) - name)) - ;; Include if the dictionary is in the library, or dir not defined. - (if (and - name - ;; For Aspell, we already know which dictionaries exist. - (or ispell-really-aspell - ;; Include all dictionaries if lib directory not known. - ;; Same for Hunspell, where ispell-library-directory is nil. - (not ispell-library-directory) - (file-exists-p (concat ispell-library-directory - "/" dict-bname ".hash")) - (file-exists-p (concat ispell-library-directory - "/" dict-bname ".has")))) + ;; Explicitly (via ispell-args) specified dictionary. + dict-explt (car (cdr (member "-d" (nth 5 dict)))) + dict-bname (or dict-explt name)) + (if (and name + (or + ;; Include all for Aspell (we already know existing dicts) + ispell-really-aspell + ;; Include all if `ispell-library-directory' is nil (Hunspell) + (not ispell-library-directory) + ;; If explicit (-d with an absolute path) and existing dict. + (and dict-explt + (file-name-absolute-p dict-explt) + (funcall dict-locate dict-explt)) + ;; If dict located in `ispell-library-directory'. + (funcall dict-locate dict-bname ispell-library-directory))) (push name dict-list))) dict-list)) @@ -1875,6 +1880,7 @@ Valid forms include: ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ;;("\\\\author" ispell-tex-arg-end) + ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) @@ -2427,7 +2433,8 @@ Global `ispell-quit' set to start location to continue spell session." nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) - (add-to-list 'ispell-buffer-session-localwords word) + (cl-pushnew word ispell-buffer-session-localwords + :test #'equal) (and (fboundp 'flyspell-unhighlight-at) (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict @@ -2682,8 +2689,8 @@ SPC: Accept word this time. (defun ispell-lookup-words (word &optional lookup-dict) "Look up WORD in optional word-list dictionary LOOKUP-DICT. A `*' serves as a wild card. If no wild cards, `look' is used if it exists. -Otherwise the variable `ispell-grep-command' contains the command used to -search for the words (usually egrep). +Otherwise the variable `ispell-grep-command' contains the command +\(usually \"grep\") used to search for the words. Optional second argument contains the dictionary to use; the default is `ispell-alternate-dictionary', overridden by `ispell-complete-word-dict' @@ -2760,7 +2767,7 @@ if defined." ;; This is the case when a process dies or fails. The default behavior ;; in this case treats the next input received as fresh input. -(defun ispell-filter (process output) +(defun ispell-filter (_process output) "Output filter function for ispell, grep, and look." (let ((start 0) (continue t) @@ -3040,14 +3047,13 @@ Keeps argument list for future Ispell invocations for no async support." (ispell-send-string "\032\n") ; so Ispell prints version and exits t))) - (defun ispell-init-process () "Check status of Ispell process and start if necessary." (let* (;; Basename of dictionary used by the spell-checker (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) ispell-current-dictionary)) ;; The directory where process was started. - (current-ispell-directory default-directory) + (current-ispell-directory default-directory) ;FIXME: Unused? ;; The default directory for the process. ;; Use "~/" as default-directory unless using Ispell with per-dir ;; personal dictionaries and not in a minibuffer under XEmacs @@ -3150,7 +3156,7 @@ Keeps argument list for future Ispell invocations for no async support." ;; Otherwise we get cool errors like "Can't open ". (sleep-for 1) (ispell-accept-output 3) - (error "%s" (mapconcat 'identity ispell-filter "\n")))) + (error "%s" (mapconcat #'identity ispell-filter "\n")))) (setq ispell-filter nil) ; Discard version ID line (let ((extended-char-mode (ispell-get-extended-character-mode))) (if extended-char-mode ; ~ extended character mode @@ -3206,7 +3212,7 @@ By just answering RET you can find out what the current dictionary is." (list (completing-read "Use new dictionary (RET for current, SPC to complete): " (and (fboundp 'ispell-valid-dictionary-list) - (mapcar 'list (ispell-valid-dictionary-list))) + (mapcar #'list (ispell-valid-dictionary-list))) nil t) current-prefix-arg)) (ispell-set-spellchecker-params) ; Initialize variables and dicts alists @@ -3412,7 +3418,7 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys. Must be called after `ispell-buffer-local-parsing' due to dependence on mode." (mapconcat - 'identity + #'identity (delq nil (list ;; messages @@ -3869,7 +3875,7 @@ Standard ispell choices are then available." (setq case-fold-search nil) ; Try and respect case of word. (cond ((string-equal (upcase word) word) - (setq possibilities (mapcar 'upcase possibilities))) + (setq possibilities (mapcar #'upcase possibilities))) ((eq (upcase (aref word 0)) (aref word 0)) (setq possibilities (mapcar (function (lambda (pos) @@ -4103,10 +4109,10 @@ The `X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your init file: - (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5 - (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4 - (add-hook \\='mail-send-hook \\='ispell-message) - (add-hook \\='mh-before-send-letter-hook \\='ispell-message) + (add-hook \\='message-send-hook #\\='ispell-message) ;; GNUS 5 + (add-hook \\='news-inews-hook #\\='ispell-message) ;; GNUS 4 + (add-hook \\='mail-send-hook #\\='ispell-message) + (add-hook \\='mh-before-send-letter-hook #\\='ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: @@ -4428,6 +4434,7 @@ Both should not be used to define a buffer-local dictionary." (insert comment-end))))) (insert (concat " " word)))))))) +;;FIXME: Use `user-error' instead! (add-to-list 'debug-ignored-errors "^No word found to check!$") (provide 'ispell) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index b064f6d2b31..35996bc2509 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -37,7 +37,7 @@ (defgroup nroff nil "Nroff mode." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) - :group 'wp + :group 'text :prefix "nroff-") diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 4769af5a1d1..f67e85e8432 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -694,20 +694,14 @@ Used by `pages-directory' function." (terpri)) (end-of-line 1))) -(defun pages-directory-mode () +(define-derived-mode pages-directory-mode special-mode "Pages-Directory" "Mode for handling the pages-directory buffer. Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go to the same line in the pages buffer." - - (kill-all-local-variables) - (use-local-map pages-directory-mode-map) - (setq major-mode 'pages-directory-mode) - (setq mode-name "Pages-Directory") (make-local-variable 'pages-buffer) (make-local-variable 'pages-pos-list) - (make-local-variable 'pages-directory-buffer-narrowing-p) - (run-mode-hooks 'pages-directory-mode-hook)) + (make-local-variable 'pages-directory-buffer-narrowing-p)) (defun pages-directory-goto () "Go to the corresponding line in the pages buffer." diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 17fda677754..22c73591b91 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -48,12 +48,13 @@ A page boundary is any line whose beginning matches the regexp (and (save-excursion (re-search-backward page-delimiter nil t)) (= (match-end 0) (point)) (goto-char (match-beginning 0))) - (forward-char -1) - (if (re-search-backward page-delimiter nil t) - ;; We found one--move to the end of it. - (goto-char (match-end 0)) - ;; We found nothing--go to beg of buffer. - (goto-char (point-min))) + (unless (bobp) + (forward-char -1) + (if (re-search-backward page-delimiter nil t) + ;; We found one--move to the end of it. + (goto-char (match-end 0)) + ;; We found nothing--go to beg of buffer. + (goto-char (point-min)))) (setq count (1+ count)))) (defun backward-page (&optional count) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 4aee2734158..01d67b5c1dd 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -33,7 +33,7 @@ (defgroup picture nil "Editing text-based pictures (\"ASCII art\")." :prefix "picture-" - :group 'wp) + :group 'text) (defcustom picture-rectangle-ctl ?+ "Character `picture-draw-rectangle' uses for top left corners." @@ -272,7 +272,11 @@ Use \"\\[command-apropos] picture-movement\" to see commands which control motio (or (eolp) (let ((pos (point))) (move-to-column col t) - (delete-region pos (point))))) + (let ((old-width (string-width (buffer-substring pos (point))))) + (delete-region pos (point)) + (when (> old-width width) + (insert-char ? (- old-width width)) + (goto-char pos)))))) (insert ch) (forward-char -1) (picture-move)))) diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index b73916a22d6..46bf3c7552b 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -61,7 +61,7 @@ (defgroup refbib nil "Convert refer-style references to ones usable by Latex bib." :prefix "r2b-" - :group 'wp) + :group 'text) (defcustom r2b-trace-on nil "Non-nil means trace conversion." diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index f2abf06ebdc..4c9e62bb4c8 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -73,7 +73,7 @@ (defgroup refer nil "Look up references in bibliography files." :prefix "refer-" - :group 'wp) + :group 'text) (defcustom refer-bib-directory nil "Directory, or list of directories, to search for \\.bib files. diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 505df5d3424..8efe8a2ec19 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index b5b7d466e9c..fd7915ccc76 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -73,7 +73,7 @@ The expanded value is cached." ;;;###autoload (defun reftex-bib-or-thebib () - "Test if BibTeX or \begin{thebibliography} should be used for the citation. + "Test if BibTeX or \\begin{thebibliography} should be used for the citation. Find the bof of the current file" (let* ((docstruct (symbol-value reftex-docstruct-symbol)) (rest (or (member (list 'bof (buffer-file-name)) docstruct) @@ -744,7 +744,7 @@ While entering the regexp, completion on knows citation keys is possible. (if (> arg 1) (progn (skip-chars-backward "}") - (decf arg) + (cl-decf arg) (reftex-do-citation arg)) (forward-char 1))) @@ -1210,7 +1210,7 @@ created files in the variables `reftex-create-bibtex-header' or ;; check for crossref entries (let* ((attr-list (reftex-parse-bibtex-entry nil beg end)) (xref-key (cdr (assoc "crossref" attr-list)))) - (if xref-key (pushnew xref-key keys))) + (if xref-key (cl-pushnew xref-key keys))) ;; check for string references (let* ((raw-fields (reftex-parse-bibtex-entry nil beg end t)) (string-fields (reftex-get-string-refs raw-fields))) diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index f1d4d6fcba8..65742f36f78 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function bibtex-beginning-of-entry "bibtex" ()) @@ -424,7 +424,7 @@ Calling this function several times find successive citation locations." (if match (progn (put 'reftex-view-regexp-match :props newprop) - (put 'reftex-view-regexp-match :cnt (incf cnt)) + (put 'reftex-view-regexp-match :cnt (cl-incf cnt)) (reftex-highlight 0 (match-beginning highlight-group) (match-end highlight-group)) (add-hook 'pre-command-hook 'reftex-highlight-shall-die) diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index d2500510443..c8c62a0d944 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (provide 'reftex-global) (require 'reftex) ;;; @@ -154,7 +154,7 @@ No active TAGS table is required." (while dlist (when (and (car (car dlist)) (cdr (car dlist))) - (incf cnt) + (cl-incf cnt) (insert (mapconcat 'identity (car dlist) "\n ") "\n")) (pop dlist)) (goto-char (point-min)) @@ -223,7 +223,7 @@ one with the `xr' package." (if (assoc label translate-alist) (error "Duplicate label %s" label)) (setq new-label (concat (match-string 1 (car entry)) - (int-to-string (incf (cdr nr-cell))))) + (int-to-string (cl-incf (cdr nr-cell))))) (push (cons label new-label) translate-alist) (or (string= label new-label) (setq changed-sequence t)))) @@ -302,7 +302,7 @@ one with the `xr' package." (error "Abort"))) (reftex-unhighlight 1))) ((and test cell) - (incf n)) + (cl-incf n)) ((and (not test) cell) ;; Replace (goto-char (match-beginning 1)) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 0ed6f26699a..4dd190d2b0f 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function texmathp "ext:texmathp" ()) (require 'reftex) @@ -128,7 +128,7 @@ will prompt for other arguments." ;; Insert the macro and ask for any additional args (insert macro) - (loop for i from 1 to nargs do + (cl-loop for i from 1 to nargs do (setq opt (member i opt-args) value (cond ((= nindex i) key) ((equal ntag i) tag1) @@ -214,16 +214,16 @@ will prompt for other arguments." i -1 val nil) (catch 'exit - (while (and (< (incf i) len) (null val)) + (while (and (< (cl-incf i) len) (null val)) (unless (assq (aref tag i) tag-alist) (push (list (aref tag i) tag (concat (substring tag 0 i) - "[" (substring tag i (incf i)) "]" + "[" (substring tag i (cl-incf i)) "]" (substring tag i))) tag-alist) (throw 'exit t))) - (push (list (+ ?0 (incf cnt)) tag + (push (list (+ ?0 (cl-incf cnt)) tag (concat "[" (int-to-string cnt) "]:" tag)) tag-alist))) (setq tag-alist (nreverse tag-alist)) @@ -287,46 +287,40 @@ will prompt for other arguments." (substitute-key-definition 'previous-line 'reftex-index-previous map global-map) - (loop for x in - '(("n" . reftex-index-next) - ("p" . reftex-index-previous) - ("?" . reftex-index-show-help) - (" " . reftex-index-view-entry) - ("\C-m" . reftex-index-goto-entry-and-hide) - ("\C-i" . reftex-index-goto-entry) - ("\C-k" . reftex-index-kill) - ("r" . reftex-index-rescan) - ("R" . reftex-index-Rescan) - ("g" . revert-buffer) - ("q" . reftex-index-quit) - ("k" . reftex-index-quit-and-kill) - ("f" . reftex-index-toggle-follow) - ("s" . reftex-index-switch-index-tag) - ("e" . reftex-index-edit) - ("^" . reftex-index-level-up) - ("_" . reftex-index-level-down) - ("}" . reftex-index-restrict-to-section) - ("{" . reftex-index-widen) - (">" . reftex-index-restriction-forward) - ("<" . reftex-index-restriction-backward) - ("(" . reftex-index-toggle-range-beginning) - (")" . reftex-index-toggle-range-end) - ("|" . reftex-index-edit-attribute) - ("@" . reftex-index-edit-visual) - ("*" . reftex-index-edit-key) - ("\C-c=". reftex-index-goto-toc) - ("c" . reftex-index-toggle-context)) - do (define-key map (car x) (cdr x))) - - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) + (define-key map "n" 'reftex-index-next) + (define-key map "p" 'reftex-index-previous) + (define-key map "?" 'reftex-index-show-help) + (define-key map " " 'reftex-index-view-entry) + (define-key map "\C-m" 'reftex-index-goto-entry-and-hide) + (define-key map "\C-i" 'reftex-index-goto-entry) + (define-key map "\C-k" 'reftex-index-kill) + (define-key map "r" 'reftex-index-rescan) + (define-key map "R" 'reftex-index-Rescan) + (define-key map "g" 'revert-buffer) + (define-key map "q" 'reftex-index-quit) + (define-key map "k" 'reftex-index-quit-and-kill) + (define-key map "f" 'reftex-index-toggle-follow) + (define-key map "s" 'reftex-index-switch-index-tag) + (define-key map "e" 'reftex-index-edit) + (define-key map "^" 'reftex-index-level-up) + (define-key map "_" 'reftex-index-level-down) + (define-key map "}" 'reftex-index-restrict-to-section) + (define-key map "{" 'reftex-index-widen) + (define-key map ">" 'reftex-index-restriction-forward) + (define-key map "<" 'reftex-index-restriction-backward) + (define-key map "(" 'reftex-index-toggle-range-beginning) + (define-key map ")" 'reftex-index-toggle-range-end) + (define-key map "|" 'reftex-index-edit-attribute) + (define-key map "@" 'reftex-index-edit-visual) + (define-key map "*" 'reftex-index-edit-key) + (define-key map "\C-c=" 'reftex-index-goto-toc) + (define-key map "c" 'reftex-index-toggle-context) ;; The capital letters and the exclamation mark - (loop for key across (concat "!" reftex-index-section-letters) do - (define-key map (vector (list key)) - (list 'lambda '() '(interactive) - (list 'reftex-index-goto-letter key)))) + (cl-loop for key across (concat "!" reftex-index-section-letters) do + (define-key map (vector (list key)) + (list 'lambda '() '(interactive) + (list 'reftex-index-goto-letter key)))) (easy-menu-define reftex-index-menu map "Menu for Index buffer" @@ -392,7 +386,7 @@ will prompt for other arguments." (defvar reftex-index-restriction-indicator nil) (defvar reftex-index-restriction-data nil) -(define-derived-mode reftex-index-mode fundamental-mode "RefTeX Index" +(define-derived-mode reftex-index-mode special-mode "RefTeX Index" "Major mode for managing Index buffers for LaTeX files. This buffer was created with RefTeX. Press `?' for a summary of important key bindings, or check the menu. @@ -1194,20 +1188,18 @@ This gets refreshed in every phrases command.") (defvar reftex-index-phrases-mode-map (let ((map (make-sparse-keymap))) ;; Keybindings and Menu for phrases buffer - (loop for x in - '(("\C-c\C-c" . reftex-index-phrases-save-and-return) - ("\C-c\C-x" . reftex-index-this-phrase) - ("\C-c\C-f" . reftex-index-next-phrase) - ("\C-c\C-r" . reftex-index-region-phrases) - ("\C-c\C-a" . reftex-index-all-phrases) - ("\C-c\C-d" . reftex-index-remaining-phrases) - ("\C-c\C-s" . reftex-index-sort-phrases) - ("\C-c\C-n" . reftex-index-new-phrase) - ("\C-c\C-m" . reftex-index-phrases-set-macro-key) - ("\C-c\C-i" . reftex-index-phrases-info) - ("\C-c\C-t" . reftex-index-find-next-conflict-phrase) - ("\C-i" . self-insert-command)) - do (define-key map (car x) (cdr x))) + (define-key map "\C-c\C-c" 'reftex-index-phrases-save-and-return) + (define-key map "\C-c\C-x" 'reftex-index-this-phrase) + (define-key map "\C-c\C-f" 'reftex-index-next-phrase) + (define-key map "\C-c\C-r" 'reftex-index-region-phrases) + (define-key map "\C-c\C-a" 'reftex-index-all-phrases) + (define-key map "\C-c\C-d" 'reftex-index-remaining-phrases) + (define-key map "\C-c\C-s" 'reftex-index-sort-phrases) + (define-key map "\C-c\C-n" 'reftex-index-new-phrase) + (define-key map "\C-c\C-m" 'reftex-index-phrases-set-macro-key) + (define-key map "\C-c\C-i" 'reftex-index-phrases-info) + (define-key map "\C-c\C-t" 'reftex-index-find-next-conflict-phrase) + (define-key map "\C-i" 'self-insert-command) (easy-menu-define reftex-index-phrases-menu map "Menu for Phrases buffer" @@ -1255,7 +1247,7 @@ This gets refreshed in every phrases command.") ["Save and Return" reftex-index-phrases-save-and-return t])) map) - "Keymap used for *toc* buffer.") + "Keymap used for index phrases buffer.") (defvar reftex-index-phrases-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\" "." table) @@ -1434,7 +1426,7 @@ Here are all local bindings. (interactive "p") (reftex-index-phrases-parse-header t) (while (> arg 0) - (decf arg) + (cl-decf arg) (end-of-line) (if (re-search-forward reftex-index-phrases-phrase-regexp12 nil t) (progn @@ -1663,11 +1655,11 @@ this function repeatedly." (widen) (goto-char (point-min)) (while (re-search-forward re1 nil t) - (incf ntimes1)) + (cl-incf ntimes1)) (goto-char (point-min)) (while (re-search-forward re2 nil t) (push (cons (count-lines 1 (point)) (match-string 1)) superphrases) - (incf ntimes2)))) + (cl-incf ntimes2)))) (save-current-buffer (while (setq file (pop files)) (setq buf (reftex-get-file-buffer-force file)) @@ -1680,7 +1672,7 @@ this function repeatedly." (let ((case-fold-search reftex-index-phrases-case-fold-search)) (while (re-search-forward re nil t) (or (reftex-in-comment) - (incf nmatches))))))))) + (cl-incf nmatches))))))))) (with-output-to-temp-buffer "*Help*" (princ (format " Phrase: %s\n" phrase)) (princ (format " Macro key: %s\n" char)) @@ -1690,7 +1682,7 @@ this function repeatedly." (index-key (let ((iks index-keys) (cnt 0) ik) (while (setq ik (pop iks)) - (princ (format "Index entry %d: %s\n" (incf cnt) ik))))) + (princ (format "Index entry %d: %s\n" (cl-incf cnt) ik))))) (repeat (princ (format " Index entry: %s\n" phrase))) (t @@ -1951,7 +1943,7 @@ both ends." (cond ((member char '(?y ?Y ?\ )) ;; Yes! (replace-match rpl t t) - (incf replace-count) + (cl-incf replace-count) ;; See if we should insert newlines to shorten lines (and reftex-index-phrases-wrap-long-lines (reftex-index-phrases-fixup-line beg end)) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 1d6fa311d5f..9180bea3d3b 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -306,7 +306,7 @@ of master file." (when reftex-support-index (setq index-entry (reftex-index-info file)) (when index-entry - (add-to-list 'reftex--index-tags (nth 1 index-entry)) + (cl-pushnew (nth 1 index-entry) reftex--index-tags :test #'equal) (push index-entry docstruct)))) ((match-end 11) @@ -608,7 +608,7 @@ if the information is exact (t) or approximate (nil)." found) (save-excursion (while (not rtn) - (incf cnt) + (cl-incf cnt) (setq found (re-search-backward (reftex-everything-regexp) nil t)) (setq rtn (cond @@ -672,7 +672,7 @@ if the information is exact (t) or approximate (nil)." (when (and (eq (car (car list)) 'index) (string= (nth 2 index-info) (nth 2 (car list)))) - (incf n) + (cl-incf n) (setq dist (abs (- (point) (nth 4 (car list))))) (if (or (not last-dist) (< dist last-dist)) (setq last-dist dist last (car list)))) @@ -841,8 +841,8 @@ considered an argument of macro \\macro." (let ((forward-sexp-function nil)) (backward-sexp) t) (error nil))) - (if (eq (following-char) ?\[) (incf cnt-opt)) - (incf cnt)) + (if (eq (following-char) ?\[) (cl-incf cnt-opt)) + (cl-incf cnt)) (setq pos (point)) (when (and (or (= (following-char) ?\[) (= (following-char) ?\{)) @@ -984,18 +984,18 @@ OPT-ARGS is a list of argument numbers which are optional." (while (< cnt n) (while (and (member cnt opt-args) (eq (following-char) ?\{)) - (incf cnt)) + (cl-incf cnt)) (when (< cnt n) (unless (and (condition-case nil (or (forward-list 1) t) (error nil)) (reftex-move-to-next-arg) - (incf cnt)) + (cl-incf cnt)) (setq cnt 1000)))) (while (and (memq cnt opt-args) (eq (following-char) ?\{)) - (incf cnt))) + (cl-incf cnt))) (if (and (= n cnt) (> (skip-chars-forward "{\\[") 0)) (reftex-context-substring) @@ -1057,7 +1057,7 @@ When point is just after a { or [, limit string to matching parenthesis" (- (string-to-char number-string) ?A -1)) (aset reftex-section-numbers i (string-to-number number-string))) (pop numbers)) - (decf i))) + (cl-decf i))) (put 'reftex-section-numbers 'appendix appendix)) ;;;###autoload @@ -1081,7 +1081,7 @@ When LEVEL is non-nil, increase section numbers on that level." (if (or (not partspecial) (not (= idx 1))) (aset reftex-section-numbers idx 0)) - (incf idx)))) + (cl-incf idx)))) (if partspecial (setq string (concat "Part " (reftex-roman-number (aref reftex-section-numbers 0)))) @@ -1091,7 +1091,7 @@ When LEVEL is non-nil, increase section numbers on that level." (if (not (and partspecial (not (equal string "")))) (setq string (concat string (if (not (string= string "")) "." "") (int-to-string n)))) - (incf idx)) + (cl-incf idx)) (save-match-data (if (string-match "\\`\\([@0]\\.\\)+" string) (setq string (replace-match "" nil nil string))) diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index f5a784bf63d..fdde4aa0541 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) (require 'reftex-parse) @@ -374,7 +374,7 @@ also applies `reftex-translate-to-ascii-function' to the string." (sep (or separator ""))) (while (assoc (concat label sep (int-to-string num)) (symbol-value reftex-docstruct-symbol)) - (incf num)) + (cl-incf num)) (setcdr cell num) (concat label sep (int-to-string num)))))) @@ -566,7 +566,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (reftex-erase-buffer)) (unless (eq major-mode 'reftex-select-label-mode) (reftex-select-label-mode)) - (add-to-list 'selection-buffers (current-buffer)) + (cl-pushnew (current-buffer) selection-buffers) (setq truncate-lines t) (setq mode-line-format (list "---- " 'mode-line-buffer-identification diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 02caa67e9a8..d3a7ee49804 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -24,7 +24,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'reftex) @@ -32,6 +32,7 @@ ;; and reftex-select-bib-mode-map. (defvar reftex-select-shared-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) (substitute-key-definition 'next-line 'reftex-select-next map global-map) (substitute-key-definition @@ -41,31 +42,23 @@ (substitute-key-definition 'newline 'reftex-select-accept map global-map) - (loop for x in - '((" " . reftex-select-callback) - ("n" . reftex-select-next) - ([(down)] . reftex-select-next) - ("p" . reftex-select-previous) - ([(up)] . reftex-select-previous) - ("f" . reftex-select-toggle-follow) - ("\C-m" . reftex-select-accept) - ([(return)] . reftex-select-accept) - ("q" . reftex-select-quit) - ("." . reftex-select-show-insertion-point) - ("?" . reftex-select-help)) - do (define-key map (car x) (cdr x))) + (define-key map " " 'reftex-select-callback) + (define-key map "n" 'reftex-select-next) + (define-key map [(down)] 'reftex-select-next) + (define-key map "p" 'reftex-select-previous) + (define-key map [(up)] 'reftex-select-previous) + (define-key map "f" 'reftex-select-toggle-follow) + (define-key map "\C-m" 'reftex-select-accept) + (define-key map [(return)] 'reftex-select-accept) + (define-key map "q" 'reftex-select-quit) + (define-key map "." 'reftex-select-show-insertion-point) + (define-key map "?" 'reftex-select-help) ;; The mouse-2 binding (if (featurep 'xemacs) (define-key map [(button2)] 'reftex-select-mouse-accept) (define-key map [(mouse-2)] 'reftex-select-mouse-accept) (define-key map [follow-link] 'mouse-face)) - - - ;; Digit arguments - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) map)) (define-obsolete-variable-alias @@ -74,28 +67,25 @@ (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) - (loop for key across "aAcgFlrRstx#%" do - (define-key map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) - - (loop for x in - '(("b" . reftex-select-jump-to-previous) - ("z" . reftex-select-jump) - ("v" . reftex-select-cycle-ref-style-forward) - ("V" . reftex-select-cycle-ref-style-backward) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark) - ("," . reftex-select-mark-comma) - ("-" . reftex-select-mark-to) - ("+" . reftex-select-mark-and) - ([(tab)] . reftex-select-read-label) - ("\C-i" . reftex-select-read-label) - ("\C-c\C-n" . reftex-select-next-heading) - ("\C-c\C-p" . reftex-select-previous-heading)) - do - (define-key map (car x) (cdr x))) + (cl-loop for key across "aAcgFlrRstx#%" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) + + (define-key map "b" 'reftex-select-jump-to-previous) + (define-key map "z" 'reftex-select-jump) + (define-key map "v" 'reftex-select-cycle-ref-style-forward) + (define-key map "V" 'reftex-select-cycle-ref-style-backward) + (define-key map "m" 'reftex-select-mark) + (define-key map "u" 'reftex-select-unmark) + (define-key map "," 'reftex-select-mark-comma) + (define-key map "-" 'reftex-select-mark-to) + (define-key map "+" 'reftex-select-mark-and) + (define-key map [(tab)] 'reftex-select-read-label) + (define-key map "\C-i" 'reftex-select-read-label) + (define-key map "\C-c\C-n" 'reftex-select-next-heading) + (define-key map "\C-c\C-p" 'reftex-select-previous-heading) map) "Keymap used for *RefTeX Select* buffer, when selecting a label. @@ -130,18 +120,16 @@ During a selection process, these are the local bindings. (let ((map (make-sparse-keymap))) (set-keymap-parent map reftex-select-shared-map) - (loop for key across "grRaAeE" do - (define-key map (vector (list key)) - (list 'lambda '() - "Press `?' during selection to find out about this key." - '(interactive) (list 'throw '(quote myexit) key)))) + (cl-loop for key across "grRaAeE" do + (define-key map (vector (list key)) + (list 'lambda '() + "Press `?' during selection to find out about this key." + '(interactive) (list 'throw '(quote myexit) key)))) - (loop for x in - '(("\C-i" . reftex-select-read-cite) - ([(tab)] . reftex-select-read-cite) - ("m" . reftex-select-mark) - ("u" . reftex-select-unmark)) - do (define-key map (car x) (cdr x))) + (define-key map "\C-i" 'reftex-select-read-cite) + (define-key map [(tab)] 'reftex-select-read-cite) + (define-key map "m" 'reftex-select-mark) + (define-key map "u" 'reftex-select-unmark) map) "Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry. @@ -272,7 +260,7 @@ During a selection process, these are the local bindings. ;; Walk the docstruct and insert the appropriate stuff (while (setq cell (pop all)) - (incf index) + (cl-incf index) (setq from (point)) (cond @@ -342,7 +330,7 @@ During a selection process, these are the local bindings. (or show-commented (null comment))) ;; Yes we want this one - (incf cnt) + (cl-incf cnt) (setq prev-inserted cell) ; (if (eq offset 'attention) (setq offset cell)) @@ -728,8 +716,8 @@ Cycle in reverse order if optional argument REVERSE is non-nil." (setq sep (nth 2 c)) (reftex-overlay-put (nth 1 c) 'before-string (if sep - (format "*%c%d* " sep (decf cnt)) - (format "*%d* " (decf cnt))))) + (format "*%c%d* " sep (cl-decf cnt)) + (format "*%d* " (cl-decf cnt))))) reftex-select-marked) (message "Entry no longer marked"))) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 915acc8382d..a4c8da07501 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -24,7 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (provide 'reftex-toc) (require 'reftex) ;;; @@ -42,41 +41,34 @@ (substitute-key-definition 'previous-line 'reftex-toc-previous map global-map) - (loop for x in - '(("n" . reftex-toc-next) - ("p" . reftex-toc-previous) - ("?" . reftex-toc-show-help) - (" " . reftex-toc-view-line) - ("\C-m" . reftex-toc-goto-line-and-hide) - ("\C-i" . reftex-toc-goto-line) - ("\C-c>" . reftex-toc-display-index) - ("r" . reftex-toc-rescan) - ("R" . reftex-toc-Rescan) - ("g" . revert-buffer) - ("q" . reftex-toc-quit) ; - ("k" . reftex-toc-quit-and-kill) - ("f" . reftex-toc-toggle-follow) ; - ("a" . reftex-toggle-auto-toc-recenter) - ("d" . reftex-toc-toggle-dedicated-frame) - ("F" . reftex-toc-toggle-file-boundary) - ("i" . reftex-toc-toggle-index) - ("l" . reftex-toc-toggle-labels) - ("t" . reftex-toc-max-level) - ("c" . reftex-toc-toggle-context) - ;; ("%" . reftex-toc-toggle-commented) - ("\M-%" . reftex-toc-rename-label) - ("x" . reftex-toc-external) - ("z" . reftex-toc-jump) - ("." . reftex-toc-show-calling-point) - ("\C-c\C-n" . reftex-toc-next-heading) - ("\C-c\C-p" . reftex-toc-previous-heading) - (">" . reftex-toc-demote) - ("<" . reftex-toc-promote)) - do (define-key map (car x) (cdr x))) - - (loop for key across "0123456789" do - (define-key map (vector (list key)) 'digit-argument)) - (define-key map "-" 'negative-argument) + (define-key map "n" 'reftex-toc-next) + (define-key map "p" 'reftex-toc-previous) + (define-key map "?" 'reftex-toc-show-help) + (define-key map " " 'reftex-toc-view-line) + (define-key map "\C-m" 'reftex-toc-goto-line-and-hide) + (define-key map "\C-i" 'reftex-toc-goto-line) + (define-key map "\C-c>" 'reftex-toc-display-index) + (define-key map "r" 'reftex-toc-rescan) + (define-key map "R" 'reftex-toc-Rescan) + (define-key map "q" 'reftex-toc-quit) ; + (define-key map "k" 'reftex-toc-quit-and-kill) + (define-key map "f" 'reftex-toc-toggle-follow) ; + (define-key map "a" 'reftex-toggle-auto-toc-recenter) + (define-key map "d" 'reftex-toc-toggle-dedicated-frame) + (define-key map "F" 'reftex-toc-toggle-file-boundary) + (define-key map "i" 'reftex-toc-toggle-index) + (define-key map "l" 'reftex-toc-toggle-labels) + (define-key map "t" 'reftex-toc-max-level) + (define-key map "c" 'reftex-toc-toggle-context) + ;; (define-key map "%" 'reftex-toc-toggle-commented) + (define-key map "\M-%" 'reftex-toc-rename-label) + (define-key map "x" 'reftex-toc-external) + (define-key map "z" 'reftex-toc-jump) + (define-key map "." 'reftex-toc-show-calling-point) + (define-key map "\C-c\C-n" 'reftex-toc-next-heading) + (define-key map "\C-c\C-p" 'reftex-toc-previous-heading) + (define-key map ">" 'reftex-toc-demote) + (define-key map "<" 'reftex-toc-promote) (easy-menu-define reftex-toc-menu map @@ -942,17 +934,17 @@ label prefix determines the wording of a reference." (with-selected-window toc-window (reftex-unhighlight 0))) ((eq final 'hide) - (let ((show-window (selected-window)) - (show-buffer (window-buffer))) - (unless (eq show-window toc-window) ;FIXME: Can this happen? + (let ((window (selected-window)) + (buffer (window-buffer))) + (unless (eq window toc-window) ;FIXME: Can this happen? (with-selected-window toc-window (reftex-unhighlight 0) (or (one-window-p) (delete-window)))) - ;; If `show-window' is still live, show-buffer is already visible + ;; If window is still live, buffer is already visible ;; so let's not make it visible in yet-another-window. - (unless (window-live-p show-window) - ;; FIXME: How could show-window not be live? - (switch-to-buffer show-buffer)) + (unless (window-live-p window) + ;; FIXME: How could window not be live? + (pop-to-buffer-same-window buffer)) (reftex-re-enlarge))) (t (unless (eq (selected-frame) (window-frame toc-window)) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index d1a6b87da2e..d6de53b2466 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -24,7 +24,7 @@ ;;; Code: (defvar reftex-tables-dirty) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (eval-and-compile (defun reftex-set-dirty (symbol value) (setq reftex-tables-dirty t) @@ -1076,9 +1076,9 @@ used in the variable `reftex-ref-style-alist'." ;; Compatibility with obsolete variables. (when reftex-vref-is-default - (add-to-list 'reftex-ref-style-default-list "Varioref")) + (cl-pushnew "Varioref" reftex-ref-style-default-list :test #'equal)) (when reftex-fref-is-default - (add-to-list 'reftex-ref-style-default-list "Fancyref")) + (cl-pushnew "Fancyref" reftex-ref-style-default-list :test #'equal)) (defcustom reftex-level-indent 2 "Number of spaces to be used for indentation per section level." diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index a488ab14b10..adc5076daf1 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -50,7 +50,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Stuff that needs to be there when we use defcustom (require 'custom) @@ -100,7 +100,42 @@ (defconst reftex-version emacs-version "Version string for RefTeX.") -(defvar reftex-mode-map (make-sparse-keymap) +(defvar reftex-mode-map + (let ((map (make-sparse-keymap))) + ;; The default bindings in the mode map. + (define-key map "\C-c=" 'reftex-toc) + (define-key map "\C-c-" 'reftex-toc-recenter) + (define-key map "\C-c(" 'reftex-label) + (define-key map "\C-c)" 'reftex-reference) + (define-key map "\C-c[" 'reftex-citation) + (define-key map "\C-c<" 'reftex-index) + (define-key map "\C-c>" 'reftex-display-index) + (define-key map "\C-c/" 'reftex-index-selection-or-word) + (define-key map "\C-c\\" 'reftex-index-phrase-selection-or-word) + (define-key map "\C-c|" 'reftex-index-visit-phrases-buffer) + (define-key map "\C-c&" 'reftex-view-crossref) + + ;; Bind `reftex-mouse-view-crossref' only when the key is still free + (if (featurep 'xemacs) + (unless (key-binding [(shift button2)]) + (define-key map [(shift button2)] 'reftex-mouse-view-crossref)) + (unless (key-binding [(shift mouse-2)]) + (define-key map [(shift mouse-2)] 'reftex-mouse-view-crossref))) + + ;; For most of these commands there are already bindings in place. + ;; Setting `reftex-extra-bindings' really is only there to spare users + ;; the hassle of defining bindings in the user space themselves. This + ;; is why they violate the key binding recommendations. + (when reftex-extra-bindings + (define-key map "\C-ct" 'reftex-toc) + (define-key map "\C-cl" 'reftex-label) + (define-key map "\C-cr" 'reftex-reference) + (define-key map "\C-cc" 'reftex-citation) + (define-key map "\C-cv" 'reftex-view-crossref) + (define-key map "\C-cg" 'reftex-grep-document) + (define-key map "\C-cs" 'reftex-search-document)) + + map) "Keymap for RefTeX mode.") (defvar reftex-mode-menu nil) @@ -255,7 +290,7 @@ on the menu bar. (defun reftex-next-multifile-index () ;; Return the next free index for multifile symbols. - (incf reftex-multifile-index)) + (cl-incf reftex-multifile-index)) (defun reftex-tie-multifile-symbols () "Tie the buffer-local symbols to globals connected with the master file. @@ -444,7 +479,7 @@ will deactivate it." (unless (member style list) (setq reftex-tables-dirty t changed t) - (add-to-list 'list style t))) + (setq list (append list (list style))))) ((eq action 'deactivate) (when (member style list) (setq reftex-tables-dirty t @@ -453,7 +488,7 @@ will deactivate it." (t (if (member style list) (delete style list) - (add-to-list 'list style t)) + (setq list (append list (list style)))) (setq reftex-tables-dirty t changed t))) (when changed @@ -659,9 +694,9 @@ on next use." (interactive) ;; Reset the file search path variables - (loop for prop in '(status master-dir recursive-path rec-type) do - (put 'reftex-tex-path prop nil) - (put 'reftex-bib-path prop nil)) + (dolist (prop '(status master-dir recursive-path rec-type)) + (put 'reftex-tex-path prop nil) + (put 'reftex-bib-path prop nil)) ;; Kill temporary buffers associated with RefTeX - just in case they ;; were not cleaned up properly @@ -796,15 +831,15 @@ This enforces rescanning the buffer on next use." reffmt (nth 1 fmt)) ;; Note a new typekey (if typekey - (add-to-list 'reftex-typekey-list typekey)) + (cl-pushnew typekey reftex-typekey-list :test #'equal)) (if (and typekey prefix (not (assoc prefix reftex-prefix-to-typekey-alist))) - (add-to-list 'reftex-prefix-to-typekey-alist - (cons prefix typekey))) + (cl-pushnew (cons prefix typekey) reftex-prefix-to-typekey-alist + :test #'equal)) (if (and typekey prefix (not (assoc typekey reftex-typekey-to-prefix-alist))) - (add-to-list 'reftex-typekey-to-prefix-alist - (cons typekey prefix))) + (cl-pushnew (cons typekey prefix) reftex-typekey-to-prefix-alist + :test #'equal)) ;; Check if this is a macro or environment (cond ((symbolp env-or-mac) @@ -813,17 +848,17 @@ This enforces rescanning the buffer on next use." (message "Warning: %s does not seem to be a valid function" env-or-mac)) (setq nargs nil nlabel nil opt-args nil) - (add-to-list 'reftex-special-env-parsers env-or-mac) + (cl-pushnew env-or-mac reftex-special-env-parsers) (setq env-or-mac (symbol-name env-or-mac))) ((string-match "\\`\\\\" env-or-mac) ;; It's a macro (let ((result (reftex-parse-args env-or-mac))) - (setq env-or-mac (or (first result) env-or-mac) - nargs (second result) - nlabel (third result) - opt-args (fourth result)) - (if nlabel (add-to-list 'macros-with-labels env-or-mac))) - (if typekey (add-to-list 'reftex-label-mac-list env-or-mac))) + (setq env-or-mac (or (cl-first result) env-or-mac) + nargs (cl-second result) + nlabel (cl-third result) + opt-args (cl-fourth result)) + (if nlabel (cl-pushnew env-or-mac macros-with-labels :test #'equal))) + (if typekey (cl-pushnew env-or-mac reftex-label-mac-list :test #'equal))) (t ;; It's an environment (setq nargs nil nlabel nil opt-args nil) @@ -831,7 +866,7 @@ This enforces rescanning the buffer on next use." ((string= env-or-mac "")) ((string= env-or-mac "section")) (t - (add-to-list 'reftex-label-env-list env-or-mac) + (cl-pushnew env-or-mac reftex-label-env-list :test #'equal) (if toc-level (let ((string (format "begin{%s}" env-or-mac))) (or (assoc string toc-levels) @@ -915,7 +950,7 @@ This enforces rescanning the buffer on next use." (not (member (aref fmt i) '(?%)))) (setq word (concat word "\\|" (regexp-quote (substring fmt 0 (1+ i))))) - (incf i)) + (cl-incf i)) (cons (concat word "\\)\\=") typekey)) (nreverse reftex-words-to-typekey-alist))) @@ -941,10 +976,10 @@ This enforces rescanning the buffer on next use." (t t)) all-index (cdr all-index)) (let ((result (reftex-parse-args macro))) - (setq macro (or (first result) macro) - nargs (second result) - nindex (third result) - opt-args (fourth result)) + (setq macro (or (cl-first result) macro) + nargs (cl-second result) + nindex (cl-third result) + opt-args (cl-fourth result)) (unless (member macro reftex-macros-with-index) ;; 0 1 2 3 4 5 6 7 (push (list macro tag prefix verify nargs nindex opt-args repeat) @@ -968,7 +1003,7 @@ This enforces rescanning the buffer on next use." (mapconcat (lambda(x) (format "[%c] %-20.20s%s" (car x) (nth 1 x) - (if (= 0 (mod (incf i) 3)) "\n" ""))) + (if (= 0 (mod (cl-incf i) 3)) "\n" ""))) reftex-key-to-index-macro-alist ""))) ;; Make the full list of section levels @@ -1058,7 +1093,7 @@ This enforces rescanning the buffer on next use." (args (substring macro (match-beginning 0))) opt-list nlabel (cnt 0)) (while (string-match "\\`[[{]\\(\\*\\)?[]}]" args) - (incf cnt) + (cl-incf cnt) (when (eq ?\[ (string-to-char args)) (push cnt opt-list)) (when (and (match-end 1) @@ -1123,7 +1158,7 @@ This enforces rescanning the buffer on next use." (defun reftex-silence-toc-markers (list n) ;; Set all toc markers in the first N entries in list to nil - (while (and list (> (decf n) -1)) + (while (and list (> (cl-decf n) -1)) (and (eq (car (car list)) 'toc) (markerp (nth 4 (car list))) (set-marker (nth 4 (car list)) nil)) @@ -1254,7 +1289,7 @@ Valid actions are: readable, restore, read, kill, write." "SELECT EXTERNAL DOCUMENT\n------------------------\n" (mapconcat (lambda (x) - (format fmt (incf n) (or (car x) "") + (format fmt (cl-incf n) (or (car x) "") (abbreviate-file-name (cdr x)))) xr-alist "")) nil t)) @@ -1758,11 +1793,11 @@ When DIE is non-nil, throw an error if file not found." ;; with limited Magic ;; The magic goes away - (letf ((format-alist nil) - (auto-mode-alist (reftex-auto-mode-alist)) - ((default-value 'major-mode) 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil)) + (cl-letf ((format-alist nil) + (auto-mode-alist (reftex-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil)) (setq buf (find-file-noselect file))) ;; Is there a hook to run? @@ -1772,7 +1807,7 @@ When DIE is non-nil, throw an error if file not found." ;; Let's see if we got a license to kill :-| (and mark-to-kill - (add-to-list 'reftex-buffers-to-kill buf)) + (cl-pushnew buf reftex-buffers-to-kill)) ;; Return the new buffer buf) @@ -2134,30 +2169,6 @@ IGNORE-WORDS List of words which should be removed from the string." ;;; ;;; Keybindings -;; The default bindings in the mode map. -(loop for x in - '(("\C-c=" . reftex-toc) - ("\C-c-" . reftex-toc-recenter) - ("\C-c(" . reftex-label) - ("\C-c)" . reftex-reference) - ("\C-c[" . reftex-citation) - ("\C-c<" . reftex-index) - ("\C-c>" . reftex-display-index) - ("\C-c/" . reftex-index-selection-or-word) - ("\C-c\\" . reftex-index-phrase-selection-or-word) - ("\C-c|" . reftex-index-visit-phrases-buffer) - ("\C-c&" . reftex-view-crossref)) - do (define-key reftex-mode-map (car x) (cdr x))) - -;; Bind `reftex-mouse-view-crossref' only when the key is still free -(if (featurep 'xemacs) - (unless (key-binding [(shift button2)]) - (define-key reftex-mode-map [(shift button2)] - 'reftex-mouse-view-crossref)) - (unless (key-binding [(shift mouse-2)]) - (define-key reftex-mode-map [(shift mouse-2)] - 'reftex-mouse-view-crossref))) - (defvar bibtex-mode-map) ;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map @@ -2165,21 +2176,6 @@ IGNORE-WORDS List of words which should be removed from the string." "bibtex" '(define-key bibtex-mode-map "\C-c&" 'reftex-view-crossref-from-bibtex)) -;; For most of these commands there are already bindings in place. -;; Setting `reftex-extra-bindings' really is only there to spare users -;; the hassle of defining bindings in the user space themselves. This -;; is why they violate the key binding recommendations. -(when reftex-extra-bindings - (loop for x in - '(("\C-ct" . reftex-toc) - ("\C-cl" . reftex-label) - ("\C-cr" . reftex-reference) - ("\C-cc" . reftex-citation) - ("\C-cv" . reftex-view-crossref) - ("\C-cg" . reftex-grep-document) - ("\C-cs" . reftex-search-document)) - do (define-key reftex-mode-map (car x) (cdr x)))) - ;;; ========================================================================= ;;; ;;; Menu @@ -2269,7 +2265,7 @@ IGNORE-WORDS List of words which should be removed from the string." :style 'toggle :selected `(member ,elt (reftex-ref-style-list)))) (unless (member item list) - (add-to-list 'list item t))) + (setq list (append list (list item))))) list)) ("Citation Style" ,@(mapcar diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 3d4854e89d6..7161dd329ac 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2003-2016 Free Software Foundation, Inc. -;; Maintainer: Stefan Merten <smerten@oekonux.de> -;; Author: Stefan Merten <smerten@oekonux.de>, +;; Maintainer: Stefan Merten <stefan at merten-home dot de> +;; Author: Stefan Merten <stefan at merten-home dot de>, ;; Martin Blais <blais@furius.ca>, ;; David Goodger <goodger@python.org>, ;; Wei-Wei Guo <wwguocn@gmail.com> @@ -53,10 +53,10 @@ ;; For full details on how to use the contents of this file, see ;; http://docutils.sourceforge.net/docs/user/emacs.html ;; -;; -;; There are a number of convenient key bindings provided by rst-mode. -;; For more on bindings, see rst-mode-map below. There are also many variables -;; that can be customized, look for defcustom in this file. +;; There are a number of convenient key bindings provided by rst-mode. For the +;; bindings, try C-c C-h when in rst-mode. There are also many variables that +;; can be customized, look for defcustom in this file or look for the "rst" +;; customization group contained in the "wp" group. ;; ;; If you use the table-of-contents feature, you may want to add a hook to ;; update the TOC automatically every time you adjust a section title:: @@ -68,11 +68,6 @@ ;; ;; (setq font-lock-global-modes '(not rst-mode ...)) ;; -;; -;; -;; Customization is done by customizable variables contained in customization -;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. -;; ;;; DOWNLOAD @@ -110,10 +105,10 @@ ;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- ;; lexical-binding: t -*-" in the first line. -;; FIXME: Use `testcover'. +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. -;; FIXME: The adornment classification often called `ado' should be a -;; `defstruct'. +;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by +;; a comment tagged with `testcover' after the `defun'. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -160,6 +155,7 @@ considered constants. Revert it with this function after each `defcustom'." ;; used from there. (defun rst-signum (x) + ;; testcover: ok. "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) @@ -167,6 +163,7 @@ considered constants. Revert it with this function after each `defcustom'." (t 0))) (defun rst-some (seq &optional pred) + ;; testcover: ok. "Return non-nil if any element of SEQ yields non-nil when PRED is applied. Apply PRED to each element of list SEQ until the first non-nil result is yielded and return this result. PRED defaults to @@ -180,6 +177,7 @@ result is yielded and return this result. PRED defaults to (throw 'rst-some r)))))) (defun rst-position-if (pred seq) + ;; testcover: ok. "Return position of first element satisfying PRED in list SEQ or nil." (catch 'rst-position-if (let ((i 0)) @@ -189,6 +187,7 @@ result is yielded and return this result. PRED defaults to (incf i))))) (defun rst-position (elem seq) + ;; testcover: ok. "Return position of ELEM in list SEQ or nil. Comparison done with `equal'." ;; Create a closure containing `elem' so the `lambda' always sees our @@ -199,13 +198,22 @@ Comparison done with `equal'." (equal elem e))) seq))) -;; FIXME: Embed complicated `defconst's in `eval-when-compile'. +(defun rst-member-if (pred seq) + ;; testcover: ok. + "Return sublist of SEQ starting with the element whose car satisfies PRED." + (let (found) + (while (and (not found) seq) + (if (funcall pred (car seq)) + (setq found seq) + (setq seq (cdr seq)))) + found)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Versions -;; testcover: ok. (defun rst-extract-version (delim-re head-re re tail-re var &optional default) + ;; testcover: ok. "Extract the version from a variable according to the given regexes. Return the version after regex DELIM-RE and HEAD-RE matching RE and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." @@ -218,7 +226,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.26 2015/10/04 09:26:04 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.600 2016/07/31 11:13:44 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -232,22 +240,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use LastChanged... to really get information from SVN. (defconst rst-svn-rev (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " - "$LastChangedRevision: 7925 $") + "$LastChangedRevision: 7963 $") "The SVN revision of this file. SVN revision is the upstream (docutils) revision.") (defconst rst-svn-timestamp (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " - "$LastChangedDate: 2015-10-04 11:21:35 +0200 (Sun, 04 Oct 2015) $") + "$LastChangedDate: 2016-07-31 13:13:21 +0200 (Sun, 31 Jul 2016) $") "The SVN time stamp of this file.") ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.4.1 %") + "%OfficialVersion: 1.5.0 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%Revision: 1.327.2.25 %") + "%Revision: 1.600 %") "CVS revision of this file in the official version.") (defconst rst-version @@ -268,6 +276,8 @@ in parentheses follows the development revision and the time stamp.") ("1.3.1" . "24.3") ("1.4.0" . "24.3") ("1.4.1" . "24.5") + ("1.4.2" . "24.5") + ("1.5.0" . "26.1") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -277,12 +287,12 @@ in parentheses follows the development revision and the time stamp.") (add-to-list 'customize-package-emacs-version-alist (cons 'ReST rst-package-emacs-version-alist)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialize customization - (defgroup rst nil "Support for reStructuredText documents." - :group 'wp + :group 'text :version "23.1" :link '(url-link "http://docutils.sourceforge.net/rst.html")) @@ -490,8 +500,10 @@ in parentheses follows the development revision and the time stamp.") ; character. ;; Titles (`ttl') - (ttl-tag "\\S *\\w\\S *") ; A title text. - (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line. + (ttl-tag "\\S *\\w.*\\S ") ; A title text. + (ttl-beg-1 lin-beg (:grp ttl-tag)) ; A title text at the beginning of a + ; line. First group is the complete, + ; trimmed title text. ;; Directives and substitution definitions (`dir') (dir-tag-3 (:grp exm-sta) @@ -531,8 +543,8 @@ argument list for `rst-re'.") ;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. (rst-testcover-add-compose 'rst-re) -;; testcover: ok. (defun rst-re (&rest args) + ;; testcover: ok. "Interpret ARGS as regular expressions and return a regex string. Each element of ARGS may be one of the following: @@ -603,10 +615,579 @@ After interpretation of ARGS the results are concatenated as for ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Concepts + +;; Each of the following classes represents an own concept. The suffix of the +;; class name is used in the code to represent entities of the respective +;; class. +;; +;; In addition a reStructuredText section header in the buffer is called +;; "section". +;; +;; For lists a "s" is added to the name of the concepts. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ado + +(defstruct + (rst-Ado + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct a transition. + (:constructor + rst-Ado-new-transition + (&aux + (char nil) + (-style 'transition))) + ;; Construct a simple section header. + (:constructor + rst-Ado-new-simple + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'simple))) + ;; Construct a over-and-under section header. + (:constructor + rst-Ado-new-over-and-under + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'over-and-under))) + ;; Construct from adornment with inverted style. + (:constructor + rst-Ado-new-invert + (ado-arg + &aux + (char (rst-Ado-char ado-arg)) + (-style (let ((sty (rst-Ado--style ado-arg))) + (cond + ((eq sty 'simple) + 'over-and-under) + ((eq sty 'over-and-under) + 'simple) + (sty))))))) + "Representation of a reStructuredText adornment. +Adornments are either section markers where they markup the +section header or transitions. + +This type is immutable." + ;; The character used for the adornment. + (char nil :read-only t) + ;; The style of the adornment. This is a private attribute. + (-style nil :read-only t)) + +;; Private class methods + +(defun rst-Ado--validate-char (char) + ;; testcover: ok. + "Validate CHAR to be a valid adornment character. +Return CHAR if so or signal an error otherwise." + (cond + ((not (characterp char)) + (signal 'wrong-type-argument (list 'characterp char))) + ((memq char rst-adornment-chars) + char) + (t + (signal 'args-out-of-range + (list (format + "Character must be a valid adornment character, not '%s'" + char)))))) + +;; Public methods + +(defun rst-Ado-is-transition (self) + ;; testcover: ok. + "Return non-nil if SELF is a transition adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'transition)) + +(defun rst-Ado-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (not (rst-Ado-is-transition self))) + +(defun rst-Ado-is-simple (self) + ;; testcover: ok. + "Return non-nil if SELF is a simple section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'simple)) + +(defun rst-Ado-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'over-and-under)) + +(defun rst-Ado-equal (self other) + ;; testcover: ok. + "Return non-nil when SELF and OTHER are equal." + (cond + ((not (rst-Ado-p self)) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + ((not (rst-Ado-p other)) + (signal 'wrong-type-argument + (list 'rst-Ado-p other))) + ((not (eq (rst-Ado--style self) (rst-Ado--style other))) + nil) + ((rst-Ado-is-transition self)) + ((equal (rst-Ado-char self) (rst-Ado-char other))))) + +(defun rst-Ado-position (self ados) + ;; testcover: ok. + "Return position of of SELF in ADOS or nil." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (lexical-let ((ado self)) ;; Create closure. + (rst-position-if (function (lambda (e) + (rst-Ado-equal ado e))) + ados))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Hdr + +(defstruct + (rst-Hdr + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Hdr-new + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado nil)))) + ;; Construct while all parameters but `indent' must be valid. + (:constructor + rst-Hdr-new-lax + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + ;; Construct a header with same characteristics but opposite style as `ado'. + (:constructor + rst-Hdr-new-invert + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. + "Representation of reStructuredText section header characteristics. + +This type is immutable." + ;; The adornment of the header. + (ado nil :read-only t) + ;; The indentation of a title text or nil if not given. + (indent nil :read-only t)) + +;; Private class methods + +(defun rst-Hdr--validate-indent (indent ado lax) + ;; testcover: ok. + "Validate INDENT to be a valid indentation for ADO. +Return INDENT if so or signal an error otherwise. If LAX don't +signal an error and return a valid indent." + (cond + ((not (integerp indent)) + (signal 'wrong-type-argument + (list 'integerp 'null indent))) + ((zerop indent) + indent) + ((rst-Ado-is-simple ado) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must be 0 for style simple")))) + ((< indent 0) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must not be negative")))) + (indent))) ;; Implicitly over-and-under. + +(defun rst-Hdr--validate-ado (ado) + ;; testcover: ok. + "Validate ADO to be a valid adornment. +Return ADO if so or signal an error otherwise." + (cond + ((not (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'rst-Ado-p ado))) + ((rst-Ado-is-transition ado) + (signal 'args-out-of-range + '("Adornment for header must not be transition."))) + (t + ado))) + +;; Public class methods + +(defun rst-Hdr-preferred-adornments () + ;; testcover: ok. + "Return preferred adornments as list of `rst-Hdr'." + (mapcar (lambda (el) + (rst-Hdr-new-lax + (if (eq (cadr el) 'over-and-under) + (rst-Ado-new-over-and-under (car el)) + (rst-Ado-new-simple (car el))) + (caddr el))) + rst-preferred-adornments)) + +;; Public methods + +(defun rst-Hdr-member-ado (self hdrs) + ;; testcover: ok. + "Return sublist of HDRS whose car's adornment equals that of SELF or nil." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) + (and pos (nthcdr pos hdrs)))) + +(defun rst-Hdr-ado-map (selves) + ;; testcover: ok. + "Return `rst-Ado' list extracted from elements of SELVES." + (mapcar 'rst-Hdr-ado selves)) + +(defun rst-Hdr-get-char (self) + ;; testcover: ok. + "Return character of the adornment of SELF." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (rst-Ado-char (rst-Hdr-ado self))) + +(defun rst-Hdr-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section header." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (rst-Ado-is-over-and-under (rst-Hdr-ado self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ttl + +(defstruct + (rst-Ttl + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct with valid parameters for all attributes. + (:constructor + rst-Ttl-new + (ado-arg + match-arg + indent-arg + text-arg + &optional + hdr-arg + level-arg + &aux + (ado (rst-Ttl--validate-ado ado-arg)) + (match (rst-Ttl--validate-match match-arg ado)) + (indent (rst-Ttl--validate-indent indent-arg ado)) + (text (rst-Ttl--validate-text text-arg ado)) + (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) + (level (and level-arg (rst-Ttl--validate-level level-arg))))) + (:copier rst-Ttl-copy)) + "Representation of a reStructuredText section header as found in the buffer. +This type gathers information about an adorned part in the +buffer. Thus only the basic attributes are immutable. Although +the remaining attributes are `setf'-able the respective setters +should be used." + ;; The adornment characteristics or nil for a title candidate. + (ado nil :read-only t) + ;; The match-data for `ado' as returned by `match-data'. Match group 0 + ;; matches the whole construct. Match group 1 matches the overline adornment + ;; if present. Match group 2 matches the section title text or the + ;; transition. Match group 3 matches the underline adornment. + (match nil :read-only t) + ;; An indentation found for the title line or nil for a transition. + (indent nil :read-only t) + ;; The text of the title or nil for a transition. + (text nil :read-only t) + ;; The header characteristics if it is a valid section header. + (hdr nil) + ;; The hierarchical level of the section header starting with 0. + (level nil)) + +;; Private class methods + +(defun rst-Ttl--validate-ado (ado) + ;; testcover: ok. + "Return valid ADO or signal error." + (unless (or (null ado) (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'null 'rst-Ado-p ado))) + ado) + +(defun rst-Ttl--validate-match (match ado) + ;; testcover: ok. + "Return valid MATCH matching ADO or signal error." + (unless (listp match) + (signal 'wrong-type-argument + (list 'listp match))) + (unless (equal (length match) 8) + (signal 'args-out-of-range + '("Match data must consist of exactly 8 buffer positions."))) + (mapcar (lambda (pos) + (unless (or (null pos) (integer-or-marker-p pos)) + (signal 'wrong-type-argument + (list 'integer-or-marker-p 'null pos)))) + match) + (unless (and (integer-or-marker-p (nth 0 match)) + (integer-or-marker-p (nth 1 match))) + (signal 'args-out-of-range + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (signal 'args-out-of-range + '("For a title candidate exactly the third match pair must be set.")))) + ((rst-Ado-is-transition ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (integer-or-marker-p (nth 6 match)) + (integer-or-marker-p (nth 7 match))) + (signal 'args-out-of-range + '("For a simple section adornment exactly the third and fourth match pair must be set.")))) + (t ;; over-and-under + (unless (and (integer-or-marker-p (nth 2 match)) + (integer-or-marker-p (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) + (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) + (signal 'args-out-of-range + '("For a over-and-under section adornment all match pairs must be set."))))) + match) + +(defun rst-Ttl--validate-indent (indent ado) + ;; testcover: ok. + "Return valid INDENT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (unless (null indent) + (signal 'args-out-of-range + '("Indent for a transition must be nil."))) + (unless (integerp indent) + (signal 'wrong-type-argument + (list 'integerp indent))) + (unless (>= indent 0) + (signal 'args-out-of-range + '("Indent for a section header must be non-negative.")))) + indent) + +(defun rst-Ttl--validate-hdr (hdr ado indent) + ;; testcover: ok. + "Return valid HDR in relation to ADO and INDENT or signal error." + (unless (rst-Hdr-p hdr) + (signal 'wrong-type-argument + (list 'rst-Hdr-p hdr))) + (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) + (signal 'args-out-of-range + '("Basic adornment and adornment in header must match."))) + (unless (equal (rst-Hdr-indent hdr) indent) + (signal 'args-out-of-range + '("Basic indent and indent in header must match."))) + hdr) + +(defun rst-Ttl--validate-text (text ado) + ;; testcover: ok. + "Return valid TEXT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (unless (null text) + (signal 'args-out-of-range + '("Transitions may not have title text."))) + (unless (stringp text) + (signal 'wrong-type-argument + (list 'stringp text)))) + text) + +(defun rst-Ttl--validate-level (level) + ;; testcover: ok. + "Return valid LEVEL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (unless (>= level 0) + (signal 'args-out-of-range + '("Level must be non-negative."))) + level) + +;; Public methods + +(defun rst-Ttl-evaluate-hdr (self) + ;; testcover: ok. + "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. +Set and return it or nil if no valid `rst-Hdr' can be formed." + (setf (rst-Ttl-hdr self) + (condition-case nil + (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) + (error nil)))) + +(defun rst-Ttl-set-level (self level) + ;; testcover: ok. + "In SELF set and return LEVEL or nil if invalid." + (setf (rst-Ttl-level self) + (rst-Ttl--validate-level level))) + +(defun rst-Ttl-get-title-beginning (self) + ;; testcover: ok. + "Return position of beginning of title text of SELF. +This position should always be at the start of a line." + (nth 4 (rst-Ttl-match self))) + +(defun rst-Ttl-get-beginning (self) + ;; testcover: ok. + "Return position of beginning of whole SELF." + (nth 0 (rst-Ttl-match self))) + +(defun rst-Ttl-get-end (self) + ;; testcover: ok. + "Return position of end of whole SELF." + (nth 1 (rst-Ttl-match self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Stn + +(defstruct + (rst-Stn + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Stn-new + (ttl-arg + level-arg + children-arg + &aux + (ttl (rst-Stn--validate-ttl ttl-arg)) + (level (rst-Stn--validate-level level-arg ttl)) + (children (rst-Stn--validate-children children-arg ttl))))) + "Representation of a section tree node. + +This type is immutable." + ;; The title of the node or nil for a missing node. + (ttl nil :read-only t) + ;; The level of the node in the tree. Negative for the (virtual) top level + ;; node. + (level nil :read-only t) + ;; The list of children of the node. + (children nil :read-only t)) + +;; Private class methods + +(defun rst-Stn--validate-ttl (ttl) + ;; testcover: ok. + "Return valid TTL or signal error." + (unless (or (null ttl) (rst-Ttl-p ttl)) + (signal 'wrong-type-argument + (list 'null 'rst-Ttl-p ttl))) + ttl) + +(defun rst-Stn--validate-level (level ttl) + ;; testcover: ok. + "Return valid LEVEL for TTL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (when ttl + (unless (or (not (rst-Ttl-level ttl)) + (equal (rst-Ttl-level ttl) level)) + (signal 'args-out-of-range + '("A title must have correct level or none at all."))) + (when (< level 0) + ;; testcover: Never reached because a title may not have a negative level + (signal 'args-out-of-range + '("Top level node must not have a title.")))) + level) + +(defun rst-Stn--validate-children (children ttl) + ;; testcover: ok. + "Return valid CHILDREN for TTL or signal error." + (unless (listp children) + (signal 'wrong-type-argument + (list 'listp children))) + (mapcar (lambda (child) + (unless (rst-Stn-p child) + (signal 'wrong-type-argument + (list 'rst-Stn-p child)))) + children) + (unless (or ttl children) + (signal 'args-out-of-range + '("A missing node must have children."))) + children) + +;; Public methods + +(defun rst-Stn-get-title-beginning (self) + ;; testcover: ok. + "Return the beginning of the title of SELF. +Handles missing node properly." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (let ((ttl (rst-Stn-ttl self))) + (if ttl + (rst-Ttl-get-title-beginning ttl) + (rst-Stn-get-title-beginning (car (rst-Stn-children self)))))) + +(defun rst-Stn-get-text (self &optional default) + ;; testcover: ok. + "Return title text of SELF or DEFAULT if SELF is a missing node. +For a missing node and no DEFAULT given return a standard title text." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (let ((ttl (rst-Stn-ttl self))) + (cond + (ttl + (rst-Ttl-text ttl)) + (default) + ("[missing node]")))) + +(defun rst-Stn-is-top (self) + ;; testcover: ok. + "Return non-nil if SELF is a top level node." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (< (rst-Stn-level self) 0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode definition -;; testcover: ok. (defun rst-define-key (keymap key def &rest deprecated) + ;; testcover: ok. "Bind like `define-key' but add deprecated key definitions. KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key definitions should be in vector notation. These are defined @@ -618,7 +1199,7 @@ as well but give an additional message." (if (string-match "^rst-\\(.*\\)$" command-name) (concat "rst-deprecated-" (match-string 1 command-name)) - (error "not an RST command: %s" command-name))) + (error "Not an RST command: %s" command-name))) (forwarder-function (intern forwarder-function-name))) (unless (fboundp forwarder-function) (defalias forwarder-function @@ -633,6 +1214,7 @@ as well but give an additional message." def def))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) + ;; Key bindings. (defvar rst-mode-map (let ((map (make-sparse-keymap))) @@ -645,7 +1227,7 @@ as well but give an additional message." ;; ;; The adjustment function that adorns or rotates a section title. (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t]) - (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on the Mac OSX and + (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on macOS and ; on consoles. ;; \C-c \C-a is the keymap for adornments. @@ -654,9 +1236,9 @@ as well but give an additional message." (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) ;; Display the hierarchy of adornments implied by the current document ;; contents. - (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy) + (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy) ;; Homogenize the adornments in the document. - (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments + (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections [?\C-c ?\C-s]) ;; @@ -818,71 +1400,62 @@ highlighting. :group 'rst ;; Paragraph recognition. - (set (make-local-variable 'paragraph-separate) - (rst-re '(:alt - "\f" - lin-end))) - (set (make-local-variable 'paragraph-start) - (rst-re '(:alt - "\f" - lin-end - (:seq hws-tag par-tag- bli-sfx)))) + (setq-local paragraph-separate + (rst-re '(:alt + "\f" + lin-end))) + (setq-local paragraph-start + (rst-re '(:alt + "\f" + lin-end + (:seq hws-tag par-tag- bli-sfx)))) ;; Indenting and filling. - (set (make-local-variable 'indent-line-function) 'rst-indent-line) - (set (make-local-variable 'adaptive-fill-mode) t) - (set (make-local-variable 'adaptive-fill-regexp) - (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) - (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill) - (set (make-local-variable 'fill-paragraph-handle-comment) nil) + (setq-local indent-line-function 'rst-indent-line) + (setq-local adaptive-fill-mode t) + (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) + (setq-local adaptive-fill-function 'rst-adaptive-fill) + (setq-local fill-paragraph-handle-comment nil) ;; Comments. - (set (make-local-variable 'comment-start) ".. ") - (set (make-local-variable 'comment-start-skip) - (rst-re 'lin-beg 'exm-tag 'bli-sfx)) - (set (make-local-variable 'comment-continue) " ") - (set (make-local-variable 'comment-multi-line) t) - (set (make-local-variable 'comment-use-syntax) nil) + (setq-local comment-start ".. ") + (setq-local comment-start-skip (rst-re 'lin-beg 'exm-tag 'bli-sfx)) + (setq-local comment-continue " ") + (setq-local comment-multi-line t) + (setq-local comment-use-syntax nil) ;; reStructuredText has not really a comment ender but nil is not really a ;; permissible value. - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-end-skip) nil) + (setq-local comment-end "") + (setq-local comment-end-skip nil) ;; Commenting in reStructuredText is very special so use our own set of ;; functions. - (set (make-local-variable 'comment-line-break-function) - 'rst-comment-line-break) - (set (make-local-variable 'comment-indent-function) - 'rst-comment-indent) - (set (make-local-variable 'comment-insert-comment-function) - 'rst-comment-insert-comment) - (set (make-local-variable 'comment-region-function) - 'rst-comment-region) - (set (make-local-variable 'uncomment-region-function) - 'rst-uncomment-region) - - (set (make-local-variable 'electric-pair-pairs) - '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) + (setq-local comment-line-break-function 'rst-comment-line-break) + (setq-local comment-indent-function 'rst-comment-indent) + (setq-local comment-insert-comment-function 'rst-comment-insert-comment) + (setq-local comment-region-function 'rst-comment-region) + (setq-local uncomment-region-function 'rst-uncomment-region) + + (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. - (set (make-local-variable 'imenu-create-index-function) - 'rst-imenu-create-index) + (setq-local imenu-create-index-function 'rst-imenu-create-index) ;; Font lock. - (set (make-local-variable 'font-lock-defaults) - '(rst-font-lock-keywords - t nil nil nil - (font-lock-multiline . t) - (font-lock-mark-block-function . mark-paragraph))) + (setq-local font-lock-defaults + '(rst-font-lock-keywords + t nil nil nil + (font-lock-multiline . t) + (font-lock-mark-block-function . mark-paragraph))) (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) ;; Text after a changed line may need new fontification. - (set (make-local-variable 'jit-lock-contextually) t) + (setq-local jit-lock-contextually t) ;; Indentation is not deterministic. - (setq electric-indent-inhibit t)) + (setq-local electric-indent-inhibit t)) ;;;###autoload (define-minor-mode rst-minor-mode @@ -908,38 +1481,14 @@ for modes derived from Text mode, like Mail mode." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section Adornment Adjustment -;; ============================ -;; +;; Section adornment adjustment + ;; The following functions implement a smart automatic title sectioning feature. ;; The idea is that with the cursor sitting on a section title, we try to get as ;; much information from context and try to do the best thing automatically. ;; This function can be invoked many times and/or with prefix argument to rotate ;; between the various sectioning adornments. ;; -;; Definitions: the two forms of sectioning define semantically separate section -;; levels. A sectioning ADORNMENT consists in: -;; -;; - a CHARACTER -;; -;; - a STYLE which can be either of 'simple' or 'over-and-under'. -;; -;; - an INDENT (meaningful for the over-and-under style only) which determines -;; how many characters and over-and-under style is hanging outside of the -;; title at the beginning and ending. -;; -;; Here are two examples of adornments (| represents the window border, column -;; 0): -;; -;; | -;; 1. char: '-' e |Some Title -;; style: simple |---------- -;; | -;; 2. char: '=' |============== -;; style: over-and-under | Some Title -;; indent: 2 |============== -;; | -;; ;; Some notes: ;; ;; - The underlining character that is used depends on context. The file is @@ -948,7 +1497,7 @@ for modes derived from Text mode, like Mail mode." ;; rotated among the existing section adornments. ;; ;; Note that when rotating the characters, if we come to the end of the -;; hierarchy of adornments, the variable rst-preferred-adornments is +;; hierarchy of adornments, the variable `rst-preferred-adornments' is ;; consulted to propose a new underline adornment, and if continued, we cycle ;; the adornments all over again. Set this variable to nil if you want to ;; limit the underlining character propositions to the existing adornments in @@ -986,6 +1535,8 @@ for modes derived from Text mode, like Mail mode." (define-obsolete-variable-alias 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0") +;; FIXME: Default must match suggestion in +;; http://sphinx-doc.org/rest.html#sections for Python documentation. (defcustom rst-preferred-adornments '((?= over-and-under 1) (?= simple 0) (?- simple 0) @@ -995,13 +1546,10 @@ for modes derived from Text mode, like Mail mode." (?# simple 0) (?@ simple 0)) "Preferred hierarchy of section title adornments. - A list consisting of lists of the form (CHARACTER STYLE INDENT). CHARACTER is the character used. STYLE is one of the symbols `over-and-under' or `simple'. INDENT is an integer giving the -wanted indentation for STYLE `over-and-under'. CHARACTER and -STYLE are always used when a section adornment is described. -In other places, t instead of a list stands for a transition. +wanted indentation for STYLE `over-and-under'. This sequence is consulted to offer a new adornment suggestion when we rotate the underlines at the end of the existing @@ -1025,156 +1573,111 @@ file." :value 0)))) (rst-testcover-defcustom) +;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to +;; 0 because the effect of 1 is probably surprising in the few cases +;; where this is used. +;; FIXME: A matching adornment style can be looked for in +;; `rst-preferred-adornments' and its indentation used before using this +;; variable. (defcustom rst-default-indent 1 "Number of characters to indent the section title. - -This is used for when toggling adornment styles, when switching +This is only used while toggling adornment styles when switching from a simple adornment style to a over-and-under adornment -style." +style. In addition this is used in cases where the adornments +found in the buffer are to be used but the indentation for +over-and-under adornments is inconsistent across the buffer." :group 'rst-adjust :type '(integer)) (rst-testcover-defcustom) -(defun rst-compare-adornments (ado1 ado2) - "Compare adornments. -Return true if both ADO1 and ADO2 adornments are equal, -according to restructured text semantics (only the character -and the style are compared, the indentation does not matter)." - (and (eq (car ado1) (car ado2)) - (eq (cadr ado1) (cadr ado2)))) - - -(defun rst-get-adornment-match (hier ado) - "Return the index (level) in hierarchy HIER of adornment ADO. -This basically just searches for the item using the appropriate -comparison and returns the index. Return nil if the item is -not found." - (let ((cur hier)) - (while (and cur (not (rst-compare-adornments (car cur) ado))) - (setq cur (cdr cur))) - cur)) - -;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test -;; `rst-adjust-no-preference'. -(defun rst-suggest-new-adornment (allados &optional prev) - "Suggest a new, different adornment from all that have been seen. - -ALLADOS is the set of all adornments, including the line numbers. -PREV is the optional previous adornment, in order to suggest a -better match." - - ;; For all the preferred adornments... - (let* ( - ;; If 'prev' is given, reorder the list to start searching after the - ;; match. - (fplist - (cdr (rst-get-adornment-match rst-preferred-adornments prev))) - - ;; List of candidates to search. - (curpotential (append fplist rst-preferred-adornments))) - (while - ;; For all the adornments... - (let ((cur allados) - found) - (while (and cur (not found)) - (if (rst-compare-adornments (car cur) (car curpotential)) - ;; Found it! - (setq found (car curpotential)) - (setq cur (cdr cur)))) - found) - - (setq curpotential (cdr curpotential))) - - (copy-sequence (car curpotential)))) +(defun rst-new-preferred-hdr (seen prev) + ;; testcover: ok. + "Return a new, preferred `rst-Hdr' different from all in SEEN. +PREV is the previous `rst-Hdr' in the buffer. If given the +search starts after this entry. Return nil if no new preferred +`rst-Hdr' can be found." + ;; All preferred adornments are candidates. + (let ((candidates + (append + (if prev + ;; Start searching after the level of the previous adornment. + (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) + (rst-Hdr-preferred-adornments)))) + (car + (rst-member-if (lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates)))) (defun rst-delete-entire-line () "Delete the entire current line without using the `kill-ring'." (delete-region (line-beginning-position) (line-beginning-position 2))) -(defun rst-update-section (char style &optional indent) - "Unconditionally update the style of a section adornment. - -Do this using the given character CHAR, with STYLE `simple' -or `over-and-under', and with indent INDENT. If the STYLE -is `simple', whitespace before the title is removed (indent -is always assumed to be 0). - +(defun rst-update-section (hdr) + "Unconditionally update the style of the section header at point to HDR. If there are existing overline and/or underline from the existing adornment, they are removed before adding the requested adornment." (end-of-line) - (let ((marker (point-marker)) - len) + (let ((indent (or (rst-Hdr-indent hdr) 0)) + (marker (point-marker)) + len) - ;; Fixup whitespace at the beginning and end of the line. - (if (or (null indent) (eq style 'simple)) ;; testcover: ok. - (setq indent 0)) - (beginning-of-line) - (delete-horizontal-space) - (insert (make-string indent ? )) + ;; Fixup whitespace at the beginning and end of the line. + (beginning-of-line) + (delete-horizontal-space) + (insert (make-string indent ? )) - (end-of-line) - (delete-horizontal-space) + (end-of-line) + (delete-horizontal-space) - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) + ;; Set the current column, we're at the end of the title line. + (setq len (+ (current-column) indent)) - ;; Remove previous line if it is an adornment. - (save-excursion - (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line - ;; of buffer. - (if (and (looking-at (rst-re 'ado-beg-2-1)) - ;; Avoid removing the underline of a title right above us. - (save-excursion (forward-line -1) - (not (looking-at (rst-re 'ttl-beg))))) - (rst-delete-entire-line))) - - ;; Remove following line if it is an adornment. + ;; Remove previous line if it is an adornment. + (save-excursion + (forward-line -1) ;; FIXME testcover: Doesn't work when in first line of + ;; buffer. + (if (and (looking-at (rst-re 'ado-beg-2-1)) + ;; Avoid removing the underline of a title right above us. + (save-excursion (forward-line -1) + (not (looking-at (rst-re 'ttl-beg-1))))) + (rst-delete-entire-line))) + + ;; Remove following line if it is an adornment. + (save-excursion + (forward-line +1) ;; FIXME testcover: Doesn't work when in last line + ;; of buffer. + (if (looking-at (rst-re 'ado-beg-2-1)) + (rst-delete-entire-line)) + ;; Add a newline if we're at the end of the buffer unless it is the final + ;; empty line, for the subsequent inserting of the underline. + (if (and (= (point) (buffer-end 1)) (not (bolp))) + (newline 1))) + + ;; Insert overline. + (when (rst-Hdr-is-over-and-under hdr) (save-excursion - (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line - ;; of buffer. - (if (looking-at (rst-re 'ado-beg-2-1)) - (rst-delete-entire-line)) - ;; Add a newline if we're at the end of the buffer, for the subsequence - ;; inserting of the underline. - (if (= (point) (buffer-end 1)) - (newline 1))) - - ;; Insert overline. - (if (eq style 'over-and-under) - (save-excursion - (beginning-of-line) - (open-line 1) - (insert (make-string len char)))) - - ;; Insert underline. - (1value ;; Line has been inserted above. - (forward-line +1)) - (open-line 1) - (insert (make-string len char)) - - (1value ;; Line has been inserted above. - (forward-line +1)) - (goto-char marker))) + (beginning-of-line) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))))) + + ;; Insert underline. + (1value ;; Line has been inserted above. + (forward-line +1)) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))) + + (1value ;; Line has been inserted above. + (forward-line +1)) + (goto-char marker))) (defun rst-classify-adornment (adornment end) - "Classify adornment for section titles and transitions. + "Classify adornment string for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer with optional trailing whitespace. END is the point after the -last character of ADORNMENT. - -Return a list. The first entry is t for a transition or a -cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for -the meaning of CHARACTER and STYLE. - -The remaining list forms four match groups as returned by -`match-data'. Match group 0 matches the whole construct. Match -group 1 matches the overline adornment if present. Match group 2 -matches the section title text or the transition. Match group 3 -matches the underline adornment. - -Return nil if no syntactically valid adornment is found." +last character of ADORNMENT. Return a `rst-Ttl' or nil if no +syntactically valid adornment is found." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) @@ -1189,31 +1692,35 @@ Return nil if no syntactically valid adornment is found." (nxt-emp ; Next line nonexistent or empty (save-excursion (or (not (zerop (forward-line 1))) - ;; testcover: FIXME: Add test classifying at the end of - ;; buffer. + ;; FIXME testcover: Add test classifying at the end of + ;; buffer. (looking-at (rst-re 'lin-end))))) (prv-emp ; Previous line nonexistent or empty (save-excursion (or (not (zerop (forward-line -1))) (looking-at (rst-re 'lin-end))))) + txt-blw (ttl-blw ; Title found below starting here. (save-excursion (and - (zerop (forward-line 1)) ;; testcover: FIXME: Add test + (zerop (forward-line 1)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. - (looking-at (rst-re 'ttl-beg)) + (looking-at (rst-re 'ttl-beg-1)) + (setq txt-blw (match-string-no-properties 1)) (point)))) + txt-abv (ttl-abv ; Title found above starting here. (save-excursion (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg)) + (looking-at (rst-re 'ttl-beg-1)) + (setq txt-abv (match-string-no-properties 1)) (point)))) (und-fnd ; Matching underline found starting here. (save-excursion (and ttl-blw - (zerop (forward-line 2)) ;; testcover: FIXME: Add test + (zerop (forward-line 2)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. (looking-at (rst-re ado-re 'lin-end)) @@ -1224,16 +1731,16 @@ Return nil if no syntactically valid adornment is found." (zerop (forward-line -2)) (looking-at (rst-re ado-re 'lin-end)) (point)))) - key beg-ovr end-ovr beg-txt end-txt beg-und end-und) + ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq key t + (setq ado (rst-Ado-new-transition) beg-txt beg-pnt end-txt end-pnt)) ((or und-fnd ovr-fnd) ;; An overline with an underline. - (setq key (cons ado-ch 'over-and-under)) + (setq ado (rst-Ado-new-over-and-under ado-ch)) (let (;; Prefer overline match over underline match. (und-pnt (if ovr-fnd beg-pnt und-fnd)) (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) @@ -1243,41 +1750,40 @@ Return nil if no syntactically valid adornment is found." end-ovr (line-end-position)) (goto-char txt-pnt) (setq beg-txt (point) - end-txt (line-end-position)) + end-txt (line-end-position) + ind (current-indentation) + txt (if ovr-fnd txt-abv txt-blw)) (goto-char und-pnt) (setq beg-und (point) end-und (line-end-position)))) (ttl-abv ;; An underline. - (setq key (cons ado-ch 'simple) + (setq ado (rst-Ado-new-simple ado-ch) beg-und beg-pnt end-und end-pnt) (goto-char ttl-abv) (setq beg-txt (point) - end-txt (line-end-position))) + end-txt (line-end-position) + ind (current-indentation) + txt txt-abv)) (t ;; Invalid adornment. - (setq key nil))) - (if key - (list key - (or beg-ovr beg-txt) - (or end-und end-txt) - beg-ovr end-ovr beg-txt end-txt beg-und end-und))))))) - -(defun rst-find-title-line () + (setq ado nil))) + (if ado + (rst-Ttl-new ado + (list + (or beg-ovr beg-txt) + (or end-und end-txt) + beg-ovr end-ovr beg-txt end-txt beg-und end-und) + ind txt))))))) + +(defun rst-ttl-at-point () "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title line. If the point is on an empty line check previous or next line whether it is a suitable title line and use it if so. If -point is on a suitable title line use it. - -If no title line is found return nil. - -Otherwise return as `rst-classify-adornment' does. However, if -the title line has no syntactically valid adornment, STYLE is nil -in the first element. If there is no adornment around the title, -CHARACTER is also nil and match groups for overline and underline -are nil." +point is on a suitable title line use it. Return a `rst-Ttl' for +a section header or nil if no title line is found." (save-excursion (1value ;; No lines may be left to move. (forward-line 0)) @@ -1285,225 +1791,258 @@ are nil." (orig-end (line-end-position))) (cond ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. (let ((char (string-to-char (match-string-no-properties 2))) (r (rst-classify-adornment (match-string-no-properties 0) (match-end 0)))) (cond ((not r) - ;; Invalid adornment - check whether this is an incomplete overline. + ;; Invalid adornment - check whether this is an overline with + ;; missing underline. (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons char nil) orig-pnt (line-end-position) - orig-pnt orig-end (point) (line-end-position) nil nil))) - ((consp (car r)) - ;; A section title - not a transition. - r)))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new (rst-Ado-new-over-and-under char) + (list orig-pnt (line-end-position) + orig-pnt orig-end + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) + ((rst-Ado-is-transition (rst-Ttl-ado r)) + nil) + ;; Return any other classification as is. + (r)))) ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. (or (save-excursion (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) (save-excursion (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))))) - ((looking-at (rst-re 'ttl-beg)) - ;; Try to use the underline. - (let ((r (rst-classify-adornment - (buffer-substring-no-properties - (line-beginning-position 2) (line-end-position 2)) - (line-end-position 2)))) - (if r - r - ;; No valid adornment found. - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil)))))))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (let ((txt (match-string-no-properties 1))) + (or (rst-classify-adornment + (buffer-substring-no-properties + (line-beginning-position 2) (line-end-position 2)) + (line-end-position 2)) + ;; No valid adornment found. + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + txt)))))))) ;; The following function and variables are used to maintain information about ;; current section adornment in a buffer local cache. Thus they can be used for ;; font-locking and manipulation commands. -(defvar rst-all-sections nil - "All section adornments in the buffer as found by `rst-find-all-adornments'. +(defvar rst-all-ttls-cache nil + "All section adornments in the buffer as found by `rst-all-ttls'. Set to t when no section adornments were found.") -(make-variable-buffer-local 'rst-all-sections) +(make-variable-buffer-local 'rst-all-ttls-cache) ;; FIXME: If this variable is set to a different value font-locking of section ;; headers is wrong. -(defvar rst-section-hierarchy nil - "Section hierarchy in the buffer as determined by `rst-get-hierarchy'. +(defvar rst-hdr-hierarchy-cache nil + "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. Set to t when no section adornments were found. -Value depends on `rst-all-sections'.") -(make-variable-buffer-local 'rst-section-hierarchy) +Value depends on `rst-all-ttls-cache'.") +(make-variable-buffer-local 'rst-hdr-hierarchy-cache) (rst-testcover-add-1value 'rst-reset-section-caches) (defun rst-reset-section-caches () "Reset all section cache variables. Should be called by interactive functions which deal with sections." - (setq rst-all-sections nil - rst-section-hierarchy nil)) + (setq rst-all-ttls-cache nil + rst-hdr-hierarchy-cache nil)) -(defun rst-find-all-adornments () +(defun rst-all-ttls () "Return all the section adornments in the current buffer. -Return a list of (LINE . ADORNMENT) with ascending LINE where -LINE is the line containing the section title. ADORNMENT consists -of a (CHARACTER STYLE INDENT) triple as described for -`rst-preferred-adornments'. +Return a list of `rst-Ttl' with ascending line number. -Uses and sets `rst-all-sections'." - (unless rst-all-sections +Uses and sets `rst-all-ttls-cache'." + (unless rst-all-ttls-cache (let (positions) ;; Iterate over all the section titles/adornments in the file. (save-excursion - (goto-char (point-min)) - (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) - (let ((ado-data (rst-classify-adornment - (match-string-no-properties 0) (point)))) - (when (and ado-data - (consp (car ado-data))) ; Ignore transitions. - (set-match-data (cdr ado-data)) - (goto-char (match-beginning 2)) ; Goto the title start. - (push (cons (1+ (count-lines (point-min) (point))) - (list (caar ado-data) - (cdar ado-data) - (current-indentation))) - positions) - (goto-char (match-end 0))))) ; Go beyond the whole thing. - (setq positions (nreverse positions)) - (setq rst-all-sections (or positions t))))) - (if (eq rst-all-sections t) + (save-match-data + (goto-char (point-min)) + (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) + (let ((ttl (rst-classify-adornment + (match-string-no-properties 0) (point)))) + (when (and ttl (rst-Ado-is-section (rst-Ttl-ado ttl))) + (when (rst-Ttl-evaluate-hdr ttl) + (push ttl positions)) + (goto-char (rst-Ttl-get-end ttl))))) + (setq positions (nreverse positions)) + (setq rst-all-ttls-cache (or positions t)))))) + (if (eq rst-all-ttls-cache t) nil - rst-all-sections)) - -(defun rst-infer-hierarchy (adornments) - "Build a hierarchy of adornments using the list of given ADORNMENTS. - -ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment -specifications, in order that they appear in a file, and will -infer a hierarchy of section levels by removing adornments that -have already been seen in a forward traversal of the adornments, -comparing just CHARACTER and STYLE. - -Similarly returns a list of (CHARACTER STYLE INDENT), where each -list element should be unique." - (let (hierarchy-alist) - (dolist (x adornments) - (let ((char (car x)) - (style (cadr x))) - (unless (assoc (cons char style) hierarchy-alist) - (push (cons (cons char style) x) hierarchy-alist)))) - (mapcar 'cdr (nreverse hierarchy-alist)))) - -(defun rst-get-hierarchy (&optional ignore) - "Return the hierarchy of section titles in the file. - -Return a list of adornments that represents the hierarchy of -section titles in the file. Each element consists of (CHARACTER -STYLE INDENT) as described for `rst-find-all-adornments'. If the -line number in IGNORE is specified, a possibly adornment found on -that line is not taken into account when building the hierarchy. - -Uses and sets `rst-section-hierarchy' unless IGNORE is given." - (if (and (not ignore) rst-section-hierarchy) - (if (eq rst-section-hierarchy t) - nil - rst-section-hierarchy) - (let ((r (rst-infer-hierarchy - (mapcar 'cdr - (assq-delete-all - ignore - (rst-find-all-adornments)))))) - (setq rst-section-hierarchy - (if ignore - ;; Clear cache reflecting that a possible update is not - ;; reflected. - nil - (or r t))) - r))) - -(defun rst-get-adornments-around () - "Return the adornments around point. -Return a list of the previous and next adornments." - (let* ((all (rst-find-all-adornments)) - (curline (line-number-at-pos)) - prev next - (cur all)) + (mapcar 'rst-Ttl-copy rst-all-ttls-cache))) + +(defun rst-infer-hdr-hierarchy (hdrs) + "Build a hierarchy from HDRS. +HDRS reflects the order in which the headers appear in the +buffer. Return a `rst-Hdr' list representing the hierarchy of +headers in the buffer. Indentation is unified." + (let (ado2indents) + (dolist (hdr hdrs) + (let* ((ado (rst-Hdr-ado hdr)) + (indent (rst-Hdr-indent hdr)) + (found (assoc ado ado2indents))) + (if found + (unless (member indent (cdr found)) + ;; Append newly found indent. + (setcdr found (append (cdr found) (list indent)))) + (push (list ado indent) ado2indents)))) + (mapcar (lambda (ado_indents) + (let ((ado (car ado_indents)) + (indents (cdr ado_indents))) + (rst-Hdr-new + ado + (if (> (length indents) 1) + ;; Indentations used inconsistently - use default. + rst-default-indent + ;; Only one indentation used - use this. + (car indents))))) + (nreverse ado2indents)))) + +(defun rst-hdr-hierarchy (&optional ignore-current) + "Return the hierarchy of section titles in the file as a `rst-Hdr' list. +Each returned element may be used directly to create a section +adornment on that level. If IGNORE-CURRENT a title found on the +current line is not taken into account when building the +hierarchy unless it appears again elsewhere. This catches cases +where the current title is edited and may not be final regarding +its level. + +Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-CURRENT is +given." + (let* ((all-ttls (rst-all-ttls)) + (ignore-position (if ignore-current + (line-beginning-position))) + (ignore-ttl + (if ignore-position + (car (member-if + (lambda (ttl) + (equal ignore-position (rst-Ttl-get-title-beginning ttl))) + all-ttls)))) + (really-ignore + (if ignore-ttl + (<= (count-if + (lambda (ttl) + (rst-Ado-equal (rst-Ttl-ado ignore-ttl) (rst-Ttl-ado ttl))) + all-ttls) + 1))) + (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) + (mapcar ;; Protect cache. + 'rst-Hdr-copy + (if (and (not ignore-current) rst-hdr-hierarchy-cache) + (if (eq rst-hdr-hierarchy-cache t) + nil + rst-hdr-hierarchy-cache) + (let ((r (rst-infer-hdr-hierarchy (mapcar 'rst-Ttl-hdr real-ttls)))) + (setq rst-hdr-hierarchy-cache + (if ignore-current + ;; Clear cache reflecting that a possible update is not + ;; reflected. + nil + (or r t))) + r))))) + +(defun rst-all-ttls-with-level () + "Return the section adornments with levels set according to hierarchy. +Return a list of `rst-Ttl' with ascending line number." + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (mapcar + (lambda (ttl) + (rst-Ttl-set-level ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)) + ttl) + (rst-all-ttls)))) + +(defun rst-get-previous-hdr () + "Return the `rst-Hdr' before point or nil if none." + (let ((ttls (rst-all-ttls)) + (curpos (line-beginning-position)) + prev) ;; Search for the adornments around the current line. - (while (and cur (< (caar cur) curline)) - (setq prev cur - cur (cdr cur))) - ;; 'cur' is the following adornment. - - (if (and cur (caar cur)) - (setq next (if (= curline (caar cur)) (cdr cur) cur))) - - (mapcar 'cdar (list prev next)))) - -(defun rst-adornment-complete-p (ado) - "Return true if the adornment ADO around point is complete." + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) curpos)) + (setq prev (car ttls) + ttls (cdr ttls))) + (and prev (rst-Ttl-hdr prev)))) + +(defun rst-adornment-complete-p (ado indent) + "Return true if the adornment ADO around point is complete using INDENT. +The adornment is complete if it is a completely correct +reStructuredText adornment for the title line at point. This +includes indentation and correct length of adornment lines." ;; Note: we assume that the detection of the overline as being the underline ;; of a preceding title has already been detected, and has been eliminated ;; from the adornment that is given to us. - - ;; There is some sectioning already present, so check if the current - ;; sectioning is complete and correct. - (let* ((char (car ado)) - (style (cadr ado)) - (indent (caddr ado)) - (endcol (save-excursion (end-of-line) (current-column)))) - (if char - (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$"))) - (and - (save-excursion (forward-line +1) - (beginning-of-line) - (looking-at exps)) - (or (not (eq style 'over-and-under)) - (save-excursion (forward-line -1) - (beginning-of-line) - (looking-at exps)))))))) - - -(defun rst-get-next-adornment - (curado hier &optional suggestion reverse-direction) - "Get the next adornment for CURADO, in given hierarchy HIER. -If suggesting, suggest for new adornment SUGGESTION. -REVERSE-DIRECTION is used to reverse the cycling order." - - (let* ( - (char (car curado)) - (style (cadr curado)) - - ;; Build a new list of adornments for the rotation. - (rotados - (append hier - ;; Suggest a new adornment. - (list suggestion - ;; If nothing to suggest, use first adornment. - (car hier)))) ) + (let ((exps (rst-re "^" (rst-Ado-char ado) + (format "\\{%d\\}" + (+ (save-excursion + ;; Determine last column of title. + (end-of-line) + (current-column)) + indent)) "$"))) + (and + (save-excursion (forward-line +1) + (looking-at exps)) + (or (rst-Ado-is-simple ado) + (save-excursion (forward-line -1) + (looking-at exps)))))) + +(defun rst-next-hdr (hdr hier prev down) + ;; testcover: ok. + "Return the next best `rst-Hdr' upward from HDR. +Consider existing hierarchy HIER and preferred headers. PREV may +be a previous `rst-Hdr' which may be taken into account. If DOWN +return the next best `rst-Hdr' downward instead. Return nil in +HIER is nil." + (let* ((normalized-hier (if down + hier + (reverse hier))) + (fnd (rst-Hdr-member-ado hdr normalized-hier)) + (prev-fnd (and prev (rst-Hdr-member-ado prev normalized-hier)))) (or - ;; Search for next adornment. - (cadr - (let ((cur (if reverse-direction rotados - (reverse rotados)))) - (while (and cur - (not (and (eq char (caar cur)) - (eq style (cadar cur))))) - (setq cur (cdr cur))) - cur)) - - ;; If not found, take the first of all adornments. - suggestion))) - + ;; Next entry in existing hierarchy if it exists. + (cadr fnd) + (if fnd + ;; If current header is found try introducing a new one from preferred + ;; hierarchy. + (rst-new-preferred-hdr hier prev) + ;; If not found try using previous header. + (if down + (cadr prev-fnd) + (car prev-fnd))) + ;; All failed - rotate by using first from normalized existing hierarchy. + (car normalized-hier)))) ;; FIXME: A line "``/`` full" is not accepted as a section title. (defun rst-adjust (pfxarg) "Auto-adjust the adornment around point. - Adjust/rotate the section adornment for the section title around point or promote/demote the adornments inside the region, depending on whether the region is active. This function is meant @@ -1516,12 +2055,9 @@ the adornments of a section title in reStructuredText. It tries to deal with all the possible cases gracefully and to do \"the right thing\" in all cases. -See the documentations of `rst-adjust-adornment-work' and +See the documentations of `rst-adjust-section' and `rst-promote-region' for full details. -Prefix Arguments -================ - The method can take either (but not both) of a. a (non-negative) prefix argument, which means to toggle the @@ -1542,11 +2078,15 @@ b. a negative numerical argument, which generally inverts the ;; Adjust adornments within region. (rst-promote-region (and pfxarg t)) ;; Adjust adornment around point. - (rst-adjust-adornment-work toggle-style reverse-direction)) + (let ((msg (rst-adjust-section toggle-style reverse-direction))) + (when msg + (apply 'message msg)))) ;; Run the hooks to run after adjusting. (run-hooks 'rst-adjust-hook) + (rst-reset-section-caches) + ;; Make sure to reset the cursor position properly after we're done. (goto-char origpt))) @@ -1567,31 +2107,23 @@ b. a negative numerical argument, which generally inverts the (rst-testcover-defcustom) (defun rst-adjust-adornment (pfxarg) - "Call `rst-adjust-adornment-work' interactively. - + "Call `rst-adjust-section' interactively. Keep this for compatibility for older bindings (are there any?). Argument PFXARG has the same meaning as for `rst-adjust'." (interactive "P") (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) (toggle-style (and pfxarg (not reverse-direction)))) - (rst-adjust-adornment-work toggle-style reverse-direction))) + (rst-adjust-section toggle-style reverse-direction))) -(defun rst-adjust-adornment-work (toggle-style reverse-direction) +(defun rst-adjust-section (toggle-style reverse) "Adjust/rotate the section adornment for the section title around point. +The action this function takes depends on context around the +point, and it is meant to be invoked possibly more than once to +rotate among the various possibilities. Basically, this function +deals with: -This function is meant to be invoked possibly multiple times, and -can vary its behavior with a true TOGGLE-STYLE argument, or with -a REVERSE-DIRECTION argument. - -General Behavior -================ - -The next action it takes depends on context around the point, and -it is meant to be invoked possibly more than once to rotate among -the various possibilities. Basically, this function deals with: - -- adding a adornment if the title does not have one; +- adding an adornment if the title does not have one; - adjusting the length of the underline characters to fit a modified title; @@ -1599,316 +2131,242 @@ the various possibilities. Basically, this function deals with: - rotating the adornment in the set of already existing sectioning adornments used in the file; -- switching between simple and over-and-under styles. - -You should normally not have to read all the following, just -invoke the method and it will do the most obvious thing that you -would expect. - - -Adornment Definitions -===================== - -The adornments consist in - -1. a CHARACTER - -2. a STYLE which can be either `simple' or `over-and-under'. - -3. an INDENT (meaningful for the over-and-under style only) - which determines how many characters and over-and-under - style is hanging outside of the title at the beginning and - ending. - -See source code for mode details. - - -Detailed Behavior Description -============================= - -Here are the gory details of the algorithm (it seems quite -complicated, but really, it does the most obvious thing in all -the particular cases): - -Before applying the adornment change, the cursor is placed on -the closest line that could contain a section title. - -Case 1: No Adornment --------------------- - -If the current line has no adornment around it, - -- search backwards for the last previous adornment, and apply - the adornment one level lower to the current line. If there - is no defined level below this previous adornment, we suggest - the most appropriate of the `rst-preferred-adornments'. - - If REVERSE-DIRECTION is true, we simply use the previous - adornment found directly. +- switching between simple and over-and-under styles by giving + TOGGLE-STYLE. -- if there is no adornment found in the given direction, we use - the first of `rst-preferred-adornments'. +Return nil if the function did something. If the function were +not able to do something return an argument list for `message' to +inform the user about what failed. -TOGGLE-STYLE forces a toggle of the prescribed adornment style. +The following is a detailed description but you should normally +not have to read it. -Case 2: Incomplete Adornment ----------------------------- +Before applying the adornment change, the cursor is placed on the +closest line that could contain a section title if such is found +around the cursor. Then the following cases are distinguished. -If the current line does have an existing adornment, but the -adornment is incomplete, that is, the underline/overline does -not extend to exactly the end of the title line (it is either -too short or too long), we simply extend the length of the -underlines/overlines to fit exactly the section title. +* Case 1: No Adornment -If TOGGLE-STYLE we toggle the style of the adornment as well. + If the current line has no adornment around it, -REVERSE-DIRECTION has no effect in this case. + - search for a previous adornment, and apply this adornment (unless + `rst-new-adornment-down') or one level lower (otherwise) to the current + line. If there is no defined level below this previous adornment, we + suggest the most appropriate of the `rst-preferred-adornments'. -Case 3: Complete Existing Adornment ------------------------------------ + If REVERSE is true, we simply use the previous adornment found + directly. -If the adornment is complete (i.e. the underline (overline) -length is already adjusted to the end of the title line), we -search/parse the file to establish the hierarchy of all the -adornments (making sure not to include the adornment around -point), and we rotate the current title's adornment from within -that list (by default, going *down* the hierarchy that is present -in the file, i.e. to a lower section level). This is meant to be -used potentially multiple times, until the desired adornment is -found around the title. + - if there is no adornment found in the given direction, we use the first of + `rst-preferred-adornments'. -If we hit the boundary of the hierarchy, exactly one choice from -the list of preferred adornments is suggested/chosen, the first -of those adornment that has not been seen in the file yet (and -not including the adornment around point), and the next -invocation rolls over to the other end of the hierarchy (i.e. it -cycles). This allows you to avoid having to set which character -to use. + TOGGLE-STYLE forces a toggle of the prescribed adornment style. -If REVERSE-DIRECTION is true, the effect is to change the -direction of rotation in the hierarchy of adornments, thus -instead going *up* the hierarchy. +* Case 2: Incomplete Adornment -However, if TOGGLE-STYLE, we do not rotate the adornment, but -instead simply toggle the style of the current adornment (this -should be the most common way to toggle the style of an existing -complete adornment). + If the current line does have an existing adornment, but the adornment is + incomplete, that is, the underline/overline does not extend to exactly the + end of the title line (it is either too short or too long), we simply extend + the length of the underlines/overlines to fit exactly the section title. + If TOGGLE-STYLE we toggle the style of the adornment as well. -Point Location -============== + REVERSE has no effect in this case. -The invocation of this function can be carried out anywhere -within the section title line, on an existing underline or -overline, as well as on an empty line following a section title. -This is meant to be as convenient as possible. +* Case 3: Complete Existing Adornment + If the adornment is complete (i.e. the underline (overline) length is already + adjusted to the end of the title line), we rotate the current title's + adornment according to the adornment hierarchy found in the buffer. This is + meant to be used potentially multiple times, until the desired adornment is + found around the title. -Indented Sections -================= + If we hit the boundary of the hierarchy, exactly one choice from the list of + preferred adornments is suggested/chosen, the first of those adornment that + has not been seen in the buffer yet, and the next invocation rolls over to + the other end of the hierarchy (i.e. it cycles). -Indented section titles such as :: + If REVERSE is we go up in the hierarchy. Otherwise we go down. - My Title - -------- - -are invalid in reStructuredText and thus not recognized by the -parser. This code will thus not work in a way that would support -indented sections (it would be ambiguous anyway). - - -Joint Sections -============== - -Section titles that are right next to each other may not be -treated well. More work might be needed to support those, and -special conditions on the completeness of existing adornments -might be required to make it non-ambiguous. - -For now we assume that the adornments are disjoint, that is, -there is at least a single line between the titles/adornment -lines." + However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply + toggle the style of the current adornment." (rst-reset-section-caches) - (let ((ttl-fnd (rst-find-title-line)) - (orig-pnt (point))) - (when ttl-fnd - (set-match-data (cdr ttl-fnd)) - (goto-char (match-beginning 2)) - (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) - (char (caar ttl-fnd)) - (style (cdar ttl-fnd)) - (indent (current-indentation)) - (curado (list char style indent)) - char-new style-new indent-new) - (cond - ;;------------------------------------------------------------------- - ;; Case 1: No valid adornment - ((not style) - (let ((prev (car (rst-get-adornments-around))) - cur - (hier (rst-get-hierarchy))) - ;; Advance one level down. - (setq cur + (let ((ttl (rst-ttl-at-point)) + (orig-pnt (point)) + msg) + (if (not ttl) + (setq msg '("No section header or candidate at point")) + (goto-char (rst-Ttl-get-title-beginning ttl)) + (let ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) + (found (rst-Ttl-ado ttl)) + (indent (rst-Ttl-indent ttl)) + (prev (rst-get-previous-hdr)) + new) + (when (and found (not (rst-Ado-p found))) + ;; Normalize found adornment - overline with no underline counts as + ;; overline. + (setq found (rst-Ado-new-over-and-under found))) + (setq new + (cond + ((not found) + ;; Case 1: No adornment at all. + (let ((hier (rst-hdr-hierarchy))) (if prev - (if (or (and rst-new-adornment-down reverse-direction) - (and (not rst-new-adornment-down) - (not reverse-direction))) - prev - (or (cadr (rst-get-adornment-match hier prev)) - (rst-suggest-new-adornment hier prev))) - (copy-sequence (car rst-preferred-adornments)))) - ;; Invert the style if requested. - (if toggle-style - (setcar (cdr cur) (if (eq (cadr cur) 'simple) - 'over-and-under 'simple)) ) - (setq char-new (car cur) - style-new (cadr cur) - indent-new (caddr cur)))) - ;;------------------------------------------------------------------- - ;; Case 2: Incomplete Adornment - ((not (rst-adornment-complete-p curado)) - ;; Invert the style if requested. - (if toggle-style - (setq style (if (eq style 'simple) 'over-and-under 'simple))) - (setq char-new char - style-new style - indent-new indent)) - ;;------------------------------------------------------------------- - ;; Case 3: Complete Existing Adornment - (t - (if toggle-style - ;; Simply switch the style of the current adornment. - (setq char-new char - style-new (if (eq style 'simple) 'over-and-under 'simple) - indent-new rst-default-indent) - ;; Else, we rotate, ignoring the adornment around the current - ;; line... - (let* ((hier (rst-get-hierarchy (line-number-at-pos))) - ;; Suggestion, in case we need to come up with something new. - (suggestion (rst-suggest-new-adornment - hier - (car (rst-get-adornments-around)))) - (nextado (rst-get-next-adornment - curado hier suggestion reverse-direction))) - ;; Indent, if present, always overrides the prescribed indent. - (setq char-new (car nextado) - style-new (cadr nextado) - indent-new (caddr nextado)))))) - ;; Override indent with present indent! - (setq indent-new (if (> indent 0) indent indent-new)) - (if (and char-new style-new) - (rst-update-section char-new style-new indent-new)) - ;; Correct the position of the cursor to more accurately reflect where - ;; it was located when the function was invoked. - (unless (zerop moved) - (forward-line (- moved)) - (end-of-line)))))) + ;; Previous header exists - use it. + (cond + ;; Customization and parameters require that the + ;; previous level is used - use it as is. + ((or (and rst-new-adornment-down reverse) + (and (not rst-new-adornment-down) (not reverse))) + prev) + ;; Advance one level down. + ((rst-next-hdr prev hier prev t)) + (t + (setq msg '("Neither hierarchy nor preferences can suggest a deeper header")) + nil)) + ;; First header in the buffer - use the first adornment + ;; from preferences or hierarchy. + (let ((p (car (rst-Hdr-preferred-adornments))) + (h (car hier))) + (cond + ((if reverse + ;; Prefer hierarchy for downwards + (or h p) + ;; Prefer preferences for upwards + (or p h))) + (t + (setq msg '("No preferences to suggest a top level from")) + nil)))))) + ((not (rst-adornment-complete-p found indent)) + ;; Case 2: Incomplete adornment. + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax found indent)) + ;; Case 3: Complete adornment exists from here on. + (toggle-style + ;; Simply switch the style of the current adornment. + (setq toggle-style nil) ;; Remember toggling has been done. + (rst-Hdr-new-invert found rst-default-indent)) + (t + ;; Rotate, ignoring a sole adornment around the current line. + (let ((hier (rst-hdr-hierarchy t))) + (cond + ;; Next header can be determined from hierarchy or + ;; preferences. + ((rst-next-hdr + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax found indent) hier prev reverse)) + ;; No next header found. + (t + (setq msg '("No preferences or hierarchy to suggest another level from")) + nil)))))) + (if (not new) + (goto-char orig-pnt) + (when toggle-style + (setq new (rst-Hdr-new-invert (rst-Hdr-ado new) indent))) + ;; Override indent with present indent if there is some. + (when (> indent 0) + ;; Use lax since existing indent may not be valid for new style. + (setq new (rst-Hdr-new-lax (rst-Hdr-ado new) indent))) + (rst-update-section new) + ;; Correct the position of the cursor to more accurately reflect where + ;; it was located when the function was invoked. + (unless (zerop moved) + (forward-line (- moved)) + (end-of-line))))) + msg)) ;; Maintain an alias for compatibility. (defalias 'rst-adjust-section-title 'rst-adjust) - (defun rst-promote-region (demote) "Promote the section titles within the region. - With argument DEMOTE or a prefix argument, demote the section titles instead. The algorithm used at the boundaries of the -hierarchy is similar to that used by `rst-adjust-adornment-work'." +hierarchy is similar to that used by `rst-adjust-section'." (interactive "P") (rst-reset-section-caches) - (let* ((cur (rst-find-all-adornments)) - (hier (rst-get-hierarchy)) - (suggestion (rst-suggest-new-adornment hier)) - - (region-begin-line (line-number-at-pos (region-beginning))) - (region-end-line (line-number-at-pos (region-end))) - - marker-list) + (let ((ttls (rst-all-ttls)) + (hier (rst-hdr-hierarchy)) + (region-beg (save-excursion + (goto-char (region-beginning)) + (line-beginning-position))) + (region-end (save-excursion + (goto-char (region-end)) + (line-beginning-position))) + marker-list) ;; Skip the markers that come before the region beginning. - (while (and cur (< (caar cur) region-begin-line)) - (setq cur (cdr cur))) + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-beg)) + (setq ttls (cdr ttls))) ;; Create a list of markers for all the adornments which are found within ;; the region. (save-excursion - (let (line) - (while (and cur (< (setq line (caar cur)) region-end-line)) - (goto-char (point-min)) - (forward-line (1- line)) - (push (list (point-marker) (cdar cur)) marker-list) - (setq cur (cdr cur)) )) + (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-end)) + (push (cons (copy-marker (rst-Ttl-get-title-beginning (car ttls))) + (rst-Ttl-hdr (car ttls))) marker-list) + (setq ttls (cdr ttls))) ;; Apply modifications. (dolist (p marker-list) ;; Go to the adornment to promote. (goto-char (car p)) - - ;; Update the adornment. - (apply 'rst-update-section - ;; Rotate the next adornment. - (rst-get-next-adornment - (cadr p) hier suggestion demote)) + ;; `rst-next-hdr' cannot return nil because we apply to a section + ;; header so there is some hierarchy. + (rst-update-section (rst-next-hdr (cdr p) hier nil demote)) ;; Clear marker to avoid slowing down the editing after we're done. (set-marker (car p) nil)) (setq deactivate-mark nil)))) - - -(defun rst-display-adornments-hierarchy (&optional adornments) +(defun rst-display-hdr-hierarchy () "Display the current file's section title adornments hierarchy. -This function expects a list of (CHARACTER STYLE INDENT) triples -in ADORNMENTS." +Hierarchy is displayed in a temporary buffer." (interactive) (rst-reset-section-caches) - (if (not adornments) - (setq adornments (rst-get-hierarchy))) - (with-output-to-temp-buffer "*rest section hierarchy*" - (let ((level 1)) + (let ((hdrs (rst-hdr-hierarchy)) + (level 1)) + (with-output-to-temp-buffer "*rest section hierarchy*" (with-current-buffer standard-output - (dolist (x adornments) - (insert (format "\nSection Level %d" level)) - (apply 'rst-update-section x) - (goto-char (point-max)) - (insert "\n") - (incf level)))))) - -(defun rst-straighten-adornments () - "Redo all the adornments in the current buffer. -This is done using our preferred set of adornments. This can be + (dolist (hdr hdrs) + (insert (format "\nSection Level %d" level)) + (rst-update-section hdr) + (goto-char (point-max)) + (insert "\n") + (incf level)))))) + +;; Maintain an alias for backward compatibility. +(defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) + +;; FIXME: Should accept an argument giving the hierarchy level to start with +;; instead of the top of the hierarchy. +(defun rst-straighten-sections () + "Redo the adornments of all section titles in the current buffer. +This is done using the preferred set of adornments. This can be used, for example, when using somebody else's copy of a document, in order to adapt it to our preferred style." (interactive) (rst-reset-section-caches) (save-excursion - (let (;; Get a list of pairs of (level . marker). - (levels-and-markers (mapcar - (lambda (ado) - (cons (rst-position (cdr ado) - (rst-get-hierarchy)) - (progn - (goto-char (point-min)) - (forward-line (1- (car ado))) - (point-marker)))) - (rst-find-all-adornments)))) - (dolist (lm levels-and-markers) - ;; Go to the appropriate position. - (goto-char (cdr lm)) - - ;; Apply the new style. - (apply 'rst-update-section (nth (car lm) rst-preferred-adornments)) - - ;; Reset the marker to avoid slowing down editing until it gets GC'ed. - (set-marker (cdr lm) nil))))) + (dolist (ttl-marker (mapcar + (lambda (ttl) + (cons ttl (copy-marker + (rst-Ttl-get-title-beginning ttl)))) + (rst-all-ttls-with-level))) + ;; Go to the appropriate position. + (goto-char (cdr ttl-marker)) + (rst-update-section (nth (rst-Ttl-level (car ttl-marker)) + (rst-Hdr-preferred-adornments))) + ;; Reset the marker to avoid slowing down editing. + (set-marker (cdr ttl-marker) nil)))) + +;; Maintain an alias for compatibility. +(defalias 'rst-straighten-adornments 'rst-straighten-sections) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Insert list items -;; ================= - -;================================================= ; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. ; I needed to make some tiny changes to the functions, so I put it here. ; -- Wei-Wei Guo @@ -1956,7 +2414,8 @@ If optional ARG is non-nil, insert in current buffer." string (replace-match "" nil t string)) (setq map (cdr map)))) (if arg (insert res) res))) -;================================================= + +;; End of borrow. (defun rst-find-pfx-in-region (beg end pfx-re) "Find all the positions of prefixes in region between BEG and END. @@ -2124,7 +2583,9 @@ If PREFER-ROMAN roman numbering is preferred over using letters." (1+ (string-to-char (match-string 0 curitem)))) nil nil curitem))))) - +;; FIXME: At least the continuation may be folded into +;; `newline-and-indent`. However, this may not be wanted by everyone so +;; it should be possible to switch this off. (defun rst-insert-list (&optional prefer-roman) "Insert a list item at the current point. @@ -2197,112 +2658,57 @@ adjust. If bullets are found on levels beyond the ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Table of contents -;; ================= - -;; FIXME: Return value should be a `defstruct'. -(defun rst-section-tree () - "Return the hierarchical tree of section titles. -A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the -stripped text of the section title. MARKER is a marker for the -beginning of the title text. For the top node or a missing -section level node TITLE is nil and MARKER points to the title -text of the first child. Each CHILD is another tree entry. The -CHILD list may be empty." - (let ((hier (rst-get-hierarchy)) - (ch-sty2level (make-hash-table :test 'equal :size 10)) - lev-ttl-mrk-l) - - (let ((lev 0)) - (dolist (ado hier) - ;; Compare just the character and indent in the hash table. - (puthash (cons (car ado) (cadr ado)) lev ch-sty2level) - (incf lev))) - - ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment. - (save-excursion - (setq lev-ttl-mrk-l - (mapcar (lambda (ado) - (goto-char (point-min)) - (1value ;; This should really succeed. - (forward-line (1- (car ado)))) - (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level) - ;; Get title. - (save-excursion - (if (re-search-forward - (rst-re "\\S .*\\S ") (line-end-position) t) - (buffer-substring-no-properties - (match-beginning 0) (match-end 0)) - "")) - (point-marker))) - (rst-find-all-adornments)))) - (cdr (rst-section-tree-rec lev-ttl-mrk-l -1)))) - -;; FIXME: Return value should be a `defstruct'. -(defun rst-section-tree-rec (remaining lev) + +(defun rst-all-stn () + "Return the hierarchical tree of section titles as a top level `rst-Stn'. +Return nil for no section titles." + ;; FIXME: The top level node may contain the document title instead of nil. + (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) + +(defun rst-remaining-stn (remaining lev) "Process the first entry of REMAINING expected to be on level LEV. -REMAINING is the remaining list of adornments consisting -of (LEVEL TITLE MARKER) entries. - -Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry -of REMAINING where TITLE is nil if the expected level is not -matched. UNPROCESSED is the list of still unprocessed entries. -Each CHILD is a child of this entry in the same format but -without UNPROCESSED." - (let ((cur (car remaining)) +REMAINING is the remaining list of `rst-Ttl' entries. +Return (UNPROCESSED . NODE) for the first entry of REMAINING. +UNPROCESSED is the list of still unprocessed entries. NODE is a +`rst-Stn' or nil if REMAINING is empty." + (let ((ttl (car remaining)) (unprocessed remaining) - ttl-mrk children) + fnd children) ;; If the current adornment matches expected level. - (when (and cur (= (car cur) lev)) + (when (and ttl (= (rst-Ttl-level ttl) lev)) ;; Consume the current entry and create the current node with it. (setq unprocessed (cdr remaining)) - (setq ttl-mrk (cdr cur))) - + (setq fnd ttl)) ;; Build the child nodes as long as they have deeper level. - (while (and unprocessed (> (caar unprocessed) lev)) - (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev)))) - (setq children (cons (cdr rem-children) children)) - (setq unprocessed (car rem-children)))) + (while (and unprocessed (> (rst-Ttl-level (car unprocessed)) lev)) + (let* ((rem-child (rst-remaining-stn unprocessed (1+ lev))) + (child (cdr rem-child))) + (when child + (push child children)) + (setq unprocessed (car rem-child)))) (setq children (reverse children)) - (cons unprocessed - (cons (or ttl-mrk - ;; Node on this level missing - use nil as text and the - ;; marker of the first child. - (cons nil (cdaar children))) - children)))) - -(defun rst-section-tree-point (tree &optional point) - "Return section containing POINT by returning the closest node in TREE. -TREE is a section tree as returned by `rst-section-tree' -consisting of (NODE CHILD...) entries. POINT defaults to the -current point. A NODE must have the structure (IGNORED MARKER...). - -Return (PATH NODE CHILD...). NODE is the node where POINT is in -if any. PATH is a list of nodes from the top of the tree down to -and including NODE. List of CHILD are the children of NODE if any." - (setq point (or point (point))) - (let ((cur (car tree)) - (children (cdr tree))) - ;; Point behind current node? - (if (and (cadr cur) (>= point (cadr cur))) - ;; Iterate all the children, looking for one that might contain the - ;; current section. - (let (found) - (while (and children (>= point (cadaar children))) - (setq found children - children (cdr children))) - (if found - ;; Found section containing point in children. - (let ((sub (rst-section-tree-point (car found) point))) - ;; Extend path with current node and return NODE CHILD... from - ;; sub. - (cons (cons cur (car sub)) (cdr sub))) - ;; Point in this section: Start a new path with current node and - ;; return current NODE CHILD... - (cons (list cur) tree))) - ;; Current node behind point: start a new path with current node and - ;; no NODE CHILD... - (list (list cur))))) + (if (or fnd children) + (rst-Stn-new fnd lev children))))) + +(defun rst-stn-containing-point (stn &optional point) + "Return `rst-Stn' in STN before POINT or nil if in no section. +POINT defaults to the current point. STN may be nil for no +section headers at all." + (when stn + (setq point (or point (point))) + (when (>= point (rst-Stn-get-title-beginning stn)) + ;; Point may be in this section or a child. + (let ((children (rst-Stn-children stn)) + found) + (while (and children + (>= point (rst-Stn-get-title-beginning (car children)))) + ;; Point may be in this child. + (setq found (car children) + children (cdr children))) + (if found + (rst-stn-containing-point found point) + stn))))) (defgroup rst-toc nil "Settings for reStructuredText table of contents." @@ -2337,6 +2743,7 @@ indentation style: :group 'rst-toc) (rst-testcover-defcustom) +;; FIXME: What does this mean? ;; This is used to avoid having to change the user's mode. (defvar rst-toc-insert-click-keymap (let ((map (make-sparse-keymap))) @@ -2351,7 +2758,7 @@ indentation style: (rst-testcover-defcustom) (defun rst-toc-insert (&optional pfxarg) - "Insert a simple text rendering of the table of contents. + "Insert a text rendering of the table of contents of the current section. By default the top level is ignored if there is only one, because we assume that the document will have a single title. @@ -2361,98 +2768,77 @@ to the specified level. The TOC is inserted indented at the current column." (interactive "P") (rst-reset-section-caches) - (let* (;; Check maximum level override. - (rst-toc-insert-max-level - (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) - (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) - - ;; Get the section tree for the current cursor point. - (sectree-pair - (rst-section-tree-point - (rst-section-tree))) - - ;; Figure out initial indent. - (initial-indent (make-string (current-column) ? )) - (init-point (point))) - - (when (cddr sectree-pair) - (rst-toc-insert-node (cdr sectree-pair) 0 initial-indent "") - - ;; Fixup for the first line. - (delete-region init-point (+ init-point (length initial-indent))) - + (let (;; Check maximum level override. + (rst-toc-insert-max-level + (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) + (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) + (pt-stn (rst-stn-containing-point (rst-all-stn))) + ;; Figure out initial indent. + (initial-indent (make-string (current-column) ? )) + (init-point (point))) + (when (and pt-stn (rst-Stn-children pt-stn)) + (rst-toc-insert-node pt-stn 0 initial-indent "") + ;; FIXME: Really having the last newline would be better. ;; Delete the last newline added. (delete-char -1)))) -(defun rst-toc-insert-node (node level indent pfx) - "Insert tree node NODE in table-of-contents. -Recursive function that does printing of the inserted TOC. -LEVEL is the depth level of the sections in the tree. -INDENT is the indentation string. PFX is the prefix numbering, -that includes the alignment necessary for all the children of -level to align." - +(defun rst-toc-insert-node (stn level indent pfx) + "Insert STN in table-of-contents. +LEVEL is the depth level of the sections in the tree currently +rendered. INDENT is the indentation string. PFX is the prefix +numbering, that includes the alignment necessary for all the +children of level to align." ;; Note: we do child numbering from the parent, so we start number the ;; children one level before we print them. - (let ((do-print (> level 0)) - (count 1)) - (when do-print - (insert indent) - (let ((b (point))) - (unless (equal rst-toc-insert-style 'plain) - (insert pfx rst-toc-insert-number-separator)) - (insert (or (caar node) "[missing node]")) - ;; Add properties to the text, even though in normal text mode it - ;; won't be doing anything for now. Not sure that I want to change - ;; mode stuff. At least the highlighting gives the idea that this - ;; is generated automatically. - (put-text-property b (point) 'mouse-face 'highlight) - (put-text-property b (point) 'rst-toc-target (cadar node)) - (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)) - (insert "\n") - - ;; Prepare indent for children. - (setq indent - (cond - ((eq rst-toc-insert-style 'plain) - (concat indent (make-string rst-toc-indent ? ))) - - ((eq rst-toc-insert-style 'fixed) - (concat indent (make-string rst-toc-indent ? ))) - - ((eq rst-toc-insert-style 'aligned) - (concat indent (make-string (+ (length pfx) 2) ? ))) - - ((eq rst-toc-insert-style 'listed) - (concat (substring indent 0 -3) - (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) - - (if (or (eq rst-toc-insert-max-level nil) - (< level rst-toc-insert-max-level)) - (let ((do-child-numbering (>= level 0)) - fmt) - (if do-child-numbering - (progn - ;; Add a separating dot if there is already a prefix. - (when (> (length pfx) 0) - (string-match (rst-re "[ \t\n]*\\'") pfx) - (setq pfx (concat (replace-match "" t t pfx) "."))) - - ;; Calculate the amount of space that the prefix will require - ;; for the numbers. - (if (cdr node) - (setq fmt (format "%%-%dd" - (1+ (floor (log (length (cdr node)) - 10)))))))) - - (dolist (child (cdr node)) - (rst-toc-insert-node child - (1+ level) - indent - (if do-child-numbering - (concat pfx (format fmt count)) pfx)) - (incf count)))))) - + (when (> level 0) + (unless (> (current-column) 0) + ;; No indent yet - insert it. + (insert indent)) + (let ((beg (point))) + (unless (equal rst-toc-insert-style 'plain) + (insert pfx rst-toc-insert-number-separator)) + (insert (rst-Stn-get-text stn)) + ;; Add properties to the text, even though in normal text mode it + ;; won't be doing anything for now. Not sure that I want to change + ;; mode stuff. At least the highlighting gives the idea that this + ;; is generated automatically. + (put-text-property beg (point) 'mouse-face 'highlight) + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn))) + (put-text-property beg (point) 'keymap rst-toc-insert-click-keymap)) + (insert "\n") + ;; Prepare indent for children. + (setq indent + (cond + ((eq rst-toc-insert-style 'plain) + (concat indent (make-string rst-toc-indent ? ))) + ((eq rst-toc-insert-style 'fixed) + (concat indent (make-string rst-toc-indent ? ))) + ((eq rst-toc-insert-style 'aligned) + (concat indent (make-string (+ (length pfx) 2) ? ))) + ((eq rst-toc-insert-style 'listed) + (concat (substring indent 0 -3) + (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) + (when (or (eq rst-toc-insert-max-level nil) + (< level rst-toc-insert-max-level)) + (let ((count 1) + fmt) + ;; Add a separating dot if there is already a prefix. + (when (> (length pfx) 0) + (string-match (rst-re "[ \t\n]*\\'") pfx) + (setq pfx (concat (replace-match "" t t pfx) "."))) + ;; Calculate the amount of space that the prefix will require + ;; for the numbers. + (when (rst-Stn-children stn) + (setq fmt + (format "%%-%dd" + (1+ (floor (log (length (rst-Stn-children stn)) + 10)))))) + (dolist (child (rst-Stn-children stn)) + (rst-toc-insert-node child (1+ level) indent + (concat pfx (format fmt count))) + (incf count))))) (defun rst-toc-update () "Automatically find the contents section of a document and update. @@ -2497,57 +2883,45 @@ file-write hook to always make it up-to-date automatically." ;; Note: always return nil, because this may be used as a hook. nil) -;; Note: we cannot bind the TOC update on file write because it messes with -;; undo. If we disable undo, since it adds and removes characters, the -;; positions in the undo list are not making sense anymore. Dunno what to do -;; with this, it would be nice to update when saving. +;; FIXME: Updating the toc on saving would be nice. However, this doesn't work +;; correctly: ;; -;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) -;; (defun rst-toc-update-fun () -;; ;; Disable undo for the write file hook. -;; (let ((buffer-undo-list t)) (rst-toc-update) )) +;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) +;; (defun rst-toc-update-fun () +;; ;; Disable undo for the write file hook. +;; (let ((buffer-undo-list t)) (rst-toc-update) )) (defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. -;;------------------------------------------------------------------------------ - -(defun rst-toc-node (node level) - "Recursive function that does insert NODE at LEVEL in the table-of-contents." - - (if (> level 0) - (let ((b (point))) - ;; Insert line text. - (insert (make-string (* rst-toc-indent (1- level)) ? )) - (insert (or (caar node) "[missing node]")) - - ;; Highlight lines. - (put-text-property b (point) 'mouse-face 'highlight) - - ;; Add link on lines. - (put-text-property b (point) 'rst-toc-target (cadar node)) - - (insert "\n"))) - - (dolist (child (cdr node)) - (rst-toc-node child (1+ level)))) - -(defun rst-toc-count-lines (node target-node) - "Count the number of lines from NODE to the TARGET-NODE node. -This recursive function returns a cons of the number of -additional lines that have been counted for its node and -children, and t if the node has been found." - - (let ((count 1) - found) - (if (eq node target-node) - (setq found t) - (let ((child (cdr node))) - (while (and child (not found)) - (let ((cl (rst-toc-count-lines (car child) target-node))) - (setq count (+ count (car cl)) - found (cdr cl) - child (cdr child)))))) - (cons count found))) +(defun rst-toc-node (stn buf target) + "Insert STN in the table-of-contents of buffer BUF. +If TARGET is given and this call renders a `rst-Stn' at the same +location return position of beginning of line. Otherwise return +nil." + (let ((beg (point)) + fnd) + (if (or (not stn) (rst-Stn-is-top stn)) + (progn + (insert (format "Table of Contents:\n")) + (put-text-property beg (point) + 'face (list '(background-color . "gray")))) + (when (and target + (equal (rst-Stn-get-title-beginning stn) + (rst-Stn-get-title-beginning target))) + (setq fnd beg)) + (insert (make-string (* rst-toc-indent (rst-Stn-level stn)) ? )) + (insert (rst-Stn-get-text stn)) + ;; Highlight lines. + (put-text-property beg (point) 'mouse-face 'highlight) + (insert "\n") + ;; Add link on lines. + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf))) + (when stn + (dolist (child (rst-Stn-children stn)) + (setq fnd (or (rst-toc-node child buf target) fnd)))) + fnd)) (defvar rst-toc-buffer-name "*Table of Contents*" "Name of the Table of Contents buffer.") @@ -2555,7 +2929,6 @@ children, and t if the node has been found." (defvar rst-toc-return-wincfg nil "Window configuration to which to return when leaving the TOC.") - (defun rst-toc () "Display a table-of-contents. Finds all the section titles and their adornments in the @@ -2567,37 +2940,21 @@ The Emacs buffer can be navigated, and selecting a section brings the cursor in that section." (interactive) (rst-reset-section-caches) - (let* ((curbuf (list (current-window-configuration) (point-marker))) - (sectree (rst-section-tree)) - - (our-node (cdr (rst-section-tree-point sectree))) - line - - ;; Create a temporary buffer. - (buf (get-buffer-create rst-toc-buffer-name))) - + (let* ((wincfg (list (current-window-configuration) (point-marker))) + (sectree (rst-all-stn)) + (target-node (rst-stn-containing-point sectree)) + (target-buf (current-buffer)) + (buf (get-buffer-create rst-toc-buffer-name)) + target-pos) (with-current-buffer buf (let ((inhibit-read-only t)) (rst-toc-mode) (delete-region (point-min) (point-max)) - (insert (format "Table of Contents: %s\n" (or (caar sectree) ""))) - (put-text-property (point-min) (point) - 'face (list '(background-color . "gray"))) - (rst-toc-node sectree 0) - - ;; Count the lines to our found node. - (let ((linefound (rst-toc-count-lines sectree our-node))) - (setq line (if (cdr linefound) (car linefound) 0))))) + (setq target-pos (rst-toc-node sectree target-buf target-node)))) (display-buffer buf) (pop-to-buffer buf) - - ;; Save the buffer to return to. - (set (make-local-variable 'rst-toc-return-wincfg) curbuf) - - ;; Move the cursor near the right section in the TOC. - (goto-char (point-min)) - (forward-line (1- line)))) - + (setq-local rst-toc-return-wincfg wincfg) + (goto-char (or target-pos (point-min))))) (defun rst-toc-mode-find-section () "Get the section from text property at point." @@ -2660,10 +3017,12 @@ EVENT is the input event." (defvar rst-toc-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) + ;; FIXME: This very useful function must be on some key. (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) (define-key map "\C-m" 'rst-toc-mode-goto-section) (define-key map "f" 'rst-toc-mode-goto-section) (define-key map "q" 'rst-toc-quit-window) + ;; FIXME: Killing should clean up like `rst-toc-quit-window' does. (define-key map "z" 'kill-this-buffer) map) "Keymap for `rst-toc-mode'.") @@ -2672,15 +3031,13 @@ EVENT is the input event." ;; Could inherit from the new `special-mode'. (define-derived-mode rst-toc-mode nil "ReST-TOC" - "Major mode for output from \\[rst-toc], the table-of-contents for the document." - (setq buffer-read-only t)) + "Major mode for output from \\[rst-toc], the table-of-contents for the document. -;; Note: use occur-mode (replace.el) as a good example to complete missing -;; features. +\\{rst-toc-mode-map}" + (setq buffer-read-only t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section movement commands -;; ========================= +;; Section movement (defun rst-forward-section (&optional offset) "Skip to the next reStructuredText section title. @@ -2688,38 +3045,32 @@ OFFSET specifies how many titles to skip. Use a negative OFFSET to move backwards in the file (default is to use 1)." (interactive) (rst-reset-section-caches) - (let* (;; Default value for offset. - (offset (or offset 1)) - - ;; Get all the adornments in the file, with their line numbers. - (allados (rst-find-all-adornments)) - - ;; Get the current line. - (curline (line-number-at-pos)) - - (cur allados) - (idx 0)) - - ;; Find the index of the "next" adornment w.r.t. to the current line. - (while (and cur (< (caar cur) curline)) + (let* ((offset (or offset 1)) + (ttls (rst-all-ttls)) + (curpos (line-beginning-position)) + (cur ttls) + (idx 0) + ttl) + + ;; Find the index of the "next" adornment with respect to the current line. + (while (and cur (< (rst-Ttl-get-title-beginning (car cur)) curpos)) (setq cur (cdr cur)) (incf idx)) - ;; 'cur' is the adornment on or following the current line. + ;; `cur' is the `rst-Ttl' on or following the current line. - (if (and (> offset 0) cur (= (caar cur) curline)) + (if (and (> offset 0) cur + (equal (rst-Ttl-get-title-beginning (car cur)) curpos)) (incf idx)) ;; Find the final index. (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) - (setq cur (nth idx allados)) - - ;; If the index is positive, goto the line, otherwise go to the buffer - ;; boundaries. - (if (and cur (>= idx 0)) - (progn - (goto-char (point-min)) - (forward-line (1- (car cur)))) - (if (> offset 0) (goto-char (point-max)) (goto-char (point-min)))))) + (setq ttl (nth idx ttls)) + (goto-char (cond + ((and ttl (>= idx 0)) + (rst-Ttl-get-title-beginning ttl)) + ((> offset 0) + (point-max)) + ((point-min)))))) (defun rst-backward-section () "Like `rst-forward-section', except move back one title." @@ -2751,11 +3102,13 @@ for negative COUNT." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are -;; always 2 or 3 characters apart horizontally with rest. +;; Indentation (defun rst-find-leftmost-column (beg end) - "Return the leftmost column in region BEG to END." + "Return the leftmost column spanned by region BEG to END. +The line containing the start of the region is always considered +spanned. If the region ends at the beginning of a line this line +is not considered spanned, otherwise it is spanned." (let (mincol) (save-excursion (goto-char beg) @@ -2768,80 +3121,6 @@ for negative COUNT." (forward-line 1))) mincol)) -;; FIXME: This definition is old and deprecated. We need to move to the newer -;; version below. -(defmacro rst-iterate-leftmost-paragraphs - (beg end first-only body-consequent body-alternative) - ;; FIXME: The following comment is pretty useless. - "Call FUN at the beginning of each line, with an argument that -specifies whether we are at the first line of a paragraph that -starts at the leftmost column of the given region BEG and END. -Set FIRST-ONLY to true if you want to callback on the first line -of each paragraph only." - `(save-excursion - (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (previous nil valid) - - (curcol (current-column) - (current-column)) - - (valid (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))) - (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))))) - ((>= (point) endm)) - - (if (if ,first-only - (and valid (not previous)) - valid) - ,body-consequent - ,body-alternative))))) - -;; FIXME: This needs to be refactored. Probably this is simply a function -;; applying BODY rather than a macro. -(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) - "Evaluate BODY for each line in region defined by BEG END. -LEFTMOST is set to true if the line is one of the leftmost of the -entire paragraph. PARABEGIN is set to true if the line is the -first of a paragraph." - (declare (indent 1) (debug (sexp body))) - (destructuring-bind - (beg end parabegin leftmost isleftmost isempty) spec - - `(save-excursion - (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (empty-line-previous nil ,isempty) - - (,isempty (looking-at (rst-re 'lin-end)) - (looking-at (rst-re 'lin-end))) - - (,parabegin (not ,isempty) - (and empty-line-previous - (not ,isempty))) - - (,isleftmost (and (not ,isempty) - (= (current-column) ,leftmost)) - (and (not ,isempty) - (= (current-column) ,leftmost)))) - ((>= (point) endm)) - - (progn ,@body)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Indentation - ;; FIXME: At the moment only block comments with leading empty comment line are ;; supported. Comment lines with leading comment markup should be also ;; supported. May be a customizable option could control which style to @@ -3052,7 +3331,7 @@ above. If no suitable tab is found `rst-indent-width' is used." (abs (abs cnt)) ; Absolute number of steps to take. ;; Get the position of the first tab beyond leftmostcol. (fnd (lexical-let ((cmp cmp) - (leftmostcol leftmostcol)) ; Create closure. + (leftmostcol leftmostcol)) ;; Create closure. (rst-position-if (lambda (elt) (funcall cmp elt leftmostcol)) tabs))) @@ -3139,7 +3418,7 @@ Region is from BEG to END. Uncomment if ARG." (defun rst-uncomment-region (beg end &optional _arg) "Uncomment the current region. -Region is from BEG to END. ARG is ignored" +Region is from BEG to END. _ARG is ignored" (save-excursion (let (bol eol) (goto-char beg) @@ -3150,7 +3429,8 @@ Region is from BEG to END. ARG is ignored" (indent-rigidly eol end (- rst-indent-comment)) (delete-region bol eol)))) -;;------------------------------------------------------------------------------ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Apply to indented block ;; FIXME: These next functions should become part of a larger effort to redo ;; the bullets in bulleted lists. The enumerate would just be one of @@ -3158,29 +3438,127 @@ Region is from BEG to END. ARG is ignored" ;; ;; FIXME: We need to do the enumeration removal as well. +(defun rst-apply-indented-blocks (beg end ind fun) + "Apply FUN to all lines from BEG to END in blocks indented to IND. +The first indented block starts with the first non-empty line +containing or after BEG and indented to IND. After the first +line the indented block may contain more lines with same +indentation (the paragraph) followed by empty lines and lines +more indented (the sub-blocks). A following line indented to IND +starts the next indented block. A line with less indentation +than IND terminates the current indented block. Such lines and +all following lines not indented to IND are skipped. FUN is +applied to unskipped lines like this + + (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) + +COUNT is 0 before the first indented block and increments for +every indented block found. + +FIRSTP is t when this is the first line of the paragraph. + +SUBP is t when this line is part of a sub-block. + +EMPTYP is t when this line is empty. + +RELIND is nil for an empty line, 0 for a line indented to IND, +and the number of columns more indented otherwise. + +LASTRET is the return value of FUN returned by the last +invocation for the same indented block or nil for the first +invocation. + +When FUN is called point is immediately behind indentation of +that line. FUN may change everything as long as a marker at END +is handled correctly by the change. + +Return the return value of the last invocation of FUN or nil if +FUN was never called." + (let (lastret + subp + skipping + nextm + (count 0) ; Before first indented block + (endm (copy-marker end t))) + (save-excursion + (goto-char beg) + (while (< (point) endm) + (save-excursion + (setq nextm (save-excursion + (forward-line 1) + (copy-marker (point) t))) + (back-to-indentation) + (let (firstp + emptyp + (relind (- (current-column) ind))) + (cond + ((looking-at (rst-re 'lin-end)) + (setq emptyp t) + (setq relind nil) + ;; Breaks indented block if one is started + (setq subp (not (zerop count)))) + ((< relind 0) ; Less indented + (setq skipping t)) + ((zerop relind) ; In indented block + (when (or subp skipping (zerop count)) + (setq firstp t) + (incf count)) + (setq subp nil) + (setq skipping nil)) + (t ; More indented + (setq subp t))) + (unless skipping + (setq lastret + (funcall fun count firstp subp emptyp relind lastret))))) + (goto-char nextm)) + lastret))) + (defun rst-enumerate-region (beg end all) "Add enumeration to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (let ((count 0) - (last-insert-len nil)) - (rst-iterate-leftmost-paragraphs - beg end (not all) - (let ((ins-string (format "%d. " (incf count)))) - (setq last-insert-len (length ins-string)) - (insert ins-string)) - (insert (make-string last-insert-len ?\ ))))) + (let ((enum 0)) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert lastret)) + ((or firstp all) + (let ((ins (format "%d. " (incf enum)))) + (setq lastret (make-string (length ins) ?\ )) + (insert ins))) + (t + (insert lastret))) + lastret)))) +;; FIXME: Does not deal with deeper indentation - although +;; `rst-apply-indented-blocks' could. (defun rst-bullet-list-region (beg end all) "Add bullets to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (rst-iterate-leftmost-paragraphs - beg end (not all) - (insert (car rst-preferred-bullets) " ") - (insert " "))) + (unless rst-preferred-bullets + (error "No preferred bullets defined")) + (let ((bul (format "%c " (car rst-preferred-bullets))) + (cont " ")) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert cont)) + ((or firstp all) + (insert bul)) + (t + (insert cont))) + nil)))) ;; FIXME: Does not deal with a varying number of digits appropriately. ;; FIXME: Does not deal with multiple levels independently. @@ -3203,29 +3581,21 @@ Renumber as necessary. Region is from BEG to END." (replace-match (format "%d." count) nil nil nil 1) (incf count))))) -;;------------------------------------------------------------------------------ - -(defun rst-line-block-region (rbeg rend &optional pfxarg) - "Toggle line block prefixes for a region. -Region is from RBEG to REND. With PFXARG set the empty lines too." +(defun rst-line-block-region (beg end &optional with-empty) + "Add line block prefixes for a region. +Region is from BEG to END. With WITH-EMPTY prefix empty lines too." (interactive "r\nP") - (let ((comment-start "| ") - (comment-end "") - (comment-start-skip "| ") - (comment-style 'indent) - (force (not (not pfxarg)))) - (rst-iterate-leftmost-paragraphs-2 - (rbeg rend parbegin leftmost isleft isempty) - (when (or force (not isempty)) - (move-to-column leftmost force) - (delete-region (point) (+ (point) (- (current-indentation) leftmost))) - (insert "| "))))) - + (let ((ind (rst-find-leftmost-column beg end))) + (rst-apply-indented-blocks + beg end ind + (lambda (count firstp subp emptyp relind lastret) + (when (or with-empty (not emptyp)) + (move-to-column ind t) + (insert "| ")))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font lock -;; ========= (require 'font-lock) @@ -3525,7 +3895,7 @@ of your own." (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) 1 rst-definition-face) ;; `Hyperlink References`_ - ;; FIXME: `Embedded URIs`_ not considered. + ;; FIXME: `Embedded URIs and Aliases`_ not considered. ;; FIXME: Directly adjacent marked up words are not fontified correctly ;; unless they are not separated by two spaces: foo_ bar_. (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") @@ -3714,9 +4084,9 @@ Return extended point or nil if not moved." (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / ; overline. (if (zerop (rst-forward-line dir)) - (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e. - ; underline / overline - ; found. + (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e. + ; underline / overline + ; found. (if (zerop (rst-forward-line dir)) (if (not (looking-at (rst-re 'ado-beg-2-1))) ; no @@ -3726,7 +4096,7 @@ Return extended point or nil if not moved." ; / adornment. (if (< dir 0) ; keep downward adornment. (rst-forward-line (- dir))))) ; step back to adornment. - (if (looking-at (rst-re 'ttl-beg)) ; may be a title. + (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title. (if (zerop (rst-forward-line dir)) (if (not (looking-at (rst-re 'ado-beg-2-1))) ; no overline / @@ -3827,7 +4197,7 @@ next non-empty line if this is indented more than the current one." "Set the match found earlier if match were found. Match has been found by `rst-font-lock-find-unindented-line-limit' the first time called or no match is found. Return non-nil if -match was found. LIMIT is not used but mandated by the caller." +match was found. _LIMIT is not used but mandated by the caller." (when rst-font-lock-find-unindented-line-end (set-match-data (list rst-font-lock-find-unindented-line-begin @@ -3846,22 +4216,14 @@ match was found. LIMIT is not used but mandated by the caller." "Storage for `rst-font-lock-handle-adornment-matcher'. Either section level of the current adornment or t for a transition.") -(defun rst-adornment-level (key) - "Return section level for adornment KEY. -KEY is the first element of the return list of `rst-classify-adornment'. -If KEY is not a cons return it. If KEY is found in the hierarchy return -its level. Otherwise return a level one beyond the existing hierarchy." - (if (not (consp key)) - key - (let* ((hier (rst-get-hierarchy)) - (char (car key)) - (style (cdr key))) - (1+ (or (lexical-let ((char char) - (style style) - (hier hier)) ; Create closure. - (rst-position-if (lambda (elt) - (and (equal (car elt) char) - (equal (cadr elt) style))) hier)) +(defun rst-adornment-level (ado) + "Return section level for ADO or t for a transition. +If ADO is found in the hierarchy return its level. Otherwise +return a level one beyond the existing hierarchy." + (if (rst-Ado-is-transition ado) + t + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (1+ (or (rst-Ado-position ado hier) (length hier)))))) (defvar rst-font-lock-adornment-match nil @@ -3878,15 +4240,15 @@ matched. ADO-END is the point where ADO ends. Return the point where the whole adorned construct ends. Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'." - (let ((ado-data (rst-classify-adornment ado ado-end))) - (if (not ado-data) + (let ((ttl (rst-classify-adornment ado ado-end))) + (if (not ttl) (setq rst-font-lock-adornment-level nil rst-font-lock-adornment-match nil) (setq rst-font-lock-adornment-level - (rst-adornment-level (car ado-data))) - (setq rst-font-lock-adornment-match (cdr ado-data)) - (goto-char (nth 1 ado-data)) ; Beginning of construct. - (nth 2 ado-data)))) ; End of construct. + (rst-adornment-level (rst-Ttl-ado ttl))) + (setq rst-font-lock-adornment-match (rst-Ttl-match ttl)) + (goto-char (rst-Ttl-get-beginning ttl)) + (rst-Ttl-get-end ttl)))) (defun rst-font-lock-handle-adornment-matcher (_limit) "Set the match found earlier if match were found. @@ -3895,7 +4257,7 @@ Match has been found by called or no match is found. Return non-nil if match was found. Called as a MATCHER in the sense of `font-lock-keywords'. -LIMIT is not used but mandated by the caller." +_LIMIT is not used but mandated by the caller." (let ((match rst-font-lock-adornment-match)) ;; May run only once - enforce this. (setq rst-font-lock-adornment-match nil) @@ -3933,6 +4295,13 @@ document with \\[rst-compile]." ".pdf" nil) (s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5") ".html" nil)) + ;; FIXME: Add at least those converters officially supported like `rst2odt' + ;; and `rst2man'. + ;; FIXME: To make this really useful there should be a generic command the + ;; user gives one of the symbols and this way select the conversion to + ;; run. This should replace the toolset stuff somehow. + ;; FIXME: Allow a template for the conversion command so `rst2pdf ... -o ...' + ;; can be supported. "Table describing the command to use for each tool-set. An association list of the tool-set to a list of the (command to use, extension of produced filename, options to the tool (nil or a @@ -4002,16 +4371,17 @@ select the alternative tool-set." (outname (file-name-sans-extension bufname))) ;; Set compile-command before invocation of compile. - (set (make-local-variable 'compile-command) - (mapconcat 'identity - (list command - (or options "") - (if conffile - (concat "--config=" (shell-quote-argument conffile)) - "") - (shell-quote-argument bufname) - (shell-quote-argument (concat outname extension))) - " ")) + (setq-local + compile-command + (mapconcat 'identity + (list command + (or options "") + (if conffile + (concat "--config=" (shell-quote-argument conffile)) + "") + (shell-quote-argument bufname) + (shell-quote-argument (concat outname extension))) + " ")) ;; Invoke the compile command. (if (or compilation-read-command use-alt) @@ -4036,7 +4406,7 @@ buffer, if the region is not selected." (cadr (assq 'pseudoxml rst-compile-toolsets)) standard-output))) -;; FIXME: Should be defcustom. +;; FIXME: Should be integrated in `rst-compile-toolsets'. (defvar rst-pdf-program "xpdf" "Program used to preview PDF files.") @@ -4053,7 +4423,8 @@ buffer, if the region is not selected." ;; output. )) -;; FIXME: Should be defcustom or use something like `browse-url'. +;; FIXME: Should be integrated in `rst-compile-toolsets' defaulting to +;; something like `browse-url'. (defvar rst-slides-program "firefox" "Program used to preview S5 slides.") @@ -4070,56 +4441,41 @@ buffer, if the region is not selected." ;; output. )) +;; FIXME: Add `rst-compile-html-preview'. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Imenu support. - -;; FIXME: Integrate this properly. Consider a key binding. - -;; Based on code from Masatake YAMATO <yamato@redhat.com>. - -(defun rst-imenu-find-adornments-for-position (adornments pos) - "Find adornments cell in ADORNMENTS for position POS." - (let ((a nil)) - (while adornments - (if (and (car adornments) - (eq (car (car adornments)) pos)) - (setq a adornments - adornments nil) - (setq adornments (cdr adornments)))) - a)) - -(defun rst-imenu-convert-cell (elt adornments) - "Convert a cell ELT in a tree returned from `rst-section-tree' to Imenu index. -ADORNMENTS is used as hint information for conversion." - (let* ((kar (car elt)) - (kdr (cdr elt)) - (title (car kar))) - (if kar - (let* ((p (marker-position (cadr kar))) - (adornments - (rst-imenu-find-adornments-for-position adornments p)) - (a (car adornments)) - (adornments (cdr adornments)) - ;; FIXME: Overline adornment characters need to be in front so - ;; they become visible even for long title lines. May be - ;; an additional level number is also useful. - (title (format "%s%s%s" - (make-string (1+ (nth 3 a)) (nth 1 a)) - title - (if (eq (nth 2 a) 'simple) - "" - (char-to-string (nth 1 a)))))) - (cons title - (if (null kdr) - p - (cons - ;; A bit ugly but this make which-func happy. - (cons title p) - (mapcar (lambda (elt0) - (rst-imenu-convert-cell elt0 adornments)) - kdr))))) - nil))) +;; Imenu support + +;; FIXME: Consider a key binding. A key binding needs to definitely switch on +;; `which-func-mode' - i.e. `which-func-modes' must be set properly. + +;; Based on ideas from Masatake YAMATO <yamato@redhat.com>. + +(defun rst-imenu-convert-cell (stn) + "Convert a STN to an Imenu index node and return it." + (let ((ttl (rst-Stn-ttl stn)) + (children (rst-Stn-children stn)) + (pos (rst-Stn-get-title-beginning stn)) + (txt (rst-Stn-get-text stn "")) + (pfx " ") + (sfx "") + name) + (when ttl + (let ((hdr (rst-Ttl-hdr ttl))) + (setq pfx (char-to-string (rst-Hdr-get-char hdr))) + (when (rst-Hdr-is-over-and-under hdr) + (setq sfx pfx)))) + ;; FIXME: Overline adornment characters need to be in front so they + ;; become visible even for long title lines. May be an additional + ;; level number is also useful. + (setq name (format "%s%s%s" pfx txt sfx)) + (cons name ;; The name of the entry. + (if children + (cons ;; The entry has a submenu. + (cons name pos) ;; The entry itself. + (mapcar 'rst-imenu-convert-cell children)) ;; The children. + pos)))) ;; The position of a plain entry. ;; FIXME: Document title and subtitle need to be handled properly. They should ;; get an own "Document" top level entry. @@ -4127,25 +4483,13 @@ ADORNMENTS is used as hint information for conversion." "Create index for Imenu. Return as described for `imenu--index-alist'." (rst-reset-section-caches) - (let ((tree (rst-section-tree)) - ;; Translate line notation to point notation. - (adornments (save-excursion - (mapcar (lambda (ln-ado) - (cons (progn - (goto-char (point-min)) - (forward-line (1- (car ln-ado))) - ;; FIXME: Need to consider - ;; `imenu-use-markers' here? - (point)) - (cdr ln-ado))) - (rst-find-all-adornments))))) - (delete nil (mapcar (lambda (elt) - (rst-imenu-convert-cell elt adornments)) - tree)))) + (let ((root (rst-all-stn))) + (when root + (mapcar 'rst-imenu-convert-cell (rst-Stn-children root))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Generic text functions that are more convenient than the defaults. +;; Convenience functions ;; FIXME: Unbound command - should be bound or removed. (defun rst-replace-lines (fromchar tochar) @@ -4228,12 +4572,12 @@ column is used (fill-column vs. end of previous/next line)." ;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex ;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc -;; LocalWords: XML PNT propertized +;; LocalWords: XML PNT propertized init referenceable + +(provide 'rst) ;; Local Variables: -;; sentence-end-double-space: t +;; sentence-end-double-space: t ;; End: -(provide 'rst) - ;;; rst.el ends here diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index e6eb060d8a4..f476cfbba04 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -32,6 +32,9 @@ ;;; Code: +(require 'dom) +(require 'seq) +(require 'subr-x) (eval-when-compile (require 'skeleton) (require 'cl-lib)) @@ -1779,11 +1782,12 @@ This takes effect when first loading the library.") "Value of `sgml-display-text' for HTML mode.") -;; should code exactly HTML 3 here when that is finished (defvar html-tag-alist (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7"))) (1-9 `(,@1-7 ("8") ("9"))) (align '(("align" ("left") ("center") ("right")))) + (ialign '(("align" ("top") ("middle") ("bottom") ("left") + ("right")))) (valign '(("top") ("middle") ("bottom") ("baseline"))) (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") @@ -1796,17 +1800,29 @@ This takes effect when first loading the library.") ("title"))) (list '((nil \n ("List item: " "<li>" str (if sgml-xml-mode "</li>") \n)))) + (shape '(("shape" ("rect") ("circle") ("poly") ("default")))) (cell `(t ,@align ("valign" ,@valign) ("colspan" ,@1-9) ("rowspan" ,@1-9) - ("nowrap" t)))) + ("nowrap" t))) + (cellhalign '(("align" ("left") ("center") ("right") + ("justify") ("char")) + ("char") ("charoff"))) + (cellvalign '(("valign" ("top") ("middle") ("bottom") + ("baseline"))))) ;; put ,-expressions first, else byte-compile chokes (as of V19.29) ;; and like this it's more efficient anyway `(("a" ,name ,@link) + ("area" t ,@shape ("coords") ("href") ("nohref" "nohref") ("alt") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) ("base" t ,@href) + ("col" t ,@cellhalign ,@cellvalign ("span") ("width")) + ("colgroup" \n ,@cellhalign ,@cellvalign ("span") ("width")) ("dir" ,@list) + ("figcaption") + ("figure" \n) ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7) ("form" (\n _ \n "<input type=\"submit\" value=\"\"" (if sgml-xml-mode " />" ">")) @@ -1818,13 +1834,28 @@ This takes effect when first loading the library.") ("h5" ,@align) ("h6" ,@align) ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align) + ("iframe" \n ,@ialign ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("scrolling" ("yes") ("no") ("auto")) ("height") ("width")) ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom")) ("src") ("alt") ("width" "1") ("height" "1") ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t)) - ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name - ("type" ("text") ("password") ("checkbox") ("radio") - ("submit") ("reset")) - ("value")) + ("input" t ,name ("accept") ("alt") ("autocomplete" ("on") ("off")) + ("autofocus" t) ("checked" t) ("dirname") ("disabled" t) ("form") + ("formaction") + ("formenctype" ("application/x-www-form-urlencoded") + ("multipart/form-data") ("text/plain")) + ("formmethod" ("get") ("post")) + ("formnovalidate" t) + ("formtarget" ("_blank") ("_self") ("_parent") ("_top")) + ("height") ("inputmode") ("list") ("max") ("maxlength") ("min") + ("minlength") ("multiple" t) ("pattern") ("placeholder") + ("readonly" t) ("required" t) ("size") ("src") ("step") + ("type" ("hidden") ("text") ("search") ("tel") ("url") ("email") + ("password") ("date") ("time") ("number") ("range") ("color") + ("checkbox") ("radio") ("file") ("submit") ("image") ("reset") + ("button")) + ("value") ("width")) ("link" t ,@link) ("menu" ,@list) ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1"))) @@ -1839,14 +1870,17 @@ This takes effect when first loading the library.") "<tr><" str ?> _ (if sgml-xml-mode (concat "<" str "></tr>")) \n)) ("border" t ,@1-9) ("width" "10") ("cellpadding")) + ("tbody" \n ,@cellhalign ,@cellvalign) ("td" ,@cell) ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9)) + ("tfoot" \n ,@cellhalign ,@cellvalign) ("th" ,@cell) + ("thead" \n ,@cellhalign ,@cellvalign) ("ul" ,@list ("type" ("disc") ("circle") ("square"))) ,@sgml-tag-alist - ("abbrev") + ("abbr") ("acronym") ("address") ("array" (nil \n @@ -1855,20 +1889,33 @@ This takes effect when first loading the library.") ("article" \n) ("aside" \n) ("au") + ("audio" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls")) ("b") + ("bdi") + ("bdo" nil ("lang") ("dir" ("ltr") ("rtl"))) ("big") ("blink") - ("blockquote" \n) + ("blockquote" \n ("cite")) ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#") ("link" "#") ("alink" "#") ("vlink" "#")) ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>"))) ("br" t ("clear" ("left") ("right"))) + ("button" nil ("name") ("value") + ("type" ("submit") ("reset") ("button")) + ("disabled" "disabled") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) + ("canvas" \n ("width") ("height")) ("caption" ("valign" ("top") ("bottom"))) ("center" \n) ("cite") ("code" \n) + ("datalist" \n) ("dd" ,(not sgml-xml-mode)) - ("del") + ("del" nil ("cite") ("datetime")) ("dfn") ("div") ("dl" (nil \n @@ -1878,14 +1925,20 @@ This takes effect when first loading the library.") ("dt" (t _ (if sgml-xml-mode "</dt>") "<dd>" (if sgml-xml-mode "</dd>") \n)) ("em") + ("embed" t ("src") ("type") ("width") ("height")) + ("fieldset" \n) ("fn" "id" "fn") ;; Footnotes were deprecated in HTML 3.2 ("footer" \n) + ("frame" t ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("noresize" "noresize") ("scrolling" ("yes") ("no") ("auto"))) + ("frameset" \n ("rows") ("cols") ("onload") ("onunload")) ("head" \n) ("header" \n) ("hgroup" \n) ("html" (\n "<head>\n" - "<title>" (setq str (read-input "Title: ")) "</title>\n" + "<title>" (setq str (read-string "Title: ")) "</title>\n" "</head>\n" "<body>\n<h1>" str "</h1>\n" _ "\n<address>\n<a href=\"mailto:" @@ -1894,24 +1947,49 @@ This takes effect when first loading the library.") "</body>" )) ("i") - ("ins") + ("ins" nil ("cite") ("datetime")) ("isindex" t ("action") ("prompt")) ("kbd") + ("label" nil ("for") ("accesskey") ("onfocus") ("onblur")) ("lang") + ("legend" nil ("accesskey")) ("li" ,(not sgml-xml-mode)) + ("main" \n) + ("map" \n ("name")) + ("mark") ("math" \n) + ("meta" t ("http-equiv") ("name") ("content") ("scheme")) + ("meter" nil ("value") ("min") ("max") ("low") ("high") + ("optimum")) ("nav" \n) ("nobr") + ("noframes" \n) + ("noscript" \n) + ("object" \n ("declare" "declare") ("classid") ("codebase") + ("data") ("type") ("codetype") ("archive") ("standby") + ("height") ("width") ("usemap") ("name") ("tabindex")) + ("optgroup" \n ("name") ("size") ("multiple" "multiple") + ("disabled" "disabled") ("tabindex") ("onfocus") ("onblur") + ("onchange")) ("option" t ("value") ("label") ("selected" t)) + ("output" nil ("for") ("form") ("name")) ("over" t) + ("param" t ("name") ("value") + ("valuetype" ("data") ("ref") ("object")) ("type")) ("person") ;; Tag for person's name tag deprecated in HTML 3.2 ("pre" \n) - ("q") + ("progress" nil ("value") ("max")) + ("q" nil ("cite")) ("rev") + ("rp" t) + ("rt" t) + ("ruby") ("s") ("samp") + ("script" nil ("charset") ("type") ("src") ("defer" "defer")) ("section" \n) ("small") + ("source" t ("src") ("type") ("media")) ("span" nil ("class" ("builtin") @@ -1924,39 +2002,60 @@ This takes effect when first loading the library.") ("variable-name") ("warning"))) ("strong") + ("style" \n ("type") ("media") ("title")) ("sub") + ("summary") ("sup") + ("time" nil ("datetime")) ("title") ("tr" t) + ("track" t + ("kind" ("subtitles") ("captions") ("descriptions") + ("chapters") ("metadata")) + ("src") ("srclang") ("label") ("default")) ("tt") ("u") ("var") + ("video" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("poster") ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls") ("width") ("height")) ("wbr" t))) "Value of `sgml-tag-alist' for HTML mode.") (defvar html-tag-help `(,@sgml-tag-help ("a" . "Anchor of point or link elsewhere") - ("abbrev" . "Abbreviation") + ("abbr" . "Abbreviation") ("acronym" . "Acronym") ("address" . "Formatted mail address") + ("area" . "Region of an image map") ("array" . "Math array") ("article" . "An independent part of document or site") ("aside" . "Secondary content related to surrounding content (e.g. page or article)") ("au" . "Author") + ("audio" . "Sound or audio stream") ("b" . "Bold face") ("base" . "Base address for URLs") + ("bdi" . "Text isolated for bidirectional formatting") + ("bdo" . "Override text directionality") ("big" . "Font size") ("blink" . "Blinking text") ("blockquote" . "Indented quotation") ("body" . "Document body") ("box" . "Math fraction") ("br" . "Line break") + ("button" . "Clickable button") + ("canvas" . "Script generated graphics canvas") ("caption" . "Table caption") ("center" . "Centered text") ("changed" . "Change bars") ("cite" . "Citation of a document") ("code" . "Formatted source code") + ("col" . "Group of attribute specifications for table columns") + ("colgroup" . "Group of columns") + ("datalist" . "A set of predefined options") ("dd" . "Definition of term") ("del" . "Deleted text") ("dfn" . "Defining instance of a term") @@ -1966,14 +2065,19 @@ This takes effect when first loading the library.") ("dt" . "Term to be defined") ("em" . "Emphasized") ("embed" . "Embedded data in foreign format") + ("fieldset" . "Group of related controls and labels") ("fig" . "Figure") ("figa" . "Figure anchor") + ("figcaption" . "Caption for a figure") ("figd" . "Figure description") ("figt" . "Figure text") + ("figure" . "Self-contained content, often with a caption") ("fn" . "Footnote") ;; No one supports special footnote rendering. ("font" . "Font size") ("footer" . "Footer of a section") ("form" . "Form with input fields") + ("frame" . "Frame in which another HTML document can be displayed") + ("frameset" . "Container for frames") ("group" . "Document grouping") ("h1" . "Most important section headline") ("h2" . "Important section headline") @@ -1987,50 +2091,78 @@ This takes effect when first loading the library.") ("hr" . "Horizontal rule") ("html" . "HTML Document") ("i" . "Italic face") + ("iframe" . "Inline frame with a nested browsing context") ("img" . "Graphic image") ("input" . "Form input field") ("ins" . "Inserted text") ("isindex" . "Input field for index search") ("kbd" . "Keyboard example face") + ("label" . "Caption for a user interface item") ("lang" . "Natural language") + ("legend" . "Caption for a fieldset") ("li" . "List item") ("link" . "Link relationship") + ("main" . "Main content of the document body") + ("map" . "Image map (a clickable link area") + ("mark" . "Highlighted text") ("math" . "Math formula") ("menu" . "List of commands") + ("meta" . "Document properties") + ("meter" . "Scalar measurement within a known range") ("mh" . "Form mail header") ("nav" . "Group of navigational links") ("nextid" . "Allocate new id") ("nobr" . "Text without line break") + ("noframes" . "Content for user agents that don't support frames") + ("noscript" . "Alternate content for when a script isn't executed") + ("object" . "External resource") ("ol" . "Ordered list") + ("optgroup" . "Group of options") ("option" . "Selection list item") + ("output" . "Result of a calculation or user action") ("over" . "Math fraction rule") ("p" . "Paragraph start") ("panel" . "Floating panel") + ("param" . "Parameters for an object") ("person" . "Person's name") ("pre" . "Preformatted fixed width text") + ("progress" . "Completion progress of a task") ("q" . "Quotation") ("rev" . "Reverse video") + ("rp" . "Fallback text for when ruby annotations aren't supported") + ("rt" . "Ruby text component of a ruby annotation") + ("ruby" . "Ruby annotation") ("s" . "Strikeout") ("samp" . "Sample text") + ("script" . "Executable script within a document") ("section" . "Section of a document") ("select" . "Selection list") ("small" . "Font size") + ("source" . "Media resource for media elements") ("sp" . "Nobreak space") ("span" . "Generic inline container") ("strong" . "Standout text") + ("style" . "Style information") ("sub" . "Subscript") + ("summary" . "Summary, caption, or legend") ("sup" . "Superscript") ("table" . "Table with rows and columns") ("tb" . "Table vertical break") + ("tbody" . "Table body") ("td" . "Table data cell") ("textarea" . "Form multiline edit area") + ("tfoot" . "Table foot") ("th" . "Table header cell") + ("thead" . "Table head") + ("time" . "Content with optional machine-readable timestamp") ("title" . "Document title") ("tr" . "Table row separator") + ("track" . "Timed text track for media elements") ("tt" . "Typewriter face") ("u" . "Underlined text") ("ul" . "Unordered list") ("var" . "Math variable face") + ("video" . "Video or movie") ("wbr" . "Enable <br> within <nobr>")) "Value of variable `sgml-tag-help' for HTML mode.") @@ -2051,6 +2183,55 @@ This takes effect when first loading the library.") nil t) (match-string-no-properties 1)))) +(defvar html--buffer-classes-cache nil + "Cache for `html-current-buffer-classes'. +When set, this should be a cons cell where the CAR is the +buffer's tick counter (as produced by `buffer-modified-tick'), +and the CDR is the list of class names found in the buffer.") +(make-variable-buffer-local 'html--buffer-classes-cache) + +(defvar html--buffer-ids-cache nil + "Cache for `html-current-buffer-ids'. +When set, this should be a cons cell where the CAR is the +buffer's tick counter (as produced by `buffer-modified-tick'), +and the CDR is the list of class names found in the buffer.") +(make-variable-buffer-local 'html--buffer-ids-cache) + +(defun html-current-buffer-classes () + "Return a list of class names used in the current buffer. +The result is cached in `html--buffer-classes-cache'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-classes-cache) tick) + (cdr html--buffer-classes-cache) + (let* ((dom (libxml-parse-html-region (point-min) (point-max))) + (classes + (seq-mapcat + (lambda (el) + (when-let (class-list + (cdr (assq 'class (dom-attributes el)))) + (split-string class-list))) + (dom-by-class dom "")))) + (setq-local html--buffer-classes-cache (cons tick classes)) + classes)))) + +(defun html-current-buffer-ids () + "Return a list of IDs used in the current buffer. +The result is cached in `html--buffer-ids-cache'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-ids-cache) tick) + (cdr html--buffer-ids-cache) + (let* ((dom + (libxml-parse-html-region (point-min) (point-max))) + (ids + (seq-mapcat + (lambda (el) + (when-let (id-list + (cdr (assq 'id (dom-attributes el)))) + (split-string id-list))) + (dom-by-id dom "")))) + (setq-local html--buffer-ids-cache (cons tick ids)) + ids)))) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") @@ -2101,6 +2282,12 @@ To work around that, do: (setq-local add-log-current-defun-function #'html-current-defun-name) (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*") + (when (fboundp 'libxml-parse-html-region) + (defvar css-class-list-function) + (setq-local css-class-list-function #'html-current-buffer-classes) + (defvar css-id-list-function) + (setq-local css-id-list-function #'html-current-buffer-ids)) + (setq imenu-create-index-function 'html-imenu-index) (setq-local sgml-empty-tags diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 653db83107d..e12a34095bb 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -641,7 +641,7 @@ "Text based table manipulation utilities." :tag "Table" :prefix "table-" - :group 'wp + :group 'text :version "22.1") (defgroup table-hooks nil @@ -936,6 +936,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu ([(shift backtab)] . table-backward-cell) ; for HPUX console keyboard ([(shift iso-lefttab)] . table-backward-cell) ; shift-tab on a microsoft natural keyboard and redhat linux ([(shift tab)] . table-backward-cell) + ([backtab] . table-backward-cell) ; for terminals (e.g., xterm) ([return] . *table--cell-newline) ([(control m)] . *table--cell-newline) ([(control j)] . *table--cell-newline-and-indent) @@ -2967,8 +2968,7 @@ CALS (DocBook DTD): (default (car table-source-language-history)) (language (downcase (completing-read (format "Language (default %s): " default) - (mapcar (lambda (s) (list (symbol-name s))) - table-source-languages) + table-source-languages nil t nil 'table-source-language-history default)))) (list (intern language) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5b1bd6a05bc..1363efea310 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -505,7 +505,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (funcall inbraces-re (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) "*}\\)+\\$?\\$") - (0 tex-math-face)) + (0 'tex-math)) ;; Heading args. (,(concat slash headings "\\*?" opt arg) ;; If ARG ends up matching too much (if the {} don't match, e.g.) @@ -735,7 +735,8 @@ automatically inserts its partner." (let ((arg-end (match-end 0))) (if (null type) ;\end (progn (goto-char arg-end) - (latex-forward-sexp -1) (forward-word 1)) + (latex-forward-sexp -1) + (forward-word-strictly 1)) (goto-char cmd-start) (latex-forward-sexp 1) (let (forward-sexp-function) (backward-sexp))) @@ -799,16 +800,11 @@ Not smaller than the value set by `tex-suscript-height-minimum'." '((t :inherit font-lock-string-face)) "Face used to highlight TeX math expressions." :group 'tex) -(define-obsolete-face-alias 'tex-math-face 'tex-math "22.1") -(defvar tex-math-face 'tex-math) (defface tex-verbatim - ;; '((t :inherit font-lock-string-face)) - '((t :family "courier")) + '((t :inherit fixed-pitch-serif)) "Face used to highlight TeX verbatim environments." :group 'tex) -(define-obsolete-face-alias 'tex-verbatim-face 'tex-verbatim "22.1") -(defvar tex-verbatim-face 'tex-verbatim) (defun tex-font-lock-verb (start delim) "Place syntax table properties on the \\verb construct. @@ -836,10 +832,10 @@ START is the position of the \\ and DELIM is the delimiter char." (let ((char (nth 3 state))) (cond ((not char) - (if (eq 2 (nth 7 state)) tex-verbatim-face font-lock-comment-face)) - ((eq char ?$) tex-math-face) + (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) + ((eq char ?$) 'tex-math) ;; A \verb element. - (t tex-verbatim-face)))) + (t 'tex-verbatim)))) (defun tex-define-common-keys (keymap) @@ -872,7 +868,7 @@ START is the position of the \\ and DELIM is the delimiter char." (set-keymap-parent map text-mode-map) (tex-define-common-keys map) (define-key map "\"" 'tex-insert-quote) - (define-key map "\n" 'tex-terminate-paragraph) + (define-key map "\n" 'tex-handle-newline) (define-key map "\M-\r" 'latex-insert-item) (define-key map "\C-c}" 'up-list) (define-key map "\C-c{" 'tex-insert-braces) @@ -1315,6 +1311,7 @@ inserts \" characters." ;; (if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\)) (eq (get-text-property (point) 'face) 'tex-verbatim) + (nth 4 (syntax-ppss)) ; non-nil if point is in a TeX comment ;; Discover if a preceding occurrence of `tex-open-quote' ;; should be morphed to a normal double quote. ;; @@ -1466,6 +1463,17 @@ area if a mismatch is found." (if failure-point (goto-char failure-point)) (not failure-point))) +(defun tex-handle-newline (inhibit-validation) + "Break a TeX paragraph with two newlines, or continue a comment. +If not in a comment, insert two newlines, breaking a paragraph for TeX, +and check for mismatched braces or $s in the paragraph being terminated +unless prefix arg INHIBIT-VALIDATION is non-nil to inhibit the checking. +Otherwise (in a comment), just insert a single continued comment line." + (interactive "*P") + (if (nth 4 (syntax-ppss)) ; non-nil if point is in a TeX comment + (comment-indent-new-line) + (tex-terminate-paragraph inhibit-validation))) + (defun tex-terminate-paragraph (inhibit-validation) "Insert two newlines, breaking a paragraph for TeX. Check for mismatched braces or $s in paragraph being terminated. @@ -2994,7 +3002,7 @@ There might be text before point." ("\\sigma" . ?σ) ("\\tau" . ?τ) ("\\upsilon" . ?υ) - ("\\phi" . ?φ) + ("\\phi" . ?ϕ) ("\\chi" . ?χ) ("\\psi" . ?ψ) ("\\omega" . ?ω) @@ -3383,10 +3391,11 @@ There might be text before point." ("\\u{i}" . ?ĭ) ("\\vDash" . ?⊨) ("\\varepsilon" . ?ε) + ("\\varphi" . ?φ) ("\\varprime" . ?′) ("\\varpropto" . ?∝) ("\\varrho" . ?ϱ) - ;; ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var. + ("\\varsigma" ?ς) ("\\vartriangleleft" . ?⊲) ("\\vartriangleright" . ?⊳) ("\\vdash" . ?⊢) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 19a21237d2b..55be7fe9df5 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -891,7 +891,7 @@ commands." ;; @ is followed by a command-word; find the end of the word. (setq texinfo-command-start (1- (point))) (if (= (char-syntax (following-char)) ?w) - (forward-word 1) + (forward-word-strictly 1) (forward-char 1)) (setq texinfo-command-end (point)) ;; Detect the case of two @-commands in a row; @@ -1190,7 +1190,7 @@ Leave point after argument." (forward-paragraph) (let ((end (point))) (if (save-excursion - (backward-word 1) + (backward-word-strictly 1) (search-forward "@refill" end t)) (setq anchor-string "@anchor-yes-refill") (setq anchor-string "@anchor-no-refill"))) @@ -2003,7 +2003,7 @@ commands that are defined in texinfo.tex for printed output. (error "In @multitable, @columnfractions misspelled")) ;; Case 1: @columnfractions .25 .3 .45 ((looking-at "@columnfractions") - (forward-word 1) + (forward-word-strictly 1) (while (not (eolp)) (push (truncate (1- @@ -2118,7 +2118,7 @@ This command is executed when texinfmt sees @item inside @multitable." ;; Delete the @tab command, including the @-sign (delete-region (point) - (progn (forward-word -1) (1- (point))))) + (progn (forward-word-strictly -1) (1- (point))))) (point))) ;; Set fill-column *wider* than needed to produce inter-column space (setq fill-column (+ 1 diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 12a991163b3..bc82bb6d0a4 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -351,8 +351,6 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") '((t (:inherit font-lock-function-name-face))) "Face used for section headings in `texinfo-mode'." :group 'texinfo) -(define-obsolete-face-alias 'texinfo-heading-face 'texinfo-heading "22.1") -(defvar texinfo-heading-face 'texinfo-heading) (defvar texinfo-font-lock-keywords `(;; All but the first had an OVERRIDE of t. @@ -380,7 +378,8 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") ;; (,texinfo-environment-regexp ;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep) (,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t) - ".*\n") 0 texinfo-heading-face t)) + ".*\n") + 0 'texinfo-heading t)) "Additional expressions to highlight in Texinfo mode.") (defun texinfo-clone-environment (start end) @@ -393,7 +392,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (unless (get-char-property start 'text-clones) (if endp (texinfo-last-unended-begin) - (forward-word 1) + (forward-word-strictly 1) (texinfo-next-unmatched-end)) (skip-syntax-forward "^w") (when (looking-at @@ -738,7 +737,7 @@ With prefix argument or inside @code or @example, inserts a plain \"." "Insert the matching `@end' for the last Texinfo command that needs one." (ignore-errors (save-excursion - (backward-word 1) + (backward-word-strictly 1) (texinfo-last-unended-begin) (or (match-string 1) '-))) \n "@end " str \n \n) diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index 8f401323445..b01c678ffec 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -519,7 +519,7 @@ line. If there is no node name, returns an empty string." (save-excursion (buffer-substring - (progn (forward-word 1) ; skip over node command + (progn (forward-word-strictly 1) ; skip over node command (skip-chars-forward " \t") ; and over spaces (point)) (if (search-forward "," (line-end-position) t) ; bound search @@ -542,7 +542,7 @@ must have been done by `texinfo-menu-locate-entry-p'." (goto-char (match-beginning 7)) ; match section name (buffer-substring - (progn (forward-word 1) ; skip over section type + (progn (forward-word-strictly 1) ; skip over section type (skip-chars-forward " \t") ; and over spaces (point)) (progn (end-of-line) (point)))) @@ -794,7 +794,7 @@ complements the node name rather than repeats it as a title does." (setq title (buffer-substring ;; skip over section type - (progn (forward-word 1) + (progn (forward-word-strictly 1) ;; and over spaces (skip-chars-forward " \t") (point)) @@ -1104,7 +1104,7 @@ point." t) (progn (beginning-of-line) - (forward-word 1) ; skip over section type + (forward-word-strictly 1) ; skip over section type (skip-chars-forward " \t") ; and over spaces (buffer-substring (point) @@ -1167,7 +1167,7 @@ error if the node is not the top node and a section is not found." (setq sec-name (buffer-substring-no-properties (progn (beginning-of-line) ; copy its name (1+ (point))) - (progn (forward-word 1) + (progn (forward-word-strictly 1) (point)))))) (cond ((or sec-pos top-pos) @@ -1374,7 +1374,7 @@ Point must be at beginning of node line. Does not move point." (save-excursion (let ((initial (texinfo-copy-next-section-title))) ;; This is not clean. Use `interactive' to read the arg. - (forward-word 1) ; skip over node command + (forward-word-strictly 1) ; skip over node command (skip-chars-forward " \t") ; and over spaces (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what Info looks for ; alternatively, use "[a-zA-Z]+" @@ -1700,7 +1700,7 @@ node names in pre-existing `@node' lines that lack names." (if title-p (progn (beginning-of-line) - (forward-word 1) + (forward-word-strictly 1) (skip-chars-forward " \t") (setq title (buffer-substring (point) @@ -1713,7 +1713,7 @@ node names in pre-existing `@node' lines that lack names." (line-beginning-position -1)) t) ;; @node is present, and point at beginning of that line - (forward-word 1) ; Leave point just after @node. + (forward-word-strictly 1) ; Leave point just after @node. ;; Else @node missing; insert one. (beginning-of-line) ; Beginning of `@section' line. (insert "@node\n") @@ -1728,7 +1728,7 @@ node names in pre-existing `@node' lines that lack names." (if (not (looking-at "[^,\t\n ]+")) (progn (beginning-of-line) - (forward-word 1) + (forward-word-strictly 1) (insert " " title) (message "Inserted title %s ... " title))))) ;; Go forward beyond current section title. @@ -1813,7 +1813,7 @@ same place. If there is no title, returns an empty string." ;; copy title (let ((title (buffer-substring - (progn (forward-word 1) ; skip over section type + (progn (forward-word-strictly 1) ; skip over section type (skip-chars-forward " \t") ; and over spaces (point)) (progn (end-of-line) (point))))) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 731c2d2d85d..30873e1dfdb 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -35,7 +35,7 @@ "Normal hook run when entering Text mode and many related modes." :type 'hook :options '(turn-on-auto-fill turn-on-flyspell) - :group 'wp) + :group 'text) (defvar text-mode-variant nil "Non-nil if this buffer's major mode is a variant of Text mode. @@ -232,4 +232,6 @@ The argument NLINES says how many lines to center." (setq nlines (1+ nlines)) (forward-line -1))))) +(provide 'text-mode) + ;;; text-mode.el ends here diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 598060e9ec8..cd258b8c970 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -54,7 +54,7 @@ (defgroup tildify nil "Add hard spaces or other text fragments to text buffers." :version "21.1" - :group 'wp) + :group 'text) (defcustom tildify-pattern "\\(?:[,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(?:\\w\\|[([{\\]\\|<[a-zA-Z]\\)" diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 9920fa06d0c..e4236309529 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -219,22 +219,17 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." (defun thing-at-point-bounds-of-list-at-point () "Return the bounds of the list at point. -[Internal function used by `bounds-of-thing-at-point'.]" +\[Internal function used by `bounds-of-thing-at-point'.]" (save-excursion - (let ((opoint (point)) - (beg (ignore-errors - (up-list -1) - (point)))) - (ignore-errors - (if beg - (progn (forward-sexp) - (cons beg (point))) - ;; Are we are at the beginning of a top-level sexp? - (forward-sexp) - (let ((end (point))) - (backward-sexp) - (if (>= opoint (point)) - (cons opoint end)))))))) + (let* ((st (parse-partial-sexp (point-min) (point))) + (beg (or (and (eq 4 (car (syntax-after (point)))) + (not (nth 8 st)) + (point)) + (nth 1 st)))) + (when beg + (goto-char beg) + (forward-sexp) + (cons beg (point)))))) ;; Defuns @@ -586,9 +581,11 @@ Signal an error if the entire string was not used." "This is an internal thingatpt function and should not be used.") (defun form-at-point (&optional thing pred) - (let ((sexp (ignore-errors - (thing-at-point--read-from-whole-string - (thing-at-point (or thing 'sexp)))))) + (let* ((obj (thing-at-point (or thing 'sexp))) + (sexp (if (stringp obj) + (ignore-errors + (thing-at-point--read-from-whole-string obj)) + obj))) (if (or (not pred) (funcall pred sexp)) sexp))) ;;;###autoload @@ -603,7 +600,10 @@ Signal an error if the entire string was not used." ;;;###autoload (defun number-at-point () "Return the number at point, or nil if none is found." - (form-at-point 'sexp 'numberp)) + (when (thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500) + (string-to-number + (buffer-substring (match-beginning 0) (match-end 0))))) + (put 'number 'thing-at-point 'number-at-point) ;;;###autoload (defun list-at-point () diff --git a/lisp/time.el b/lisp/time.el index e0d39b19586..b507fe9df02 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -108,7 +108,10 @@ A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used." :type 'boolean :group 'display-time) -(defvar display-time-string nil) +(defvar display-time-string nil + "String used in mode lines to display a time string. +It should not be set directly, but is instead updated by the +`display-time' function.") ;;;###autoload(put 'display-time-string 'risky-local-variable t) (defcustom display-time-hook nil @@ -303,15 +306,15 @@ This expression is a list of expressions that can involve the keywords `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', and `time-zone' all alphabetic strings, and `mail' a true/nil value. -For example, the form +For example: - '((substring year -2) \"/\" month \"/\" day + ((substring year -2) \"/\" month \"/\" day \" \" 24-hours \":\" minutes \":\" seconds (if time-zone \" (\") time-zone (if time-zone \")\") (if mail \" Mail\" \"\")) would give mode line times like `94/12/30 21:07:48 (UTC)'." - :type 'sexp + :type '(repeat sexp) :group 'display-time) (defun display-time-event-handler () @@ -532,7 +535,8 @@ See `display-time-world'." (setq fmt (concat "%-" (int-to-string max-width) "s %s\n")) (dolist (timedata (nreverse result)) (insert (format fmt (car timedata) (cdr timedata)))) - (delete-char -1))) + (delete-char -1)) + (goto-char (point-min))) ;;;###autoload (defun display-time-world () diff --git a/lisp/tmm.el b/lisp/tmm.el index 714de9230e7..d1a08ab2623 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -72,13 +72,15 @@ to invoke `tmm-menubar' instead, customize the variable (tmm-get-keybind [menu-bar])) (setq menu-bar `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end))) (if x-position - (let ((column 0)) + (let ((column 0) + prev-key) (catch 'done (map-keymap (lambda (key binding) (when (> column x-position) - (setq menu-bar-item key) + (setq menu-bar-item prev-key) (throw 'done nil)) + (setq prev-key key) (pcase binding ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. `(menu-item ,name ,_cmd ;Extended menu item. @@ -187,7 +189,6 @@ Its value should be an event that has a binding in MENU." ((vectorp elt) (dotimes (i (length elt)) (tmm-get-keymap (cons i (aref elt i)) not-menu)))))) - (setq tmm-km-list (nreverse tmm-km-list)) ;; Choose an element of tmm-km-list; put it in choice. (if (and not-menu (= 1 (length tmm-km-list))) ;; If this is the top-level of an x-popup-menu menu, @@ -239,10 +240,17 @@ Its value should be an event that has a binding in MENU." (if default-item (car (nth index-of-default tmm-km-list)) (minibuffer-with-setup-hook #'tmm-add-prompt + ;; tmm-km-list is reversed, because history + ;; needs it in LIFO order. But completion + ;; needs it in non-reverse order, so that the + ;; menu items are displayed as completion + ;; candidates in the order they are shown on + ;; the menu bar. So pass completing-read the + ;; reversed copy of the list. (completing-read (concat gl-str " (up/down to change, PgUp to menu): ") - (tmm--completion-table tmm-km-list) nil t nil + (tmm--completion-table (reverse tmm-km-list)) nil t nil (cons 'tmm--history (- (* 2 history-len) index-of-default)))))))) (setq choice (cdr (assoc out tmm-km-list))) diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index b2eceb0da10..a2aa97c2799 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -1,4 +1,4 @@ -;;; url-auth.el --- Uniform Resource Locator authorization modules +;;; url-auth.el --- Uniform Resource Locator authorization modules -*- lexical-binding: t -*- ;; Copyright (C) 1996-1999, 2004-2016 Free Software Foundation, Inc. @@ -53,7 +53,7 @@ lists. The first assoc list is keyed by the server name. The cdr of this is an assoc list based on the \"directory\" specified by the URL we are looking up.") -(defun url-basic-auth (url &optional prompt overwrite realm args) +(defun url-basic-auth (url &optional prompt overwrite realm _args) "Get the username/password for the specified URL. If optional argument PROMPT is non-nil, ask for the username/password to use for the url and its descendants. If optional third argument diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index 434b77550d7..48d3ce40f74 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -1,4 +1,4 @@ -;;; url-expand.el --- expand-file-name for URLs +;;; url-expand.el --- expand-file-name for URLs -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2004-2016 Free Software Foundation, Inc. diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 9eb9377583d..61e83c09974 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -27,6 +27,7 @@ (require 'url-vars) (require 'url-parse) (require 'url-dired) +(declare-function mm-disable-multibyte "mm-util" ()) (defconst url-file-default-port 21 "Default FTP port.") (defconst url-file-asynchronous-p t "FTP transfers are asynchronous.") diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index c4005a634cb..12c971c87d6 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -1,4 +1,4 @@ -;;; url-future.el --- general futures facility for url.el +;;; url-future.el --- general futures facility for url.el -*- lexical-binding: t -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index d3be880b382..0fada8d49d7 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -262,11 +262,12 @@ Fifth arg PRESERVE-UID-GID is ignored. A prefix arg makes KEEP-TIME non-nil." (if (and (file-exists-p newname) (not ok-if-already-exists)) - (error "Opening output file: File already exists, %s" newname)) + (signal 'file-already-exists (list "File exists" newname))) (let ((buffer (url-retrieve-synchronously url)) (handle nil)) (if (not buffer) - (error "Opening input file: No such file or directory, %s" url)) + (signal 'file-missing (list "Opening URL" "No such file or directory" + url))) (with-current-buffer buffer (setq handle (mm-dissect-buffer t))) (let ((mm-attachment-file-modes (default-file-modes))) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 33f6d11eef3..81bb9b4721e 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1,4 +1,4 @@ -;;; url-http.el --- HTTP retrieval routines +;;; url-http.el --- HTTP retrieval routines -*- lexical-binding:t -*- ;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc. @@ -27,6 +27,7 @@ (require 'cl-lib) (require 'puny) +(require 'nsm) (eval-when-compile (require 'subr-x)) @@ -127,6 +128,7 @@ request.") (422 unprocessable-entity "Unprocessable Entity (Added by DAV)") (423 locked "Locked") (424 failed-Dependency "Failed Dependency") + (451 unavailable-for-legal-reasons "Unavailable for legal reasons") ;RFC 7725 (500 internal-server-error "Internal server error") (501 not-implemented "Not implemented") (502 bad-gateway "Bad gateway") @@ -136,6 +138,8 @@ request.") (507 insufficient-storage "Insufficient storage")) "The HTTP return codes and their text.") +(defconst url-https-default-port 443 "Default HTTPS port.") + ;(eval-when-compile ;; These are all macros so that they are hidden from external sight ;; when the file is byte-compiled. @@ -197,7 +201,14 @@ request.") ;; `url-open-stream' needs a buffer in which to do things ;; like authentication. But we use another buffer afterwards. (unwind-protect - (let ((proc (url-open-stream host buf host port gateway-method))) + (let ((proc (url-open-stream host buf + (if url-using-proxy + (url-host url-using-proxy) + host) + (if url-using-proxy + (url-port url-using-proxy) + port) + gateway-method))) ;; url-open-stream might return nil. (when (processp proc) ;; Drop the temp buffer link before killing the buffer. @@ -212,15 +223,36 @@ request.") (if connection (url-http-mark-connection-as-busy host port connection)))) +(defun url-http--user-agent-default-string () + "Compute a default User-Agent string based on `url-privacy-level'." + (let ((package-info (when url-package-name + (format "%s/%s" url-package-name url-package-version))) + (emacs-info (unless (and (listp url-privacy-level) + (memq 'emacs url-privacy-level)) + (format "Emacs/%s" emacs-version))) + (os-info (unless (and (listp url-privacy-level) + (memq 'os url-privacy-level)) + (format "(%s; %s)" url-system-type url-os-type))) + (url-info (format "URL/%s" url-version))) + (string-join (delq nil (list package-info url-info + emacs-info os-info)) + " "))) + ;; Building an HTTP request (defun url-http-user-agent-string () - (if (or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'agent url-privacy-level))) - "" - (if (functionp url-user-agent) - (funcall url-user-agent) - url-user-agent))) + "Compute a User-Agent string. +The string is based on `url-privacy-level' and `url-user-agent'." + (let* ((hide-ua + (or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'agent url-privacy-level)))) + (ua-string + (and (not hide-ua) + (cond + ((functionp url-user-agent) (funcall url-user-agent)) + ((stringp url-user-agent) url-user-agent) + ((eq url-user-agent 'default) (url-http--user-agent-default-string)))))) + (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) ""))) (defun url-http-create-request (&optional ref-url) "Create an HTTP request for `url-http-target-url', referred to by REF-URL." @@ -236,7 +268,7 @@ request.") 'url-http-proxy-basic-auth-storage)) (url-get-authentication url-http-proxy nil 'any nil)))) (real-fname (url-filename url-http-target-url)) - (host (url-host url-http-target-url)) + (host (url-http--encode-string (url-host url-http-target-url))) (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) nil (url-get-authentication (or @@ -276,22 +308,11 @@ request.") ;; allows us to elide null lines directly, at the cost of making ;; the layout less clear. (setq request - ;; We used to concat directly, but if one of the strings happens - ;; to being multibyte (even if it only contains pure ASCII) then - ;; every string gets converted with `string-MAKE-multibyte' which - ;; turns the 127-255 codes into things like latin-1 accented chars - ;; (it would work right if it used `string-TO-multibyte' instead). - ;; So to avoid the problem we force every string to be unibyte. - (mapconcat - ;; FIXME: Instead of `string-AS-unibyte' we'd want - ;; `string-to-unibyte', so as to properly signal an error if one - ;; of the strings contains a multibyte char. - 'string-as-unibyte - (delq nil - (list + (concat ;; The request (or url-http-method "GET") " " - (if using-proxy (url-recreate-url url-http-target-url) real-fname) + (url-http--encode-string + (if using-proxy (url-recreate-url url-http-target-url) real-fname)) " HTTP/" url-http-version "\r\n" ;; Version of MIME we speak "MIME-Version: 1.0\r\n" @@ -328,7 +349,9 @@ request.") "Accept-encoding: " url-mime-encoding-string "\r\n")) (if url-mime-charset-string (concat - "Accept-charset: " url-mime-charset-string "\r\n")) + "Accept-charset: " + (url-http--encode-string url-mime-charset-string) + "\r\n")) ;; Languages we understand (if url-mime-language-string (concat @@ -343,9 +366,10 @@ request.") auth ;; Cookies (when (url-use-cookies url-http-target-url) - (url-cookie-generate-header-lines - host real-fname - (equal "https" (url-type url-http-target-url)))) + (url-http--encode-string + (url-cookie-generate-header-lines + host real-fname + (equal "https" (url-type url-http-target-url))))) ;; If-modified-since (if (and (not no-cache) (member url-http-method '("GET" nil))) @@ -367,10 +391,18 @@ request.") "\r\n" ;; Any data url-http-data)) - "")) + ;; Bug#23750 + (unless (= (string-bytes request) + (length request)) + (error "Multibyte text in HTTP request: %s" request)) (url-http-debug "Request is: \n%s" request) request)) +(defun url-http--encode-string (s) + (if (multibyte-string-p s) + (encode-coding-string s 'us-ascii) + s)) + ;; Parsing routines (defun url-http-clean-headers () "Remove trailing \r from header lines. @@ -477,6 +509,7 @@ work correctly." ) (declare-function gnutls-peer-status "gnutls.c" (proc)) +(declare-function gnutls-negotiate "gnutls.el" t t) (defun url-http-parse-headers () "Parse and handle HTTP specific headers. @@ -899,7 +932,7 @@ should be shown to the user." ;; ) ;; These unfortunately cannot be macros... please ignore them! -(defun url-http-idle-sentinel (proc why) +(defun url-http-idle-sentinel (proc _why) "Remove (now defunct) process PROC from the list of open connections." (maphash (lambda (key val) (if (memq proc val) @@ -925,18 +958,24 @@ should be shown to the user." (erase-buffer) (let ((url-request-method url-http-method) (url-request-extra-headers url-http-extra-headers) - (url-request-data url-http-data)) + (url-request-data url-http-data) + (url-using-proxy (url-find-proxy-for-url + url-current-object + (url-host url-current-object)))) + (when url-using-proxy + (setq url-using-proxy + (url-generic-parse-url url-using-proxy))) (url-http url-current-object url-callback-function url-callback-arguments (current-buffer))))) ((url-http-parse-headers) (url-http-activate-callback)))))) -(defun url-http-simple-after-change-function (st nd length) +(defun url-http-simple-after-change-function (_st _nd _length) ;; Function used when we do NOT know how long the document is going to be ;; Just _very_ simple 'downloaded %d' type of info. - (url-lazy-message "Reading %s..." (file-size-human-readable nd))) + (url-lazy-message "Reading %s..." (file-size-human-readable (buffer-size)))) -(defun url-http-content-length-after-change-function (st nd length) +(defun url-http-content-length-after-change-function (_st nd _length) "Function used when we DO know how long the document is going to be. More sophisticated percentage downloaded, etc. Also does minimal parsing of HTTP headers and will actually cause @@ -1055,7 +1094,7 @@ the end of the document." (if (url-http-parse-headers) (url-http-activate-callback)))))))))) -(defun url-http-wait-for-headers-change-function (st nd length) +(defun url-http-wait-for-headers-change-function (_st nd _length) ;; This will wait for the headers to arrive and then splice in the ;; next appropriate after-change-function, etc. (url-http-debug "url-http-wait-for-headers-change-function (%s)" @@ -1063,7 +1102,8 @@ the end of the document." (let ((end-of-headers nil) (old-http nil) (process-buffer (current-buffer)) - (content-length nil)) + ;; (content-length nil) + ) (when (not (bobp)) (goto-char (point-min)) (if (and (looking-at ".*\n") ; have one line at least @@ -1204,22 +1244,25 @@ overriding the value of `url-gateway-method'. The return value of this function is the retrieval buffer." (cl-check-type url vector "Need a pre-parsed URL.") - (let* ((host (url-host (or url-using-proxy url))) - (port (url-port (or url-using-proxy url))) + (let* (;; (host (url-host (or url-using-proxy url))) + ;; (port (url-port (or url-using-proxy url))) (nsm-noninteractive (or url-request-noninteractive (and (boundp 'url-http-noninteractive) url-http-noninteractive))) - (connection (url-http-find-free-connection host port gateway-method)) + (connection (url-http-find-free-connection (url-host url) + (url-port url) + gateway-method)) (mime-accept-string url-mime-accept-string) (buffer (or retry-buffer (generate-new-buffer - (format " *http %s:%d*" host port))))) + (format " *http %s:%d*" (url-host url) (url-port url)))))) (if (not connection) ;; Failed to open the connection for some reason (progn (kill-buffer buffer) (setq buffer nil) - (error "Could not create connection to %s:%d" host port)) + (error "Could not create connection to %s:%d" (url-host url) + (url-port url))) (with-current-buffer buffer (mm-disable-multibyte) (setq url-current-object url @@ -1275,13 +1318,72 @@ The return value of this function is the retrieval buffer." (set-process-sentinel connection 'url-http-async-sentinel)) (`failed ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) + (error "Could not create connection to %s:%d" (url-host url) + (url-port url))) (_ - (set-process-sentinel connection - 'url-http-end-of-document-sentinel) - (process-send-string connection (url-http-create-request)))))) + (if (and url-http-proxy (string= "https" + (url-type url-current-object))) + (url-https-proxy-connect connection) + (set-process-sentinel connection + 'url-http-end-of-document-sentinel) + (process-send-string connection (url-http-create-request))))))) buffer)) +(defun url-https-proxy-connect (connection) + (setq url-http-after-change-function 'url-https-proxy-after-change-function) + (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" + "Host: %s\r\n" + "\r\n") + (url-host url-current-object) + (or (url-port url-current-object) + url-https-default-port) + (url-host url-current-object)))) + +(defun url-https-proxy-after-change-function (_st _nd _length) + (let* ((process-buffer (current-buffer)) + (proc (get-buffer-process process-buffer))) + (goto-char (point-min)) + (when (re-search-forward "^\r?\n" nil t) + (backward-char 1) + ;; Saw the end of the headers + (setq url-http-end-of-headers (set-marker (make-marker) (point))) + (url-http-parse-response) + (cond + ((null url-http-response-status) + ;; We got back a headerless malformed response from the + ;; server. + (url-http-activate-callback) + (error "Malformed response from proxy, fail!")) + ((= url-http-response-status 200) + (if (gnutls-available-p) + (condition-case e + (let ((tls-connection (gnutls-negotiate + :process proc + :hostname (url-host url-current-object) + :verify-error nil))) + ;; check certificate validity + (setq tls-connection + (nsm-verify-connection tls-connection + (url-host url-current-object) + (url-port url-current-object))) + (with-current-buffer process-buffer (erase-buffer)) + (set-process-buffer tls-connection process-buffer) + (setq url-http-after-change-function + 'url-http-wait-for-headers-change-function) + (set-process-filter tls-connection 'url-http-generic-filter) + (process-send-string tls-connection + (url-http-create-request))) + (gnutls-error + (url-http-activate-callback) + (error "gnutls-error: %s" e)) + (error + (url-http-activate-callback) + (error "error: %s" e))) + (error "error: gnutls support needed!"))) + (t + (message "error response: %d" url-http-response-status) + (url-http-activate-callback)))))) + (defun url-http-async-sentinel (proc why) ;; We are performing an asynchronous connection, and a status change ;; has occurred. @@ -1293,11 +1395,13 @@ The return value of this function is the retrieval buffer." (url-http-end-of-document-sentinel proc why)) ((string= (substring why 0 4) "open") (setq url-http-connection-opened t) - (condition-case error - (process-send-string proc (url-http-create-request)) - (file-error - (setq url-http-connection-opened nil) - (message "HTTP error: %s" error)))) + (if (and url-http-proxy (string= "https" (url-type url-current-object))) + (url-https-proxy-connect proc) + (condition-case error + (process-send-string proc (url-http-create-request)) + (file-error + (setq url-http-connection-opened nil) + (message "HTTP error: %s" error))))) (t (setf (car url-callback-arguments) (nconc (list :error (list 'error 'connection-failed why @@ -1359,7 +1463,7 @@ The return value of this function is the retrieval buffer." (defalias 'url-http-file-readable-p 'url-http-file-exists-p) -(defun url-http-head-file-attributes (url &optional id-format) +(defun url-http-head-file-attributes (url &optional _id-format) (let ((buffer (url-http-head url))) (when buffer (prog1 @@ -1374,7 +1478,7 @@ The return value of this function is the retrieval buffer." nil nil nil) ;whether gid would change ; inode ; device. (kill-buffer buffer))))) -(declare-function url-dav-file-attributes "url-dav" (url &optional id-format)) +(declare-function url-dav-file-attributes "url-dav" (url &optional _id-format)) (defun url-http-file-attributes (url &optional id-format) (if (url-dav-supported-p url) @@ -1458,7 +1562,6 @@ p3p ;; with url-http.el on systems with 8-character file names. (require 'tls) -(defconst url-https-default-port 443 "Default HTTPS port.") (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") ;; FIXME what is the point of this alias being an autoload? diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el index 2c277fb69c2..14b9f7eab44 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el @@ -24,6 +24,7 @@ (require 'url-vars) (require 'url-parse) +(declare-function mm-disable-multibyte "mm-util" ()) (autoload 'Info-goto-node "info" "" t) (autoload 'man "man" nil t) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 6e51b35f5a1..c0e386d0385 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -1,4 +1,4 @@ -;;; url-parse.el --- Uniform Resource Locator parser +;;; url-parse.el --- Uniform Resource Locator parser -*- lexical-binding: t -*- ;; Copyright (C) 1996-1999, 2004-2016 Free Software Foundation, Inc. @@ -224,7 +224,7 @@ parses to fragment nil full)))))) (defmacro url-bit-for-url (method lookfor url) - `(let* ((urlobj (url-generic-parse-url url)) + `(let* ((urlobj (url-generic-parse-url ,url)) (bit (funcall ,method urlobj)) (methods (list 'url-recreate-url 'url-host)) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index af18acd8b6a..a3844f9e32e 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -1,4 +1,4 @@ -;;; url-util.el --- Miscellaneous helper routines for URL library +;;; url-util.el --- Miscellaneous helper routines for URL library -*- lexical-binding: t -*- ;; Copyright (C) 1996-1999, 2001, 2004-2016 Free Software Foundation, ;; Inc. diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 960a04ad30f..1286d6cda98 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -116,6 +116,7 @@ If a list, this should be a list of symbols of what NOT to send. Valid symbols are: email -- the email address os -- the operating system info +emacs -- the version of Emacs lastloc -- the last location agent -- do not send the User-Agent string cookies -- never accept HTTP cookies @@ -143,6 +144,7 @@ variable." (checklist :tag "Custom" (const :tag "Email address" :value email) (const :tag "Operating system" :value os) + (const :tag "Emacs version" :value emacs) (const :tag "Last location" :value lastloc) (const :tag "Browser identification" :value agent) (const :tag "No cookies" :value cookie))) @@ -357,16 +359,21 @@ Currently supported methods: (const :tag "Direct connection" :value native)) :group 'url-hairy) -(defcustom url-user-agent (format "User-Agent: %sURL/%s\r\n" - (if url-package-name - (concat url-package-name "/" - url-package-version " ") - "") url-version) - "User Agent used by the URL package for HTTP/HTTPS requests -Should be a string or a function of no arguments returning a string." - :type '(choice (string :tag "A static User-Agent string") - (function :tag "Call a function to get the User-Agent string")) - :version "25.1" +(defcustom url-user-agent 'default + "User Agent used by the URL package for HTTP/HTTPS requests. +Should be one of: +* A string (not including the \"User-Agent:\" prefix) +* A function of no arguments, returning a string +* `default' (to compute a value according to `url-privacy-level') +* nil (to omit the User-Agent header entirely)" + :type + '(choice + (string :tag "A static User-Agent string") + (function :tag "Call a function to get the User-Agent string") + (const :tag "No User-Agent at all" :value nil) + (const :tag "An string auto-generated according to `url-privacy-level'" + :value default)) + :version "26.1" :group 'url) (defvar url-setup-done nil "Has setup configuration been done?") diff --git a/lisp/url/url.el b/lisp/url/url.el index 4837ba07f7e..6d710e02d63 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -221,14 +221,20 @@ URL-encoded before it's used." buffer)) ;;;###autoload -(defun url-retrieve-synchronously (url &optional silent inhibit-cookies) +(defun url-retrieve-synchronously (url &optional silent inhibit-cookies timeout) "Retrieve URL synchronously. Return the buffer containing the data, or nil if there are no data associated with it (the case for dired, info, or mailto URLs that need -no further processing). URL is either a string or a parsed URL." +no further processing). URL is either a string or a parsed URL. + +If SILENT is non-nil, don't do any messaging while retrieving. +If INHIBIT-COOKIES is non-nil, refuse to store cookies. If +TIMEOUT is passed, it should be a number that says (in seconds) +how long to wait for a response before giving up." (url-do-setup) (let ((retrieval-done nil) + (start-time (current-time)) (asynch-buffer nil)) (setq asynch-buffer (url-retrieve url (lambda (&rest ignored) @@ -250,7 +256,11 @@ no further processing). URL is either a string or a parsed URL." ;; buffer-local variable so we can find the exact process that we ;; should be waiting for. In the mean time, we'll just wait for any ;; process output. - (while (not retrieval-done) + (while (and (not retrieval-done) + (or (not timeout) + (< (float-time (time-subtract + (current-time) start-time)) + timeout))) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) @@ -281,7 +291,7 @@ no further processing). URL is either a string or a parsed URL." ;; `sleep-for' was tried but it lead to other forms of ;; hanging. --Stef (unless (or (with-local-quit - (accept-process-output proc)) + (accept-process-output proc 1)) (null proc)) ;; accept-process-output returned nil, maybe because the process ;; exited (and may have been replaced with another). If we got diff --git a/lisp/userlock.el b/lisp/userlock.el index a0c55fd1e13..1cfc3b9d64a 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -97,6 +97,41 @@ You can <q>uit; don't modify this file.") (define-error 'file-supersession nil 'file-error) +(defun userlock--check-content-unchanged (fn) + (with-demoted-errors "Unchanged content check: %S" + ;; Even tho we receive `fn', we know that `fn' refers to the current + ;; buffer's file. + (cl-assert (equal fn (expand-file-name buffer-file-truename))) + ;; Note: rather than read the file and compare to the buffer, we could save + ;; the buffer and compare to the file, but for encrypted data this + ;; wouldn't work well (and would risk exposing the data). + (save-restriction + (widen) + (let ((buf (current-buffer)) + (cs buffer-file-coding-system) + (start (point-min)) + (end (point-max))) + ;; FIXME: To avoid a slow `insert-file-contents' on large or + ;; remote files, it'd be good to include file size in the + ;; "visited-modtime" check. + (when (with-temp-buffer + (let ((coding-system-for-read cs) + (non-essential t)) + (insert-file-contents fn)) + (when (= (buffer-size) (- end start)) ;Minor optimization. + (= 0 (let ((case-fold-search nil)) + (compare-buffer-substrings + buf start end + (current-buffer) (point-min) (point-max)))))) + (set-visited-file-modtime) + 'unchanged))))) + +;;;###autoload +(defun userlock--ask-user-about-supersession-threat (fn) + ;; Called from filelock.c. + (unless (userlock--check-content-unchanged fn) + (ask-user-about-supersession-threat fn))) + ;;;###autoload (defun ask-user-about-supersession-threat (fn) "Ask a user who is about to modify an obsolete buffer what to do. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index d6c1fc203db..ba710b2f4f9 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -175,7 +175,7 @@ Note: The search is conducted only within 10%, at the beginning of the file." "List of files that cause `find-change-log' to stop in containing directory. This applies if no pre-existing ChangeLog is found. If nil, then in such a case simply use the directory containing the changed file." - :version "25.2" + :version "26.1" :type '(repeat file) :group 'change-log) @@ -184,51 +184,42 @@ a case simply use the directory containing the changed file." "Face used to highlight dates in date lines." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-date-face 'change-log-date "22.1") (defface change-log-name '((t (:inherit font-lock-constant-face))) "Face for highlighting author names." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-name-face 'change-log-name "22.1") (defface change-log-email '((t (:inherit font-lock-variable-name-face))) "Face for highlighting author email addresses." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-email-face 'change-log-email "22.1") (defface change-log-file '((t (:inherit font-lock-function-name-face))) "Face for highlighting file names." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-file-face 'change-log-file "22.1") (defface change-log-list '((t (:inherit font-lock-keyword-face))) "Face for highlighting parenthesized lists of functions or variables." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-list-face 'change-log-list "22.1") (defface change-log-conditionals '((t (:inherit font-lock-variable-name-face))) "Face for highlighting conditionals of the form `[...]'." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-conditionals-face - 'change-log-conditionals "22.1") (defface change-log-function '((t (:inherit font-lock-variable-name-face))) "Face for highlighting items of the form `<....>'." :version "21.1" :group 'change-log) -(define-obsolete-face-alias 'change-log-function-face - 'change-log-function "22.1") (defface change-log-acknowledgment '((t (:inherit font-lock-comment-face))) @@ -237,8 +228,6 @@ a case simply use the directory containing the changed file." :group 'change-log) (define-obsolete-face-alias 'change-log-acknowledgement 'change-log-acknowledgment "24.3") -(define-obsolete-face-alias 'change-log-acknowledgement-face - 'change-log-acknowledgment "22.1") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") @@ -583,33 +572,21 @@ Compatibility function for \\[next-error] invocations." ;; called add-log-time-zone-rule since it's only used from add-log-* code. (defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule) (defvar add-log-time-zone-rule nil - "Time zone used for calculating change log time stamps. -It takes the same format as the TZ argument of `set-time-zone-rule'. -If nil, use local time. -If t, use universal time.") + "Time zone rule used for calculating change log time stamps. +If nil, use local time. If t, use Universal Time. +If a string, interpret as the ZONE argument of `format-time-string'.") (put 'add-log-time-zone-rule 'safe-local-variable (lambda (x) (or (booleanp x) (stringp x)))) (defun add-log-iso8601-time-zone (&optional time zone) - (let* ((utc-offset (or (car (current-time-zone time zone)) 0)) - (sign (if (< utc-offset 0) ?- ?+)) - (sec (abs utc-offset)) - (ss (% sec 60)) - (min (/ sec 60)) - (mm (% min 60)) - (hh (/ min 60))) - (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d") - ((not (zerop mm)) "%c%02d:%02d") - (t "%c%02d")) - sign hh mm ss))) + (declare (obsolete nil "26.1")) + (format-time-string "%:::z" time zone)) (defvar add-log-iso8601-with-time-zone nil) (defun add-log-iso8601-time-string (&optional time zone) - (let ((date (format-time-string "%Y-%m-%d" time zone))) - (if add-log-iso8601-with-time-zone - (concat date " " (add-log-iso8601-time-zone time zone)) - date))) + (format-time-string + (if add-log-iso8601-with-time-zone "%Y-%m-%d %:::z" "%Y-%m-%d") time zone)) (defun change-log-name () "Return (system-dependent) default name for a change log file." diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index bada492a31b..5b48c8d93df 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -243,8 +243,6 @@ well." (t :weight bold)) "`diff-mode' face inherited by hunk and index header faces." :group 'diff-mode) -(define-obsolete-face-alias 'diff-header-face 'diff-header "22.1") -(defvar diff-header-face 'diff-header) (defface diff-file-header '((((class color) (min-colors 88) (background light)) @@ -256,22 +254,16 @@ well." (t :weight bold)) ; :height 1.3 "`diff-mode' face used to highlight file header lines." :group 'diff-mode) -(define-obsolete-face-alias 'diff-file-header-face 'diff-file-header "22.1") -(defvar diff-file-header-face 'diff-file-header) (defface diff-index '((t :inherit diff-file-header)) "`diff-mode' face used to highlight index header lines." :group 'diff-mode) -(define-obsolete-face-alias 'diff-index-face 'diff-index "22.1") -(defvar diff-index-face 'diff-index) (defface diff-hunk-header '((t :inherit diff-header)) "`diff-mode' face used to highlight hunk header lines." :group 'diff-mode) -(define-obsolete-face-alias 'diff-hunk-header-face 'diff-hunk-header "22.1") -(defvar diff-hunk-header-face 'diff-hunk-header) (defface diff-removed '((default @@ -284,8 +276,6 @@ well." :foreground "red")) "`diff-mode' face used to highlight removed lines." :group 'diff-mode) -(define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1") -(defvar diff-removed-face 'diff-removed) (defface diff-added '((default @@ -298,16 +288,12 @@ well." :foreground "green")) "`diff-mode' face used to highlight added lines." :group 'diff-mode) -(define-obsolete-face-alias 'diff-added-face 'diff-added "22.1") -(defvar diff-added-face 'diff-added) (defface diff-changed '((t nil)) "`diff-mode' face used to highlight changed lines." :version "25.1" :group 'diff-mode) -(define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") -(defvar diff-changed-face 'diff-changed) (defface diff-indicator-removed '((t :inherit diff-removed)) @@ -334,8 +320,6 @@ well." '((t :inherit diff-header)) "`diff-mode' face used to highlight function names produced by \"diff -p\"." :group 'diff-mode) -(define-obsolete-face-alias 'diff-function-face 'diff-function "22.1") -(defvar diff-function-face 'diff-function) (defface diff-context '((((class color grayscale) (min-colors 88) (background light)) @@ -345,15 +329,11 @@ well." "`diff-mode' face used to highlight context and other side-information." :version "25.1" :group 'diff-mode) -(define-obsolete-face-alias 'diff-context-face 'diff-context "22.1") -(defvar diff-context-face 'diff-context) (defface diff-nonexistent '((t :inherit diff-file-header)) "`diff-mode' face used to highlight nonexistent files in recursive diffs." :group 'diff-mode) -(define-obsolete-face-alias 'diff-nonexistent-face 'diff-nonexistent "22.1") -(defvar diff-nonexistent-face 'diff-nonexistent) (defconst diff-yank-handler '(diff-yank-function)) (defun diff-yank-function (text) @@ -382,57 +362,57 @@ well." (defconst diff-context-mid-hunk-header-re "--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$") -(defvar diff-use-changed-face (and (face-differs-from-default-p diff-changed-face) - (not (face-equal diff-changed-face diff-added-face)) - (not (face-equal diff-changed-face diff-removed-face))) +(defvar diff-use-changed-face (and (face-differs-from-default-p 'diff-changed) + (not (face-equal 'diff-changed 'diff-added)) + (not (face-equal 'diff-changed 'diff-removed))) "If non-nil, use the face `diff-changed' for changed lines in context diffs. Otherwise, use the face `diff-removed' for removed lines, and the face `diff-added' for added lines.") (defvar diff-font-lock-keywords `((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$") - (1 diff-hunk-header-face) (6 diff-function-face)) + (1 'diff-hunk-header) (6 'diff-function)) ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context - (1 diff-hunk-header-face) (2 diff-function-face)) - ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context - (,diff-context-mid-hunk-header-re . diff-hunk-header-face) ;context - ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal - ("^---$" . diff-hunk-header-face) ;normal + (1 'diff-hunk-header) (2 'diff-function)) + ("^\\*\\*\\* .+ \\*\\*\\*\\*". 'diff-hunk-header) ;context + (,diff-context-mid-hunk-header-re . 'diff-hunk-header) ;context + ("^[0-9,]+[acd][0-9,]+$" . 'diff-hunk-header) ;normal + ("^---$" . 'diff-hunk-header) ;normal ;; For file headers, accept files with spaces, but be careful to rule ;; out false-positives when matching hunk headers. ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+?\\)\\(?:\t.*\\| \\(\\*\\*\\*\\*\\|----\\)\\)?\n" - (0 diff-header-face) - (2 (if (not (match-end 3)) diff-file-header-face) prepend)) + (0 'diff-header) + (2 (if (not (match-end 3)) 'diff-file-header) prepend)) ("^\\([-<]\\)\\(.*\n\\)" - (1 diff-indicator-removed-face) (2 diff-removed-face)) + (1 diff-indicator-removed-face) (2 'diff-removed)) ("^\\([+>]\\)\\(.*\n\\)" - (1 diff-indicator-added-face) (2 diff-added-face)) + (1 diff-indicator-added-face) (2 'diff-added)) ("^\\(!\\)\\(.*\n\\)" (1 (if diff-use-changed-face diff-indicator-changed-face ;; Otherwise, search for `diff-context-mid-hunk-header-re' and - ;; if the line of context diff is above, use `diff-removed-face'; - ;; if below, use `diff-added-face'. + ;; if the line of context diff is above, use `diff-removed'; + ;; if below, use `diff-added'. (save-match-data (let ((limit (save-excursion (diff-beginning-of-hunk)))) (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) diff-indicator-added-face diff-indicator-removed-face))))) (2 (if diff-use-changed-face - diff-changed-face + 'diff-changed ;; Otherwise, use the same method as above. (save-match-data (let ((limit (save-excursion (diff-beginning-of-hunk)))) (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) - diff-added-face - diff-removed-face)))))) + 'diff-added + 'diff-removed)))))) ("^\\(?:Index\\|revno\\): \\(.+\\).*\n" - (0 diff-header-face) (1 diff-index-face prepend)) - ("^Only in .*\n" . diff-nonexistent-face) + (0 'diff-header) (1 'diff-index prepend)) + ("^Only in .*\n" . 'diff-nonexistent) ("^\\(#\\)\\(.*\\)" (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) - ("^[^-=+*!<>#].*\n" (0 diff-context-face)))) + ("^[^-=+*!<>#].*\n" (0 'diff-context)))) (defconst diff-font-lock-defaults '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil))) @@ -571,7 +551,7 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation - diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view + diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view (when diff-auto-refine-mode (unless (prog1 diff--auto-refine-data (setq diff--auto-refine-data @@ -590,7 +570,102 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." (diff-refine-hunk)))))))))))) (easy-mmode-define-navigation - diff-file diff-file-header-re "file" diff-end-of-file) + diff--internal-file diff-file-header-re "file" diff-end-of-file) + +(defun diff--wrap-navigation (skip-hunk-start + what orig + header-re goto-start-func count) + "Wrap diff-{hunk,file}-{next,prev} for more intuitive behavior. +Override the default diff-{hunk,file}-{next,prev} implementation +by skipping any lines that are associated with this hunk/file but +precede the hunk-start marker. For instance, a diff file could +contain + +diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el +index 923de9a..6b1c24f 100644 +--- a/lisp/vc/diff-mode.el ++++ b/lisp/vc/diff-mode.el +@@ -590,6 +590,22 @@ +....... + +If a point is on 'index', then the point is considered to be in +this first hunk. Move the point to the @@... marker before +executing the default diff-hunk-next/prev implementation to move +to the NEXT marker." + (if (not skip-hunk-start) + (funcall orig count) + + (let ((start (point))) + (funcall goto-start-func) + + ;; Trap the error. + (condition-case nil + (funcall orig count) + (error nil)) + + (when (not (looking-at header-re)) + (goto-char start) + (user-error (format "No %s" what)))))) + +;; These functions all take a skip-hunk-start argument which controls +;; whether we skip pre-hunk-start text or not. In interactive uses we +;; always want to do this, but the simple behavior is still necessary +;; to, for example, avoid an infinite loop: +;; +;; diff-hunk-next calls +;; diff--wrap-navigation calls +;; diff-bounds-of-hunk calls +;; diff-beginning-of-hunk calls +;; diff-hunk-next +;; +;; Here the outer diff-hunk-next has skip-hunk-start set to t, but the +;; inner one does not, which breaks the loop. +(defun diff-hunk-prev (&optional count skip-hunk-start) + "Go to the previous COUNT'th hunk." + (interactive (list (prefix-numeric-value current-prefix-arg) t)) + (diff--wrap-navigation + skip-hunk-start + "prev hunk" + 'diff--internal-hunk-prev + diff-hunk-header-re + (lambda () (goto-char (car (diff-bounds-of-hunk)))) + count)) + +(defun diff-hunk-next (&optional count skip-hunk-start) + "Go to the next COUNT'th hunk." + (interactive (list (prefix-numeric-value current-prefix-arg) t)) + (diff--wrap-navigation + skip-hunk-start + "next hunk" + 'diff--internal-hunk-next + diff-hunk-header-re + (lambda () (goto-char (car (diff-bounds-of-hunk)))) + count)) + +(defun diff-file-prev (&optional count skip-hunk-start) + "Go to the previous COUNT'th file." + (interactive (list (prefix-numeric-value current-prefix-arg) t)) + (diff--wrap-navigation + skip-hunk-start + "prev file" + 'diff--internal-file-prev + diff-file-header-re + (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next)) + count)) + +(defun diff-file-next (&optional count skip-hunk-start) + "Go to the next COUNT'th file." + (interactive (list (prefix-numeric-value current-prefix-arg) t)) + (diff--wrap-navigation + skip-hunk-start + "next file" + 'diff--internal-file-next + diff-file-header-re + (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next)) + count)) + + + (defun diff-bounds-of-hunk () "Return the bounds of the diff hunk at point. @@ -601,12 +676,13 @@ point is in a file header, return the bounds of the next hunk." (let ((pos (point)) (beg (diff-beginning-of-hunk t)) (end (diff-end-of-hunk))) - (cond ((>= end pos) + (cond ((> end pos) (list beg end)) ;; If this hunk ends above POS, consider the next hunk. ((re-search-forward diff-hunk-header-re nil t) (list (match-beginning 0) (diff-end-of-hunk))) - (t (error "No hunk found")))))) + ;; There's no next hunk, so just take the one we have. + (t (list beg end)))))) (defun diff-bounds-of-file () "Return the bounds of the file segment at point. @@ -820,7 +896,7 @@ If the OLD prefix arg is passed, tell the file NAME of the old file." (error (point-min))))) (header-files ;; handle filenames with spaces; - ;; cf. diff-font-lock-keywords / diff-file-header-face + ;; cf. diff-font-lock-keywords / diff-file-header (if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)") (list (if old (match-string 1) (match-string 2)) (if old (match-string 2) (match-string 1))) @@ -1685,8 +1761,9 @@ SRC and DST are the two variants of text as returned by `diff-hunk-text'. SWITCHED is non-nil if the patch is already applied. NOPROMPT, if non-nil, means not to prompt the user." (save-excursion - (let* ((other (diff-xor other-file diff-jump-to-old-file)) - (char-offset (- (point) (diff-beginning-of-hunk t))) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (other (diff-xor other-file diff-jump-to-old-file)) + (char-offset (- (point) (goto-char (car hunk-bounds)))) ;; Check that the hunk is well-formed. Otherwise diff-mode and ;; the user may disagree on what constitutes the hunk ;; (e.g. because an empty line truncates the hunk mid-course), @@ -1695,7 +1772,7 @@ NOPROMPT, if non-nil, means not to prompt the user." ;; Suppress check when NOPROMPT is non-nil (Bug#3033). (_ (unless noprompt (diff-sanity-check-hunk))) (hunk (buffer-substring - (point) (save-excursion (diff-end-of-hunk) (point)))) + (point) (cadr hunk-bounds))) (old (diff-hunk-text hunk reverse char-offset)) (new (diff-hunk-text hunk (not reverse) char-offset)) ;; Find the location specification. @@ -1803,8 +1880,15 @@ With a prefix argument, REVERSE the hunk." ;; Display BUF in a window (set-window-point (display-buffer buf) (+ (car pos) (cdr new))) (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil) + + ;; Advance to the next hunk with skip-hunk-start set to t + ;; because we want the behavior of moving to the next logical + ;; hunk, not the original behavior where were would sometimes + ;; stay on the curent hunk. This is the behavior we get when + ;; navigating through hunks interactively, and we want it when + ;; applying hunks too (see http://debbugs.gnu.org/17544). (when diff-advance-after-apply-hunk - (diff-hunk-next)))))) + (diff-hunk-next nil t)))))) (defun diff-test-hunk (&optional reverse) @@ -1885,14 +1969,15 @@ For use in `add-log-current-defun-function'." (defun diff-ignore-whitespace-hunk () "Re-diff the current hunk, ignoring whitespace differences." (interactive) - (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (char-offset (- (point) (goto-char (car hunk-bounds)))) (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) (inhibit-read-only t) (hunk (delete-and-extract-region - (point) (save-excursion (diff-end-of-hunk) (point)))) + (point) (cadr hunk-bounds))) (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1. (file1 (make-temp-file "diff1")) (file2 (make-temp-file "diff2")) @@ -1936,11 +2021,10 @@ For use in `add-log-current-defun-function'." (t :inverse-video t)) "Face used for char-based changes shown by `diff-refine-hunk'." :group 'diff-mode) -(define-obsolete-face-alias 'diff-refine-change 'diff-refine-changed "24.5") (defface diff-refine-removed '((default - :inherit diff-refine-change) + :inherit diff-refine-changed) (((class color) (min-colors 88) (background light)) :background "#ffbbbb") (((class color) (min-colors 88) (background dark)) @@ -1951,7 +2035,7 @@ For use in `add-log-current-defun-function'." (defface diff-refine-added '((default - :inherit diff-refine-change) + :inherit diff-refine-changed) (((class color) (min-colors 88) (background light)) :background "#aaffaa") (((class color) (min-colors 88) (background dark)) @@ -1980,16 +2064,14 @@ For use in `add-log-current-defun-function'." (interactive) (require 'smerge-mode) (save-excursion - (diff-beginning-of-hunk t) - (let* ((start (point)) - (style (diff-hunk-style)) ;Skips the hunk header as well. + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (style (progn (goto-char (car hunk-bounds)) + (diff-hunk-style))) ;Skips the hunk header as well. (beg (point)) - (props-c '((diff-mode . fine) (face diff-refine-change))) + (end (cadr hunk-bounds)) + (props-c '((diff-mode . fine) (face diff-refine-changed))) (props-r '((diff-mode . fine) (face diff-refine-removed))) - (props-a '((diff-mode . fine) (face diff-refine-added))) - ;; Be careful to go back to `start' so diff-end-of-hunk gets - ;; to read the hunk header's line info. - (end (progn (goto-char start) (diff-end-of-hunk) (point)))) + (props-a '((diff-mode . fine) (face diff-refine-added)))) (remove-overlays beg end 'diff-mode 'fine) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index a8c3fcca2fc..6b316c4073c 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -167,7 +167,7 @@ Possible values are: (setq default-directory thisdir) (let ((inhibit-read-only t)) (insert command "\n")) - (if (and (not no-async) (fboundp 'start-process)) + (if (and (not no-async) (fboundp 'make-process)) (let ((proc (start-process "Diff" buf shell-file-name shell-command-switch command))) (set-process-filter proc 'diff-process-filter) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index b1ac32d7019..56bfebb579c 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -1347,10 +1347,8 @@ arguments to `skip-chars-forward'." ;; located on the same remote host. (apply 'process-file ediff-cmp-program nil nil nil (append ediff-cmp-options - (list (or (file-remote-p f1 'localname) - (expand-file-name f1)) - (or (file-remote-p f2 'localname) - (expand-file-name f2))))) + (list (expand-file-name (file-local-name f1)) + (expand-file-name (file-local-name f2))))) )) (and (numberp res) (eq res 0))) diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 7f0db5d45dc..9c7e278e6ab 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -1846,9 +1846,9 @@ all marked sessions must be active." (read-string (if (stringp default-regexp) (format - "Filter through regular expression (default %s): " + "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp))) @@ -1872,7 +1872,7 @@ all marked sessions must be active." (file-directory-p file1)) (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf) - (setq regexp (read-string "Filter through regular expression: " + (setq regexp (read-string "Filter filenames through regular expression: " nil 'ediff-filtering-regexp-history)) (ediff-directory-revisions-internal file1 regexp diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 6a07f805334..3effd9b2cf9 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -120,11 +120,12 @@ patch. So, don't change these variables, unless the default doesn't work." ;; This context diff does not recognize spaces inside files, but removing ' ' ;; from [^ \t] breaks normal patches for some reason (defcustom ediff-context-diff-label-regexp - (concat "\\(" ; context diff 2-liner - "^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)" - "\\|" ; unified format diff 2-liner - "^--- +\\([^ \t]+\\).*\n\\+\\+\\+ +\\([^ \t]+\\)" - "\\)") + (let ((stuff "\\([^ \t\n]+\\)")) + (concat "\\(" ; context diff 2-liner + "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff + "\\|" ; unified format diff 2-liner + "^--- +" stuff ".*\n\\+\\+\\+ +" stuff + "\\)")) "Regexp matching filename 2-liners at the start of each context diff. You probably don't want to change that, unless you are using an obscure patch program." @@ -268,6 +269,7 @@ program." ;; directory part of filename (file-name-as-directory filename) (file-name-directory filename))) + (multi-patch-p (cdr ediff-patch-map)) ;; In case 2 files are possible patch targets, the user will be offered ;; to choose file1 or file2. In a multifile patch, if the user chooses ;; 1 or 2, this choice is preserved to decide future alternatives. @@ -429,6 +431,16 @@ Please advise: (f2-exists (setcar session-file-object file2)) (f1-exists (setcar session-file-object file1)) (t + ;; TODO: Often for multipaches the file doesn't exist because the + ;; directory part is wrong; for instance, if the patch need to + ;; be applied into + ;; (expand-file-name "lisp/vc/ediff-ptch.el" source-directory) + ;; and default-directory is + ;; (expand-file-name "lisp" source-directory) + ;; then Ediff assumes the wrong file: + ;; (expand-file-name "lisp/ediff-ptch.el" source-directory). + ;; We might identify these common failoures and suggest + ;; in the prompt the possible corrected file. --Tino (with-output-to-temp-buffer ediff-msg-buffer (ediff-with-current-buffer standard-output (fundamental-mode)) @@ -436,13 +448,15 @@ Please advise: (if (string= file1 file2) (princ (format " %s -is assumed to be the target for this patch. However, this file does not exist." - file1)) +is assumed to be %s target for this %spatch. However, this file does not exist." + file1 + (if multi-patch-p "one" "the") + (if multi-patch-p "multi-" ""))) (princ (format " %s %s -are two possible targets for this patch. However, these files do not exist." - file1 file2))) +are two possible targets for this %spatch. However, these files do not exist." + file1 file2 (if multi-patch-p "multi-" "")))) (princ " \nPlease enter an alternative patch target ...\n")) (let ((directory t) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index eb5c2490a7e..31201477fa2 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1,4 +1,4 @@ -;;; ediff-util.el --- the core commands and utilities of ediff +;;; ediff-util.el --- the core commands and utilities of ediff -*- lexical-binding:t -*- ;; Copyright (C) 1994-2016 Free Software Foundation, Inc. @@ -517,7 +517,7 @@ to invocation.") (select-window ediff-control-window) (ediff-visible-region) - (run-hooks 'startup-hooks) + (mapc #'funcall startup-hooks) (ediff-arrange-autosave-in-merge-jobs merge-buffer-file) (ediff-refresh-mode-lines) @@ -1141,11 +1141,8 @@ of the current buffer." )) (defun ediff-file-compressed-p (file) - (condition-case nil - (require 'jka-compr) - (error)) - (if (featurep 'jka-compr) - (string-match (jka-compr-build-file-regexp) file))) + (require 'jka-compr) + (string-match (jka-compr-build-file-regexp) file)) (defun ediff-swap-buffers () @@ -1645,8 +1642,8 @@ the width of the A/B/C windows." (or ctl-buf (setq ctl-buf ediff-control-buffer)) (ediff-with-current-buffer ctl-buf (let* ((buf (ediff-get-buffer buf-type)) - (wind (eval (ediff-get-symbol-from-alist - buf-type ediff-window-alist))) + (wind (symbol-value (ediff-get-symbol-from-alist + buf-type ediff-window-alist))) (beg (window-start wind)) (end (ediff-get-diff-posn buf-type 'end)) lines) @@ -1663,8 +1660,8 @@ the width of the A/B/C windows." (or ctl-buf (setq ctl-buf ediff-control-buffer)) (ediff-with-current-buffer ctl-buf (let* ((buf (ediff-get-buffer buf-type)) - (wind (eval (ediff-get-symbol-from-alist - buf-type ediff-window-alist))) + (wind (symbol-value (ediff-get-symbol-from-alist + buf-type ediff-window-alist))) (end (or (window-end wind) (window-end wind t))) (beg (ediff-get-diff-posn buf-type 'beg diff-num))) (ediff-with-current-buffer buf @@ -2442,7 +2439,9 @@ temporarily reverses the meaning of this variable." ;; restore buffer mode line id's in buffer-A/B/C (let ((control-buffer ediff-control-buffer) (meta-buffer ediff-meta-buffer) - (after-quit-hook-internal ediff-after-quit-hook-internal) + ;; FIXME: Here we ignore the global part of the + ;; ediff-after-quit-hook-internal hook. + (after-quit-hook-internal (remq t ediff-after-quit-hook-internal)) (session-number ediff-meta-session-number) ;; suitable working frame (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t)) @@ -2525,7 +2524,7 @@ temporarily reverses the meaning of this variable." (frame-selected-window warp-frame)) 2 1)) - (run-hooks 'after-quit-hook-internal) + (mapc #'funcall after-quit-hook-internal) )) ;; Returns frame under mouse, if this frame is not a minibuffer @@ -2627,6 +2626,8 @@ temporarily reverses the meaning of this variable." "Kill buffers A, B, and, possibly, C, if these buffers aren't modified. In merge jobs, buffer C is not deleted here, but rather according to ediff-quit-merge-hook. +ASK non-nil means ask the user whether to keep each unmodified buffer, unless +KEEP-VARIANTS is non-nil, in which case buffers are never killed. A side effect of cleaning up may be that you should be careful when comparing the same buffer in two separate Ediff sessions: quitting one of them might delete this buffer in another session as well." @@ -3482,6 +3483,7 @@ Without an argument, it saves customized diff argument, if available (declare-function ediff-regions-internal "ediff" (buffer-a beg-a end-a buffer-b beg-b end-b startup-hooks job-name word-mode setup-parameters)) +(defvar zmacs-regions) ;;XEmacs'ism. (defun ediff-inferior-compare-regions () "Compare regions in an active Ediff session. @@ -3529,7 +3531,7 @@ Ediff Control Panel to restore highlighting." (while (cond ((memq answer possibilities) (setq possibilities (delq answer possibilities)) (setq bufA - (eval + (symbol-value (ediff-get-symbol-from-alist answer ediff-buffer-alist))) nil) @@ -3548,7 +3550,7 @@ Ediff Control Panel to restore highlighting." (while (cond ((memq answer possibilities) (setq possibilities (delq answer possibilities)) (setq bufB - (eval + (symbol-value (ediff-get-symbol-from-alist answer ediff-buffer-alist))) nil) @@ -3947,15 +3949,18 @@ Ediff Control Panel to restore highlighting." (setq n (1+ n))) (format "%s<%d>%s" prefix n suffix)))) +(defvar reporter-prompt-for-summary-p) (defun ediff-submit-report () "Submit bug report on Ediff." (interactive) (ediff-barf-if-not-control-buffer) + (defvar ediff-device-type) + (defvar ediff-buffer-name) (let ((reporter-prompt-for-summary-p t) (ctl-buf ediff-control-buffer) (ediff-device-type (ediff-device-type)) - varlist salutation buffer-name) + varlist salutation ediff-buffer-name) (setq varlist '(ediff-diff-program ediff-diff-options ediff-diff3-program ediff-diff3-options ediff-patch-program ediff-patch-options @@ -3972,7 +3977,7 @@ Ediff Control Panel to restore highlighting." ediff-split-window-function ediff-job-name ediff-word-mode - buffer-name + ediff-buffer-name ediff-device-type )) (setq salutation " @@ -4027,7 +4032,7 @@ Mail anyway? (y or n) ") (progn (if (ediff-buffer-live-p ctl-buf) (set-buffer ctl-buf)) - (setq buffer-name (buffer-name)) + (setq ediff-buffer-name (buffer-name)) (require 'reporter) (reporter-submit-bug-report "kifer@cs.stonybrook.edu, bug-gnu-emacs@gnu.org" (ediff-version) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index be4ced9b55f..ed36a3fc8c1 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -553,9 +553,9 @@ expression; only file names that match the regexp are considered." nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -581,9 +581,9 @@ names. Only the files that are under revision control are taken into account." "Directory to compare with revision:" dir-A nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -619,9 +619,9 @@ regular expression; only file names that match the regexp are considered." nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -651,9 +651,9 @@ expression; only file names that match the regexp are considered." nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -692,9 +692,9 @@ only file names that match the regexp are considered." nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -719,9 +719,9 @@ names. Only the files that are under revision control are taken into account." "Directory to merge with revisions:" dir-A nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -750,9 +750,9 @@ names. Only the files that are under revision control are taken into account." dir-A nil 'must-match) (read-string (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " + (format "Filter filenames through regular expression (default %s): " default-regexp) - "Filter through regular expression: ") + "Filter filenames through regular expression: ") nil 'ediff-filtering-regexp-history (eval ediff-default-filtering-regexp)) @@ -1367,8 +1367,8 @@ buffer. If odd -- assume it is in a file." (require 'ediff-ptch) (setq patch-buf (ediff-get-patch-buffer - (if arg (prefix-numeric-value arg)) - (get-buffer patch-buf))) + (and arg (prefix-numeric-value arg)) + (and patch-buf (get-buffer patch-buf)))) (setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch) ((and (not ediff-patch-default-directory) (buffer-file-name patch-buf)) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index de25cbafb0d..9c25ec43321 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -621,9 +621,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (erase-buffer) (shell-command (format "%s %s %s %s" - emerge-diff-program emerge-diff-options - (emerge-protect-metachars file-A) - (emerge-protect-metachars file-B)) + (shell-quote-argument emerge-diff-program) + emerge-diff-options + (shell-quote-argument file-A) + (shell-quote-argument file-B)) t)) (emerge-prepare-error-list emerge-diff-ok-lines-regexp) (emerge-convert-diffs-to-markers @@ -792,10 +793,11 @@ This is *not* a user option, since Emerge uses it for its own processing.") (erase-buffer) (shell-command (format "%s %s %s %s %s" - emerge-diff3-program emerge-diff-options - (emerge-protect-metachars file-A) - (emerge-protect-metachars file-ancestor) - (emerge-protect-metachars file-B)) + (shell-quote-argument emerge-diff3-program) + emerge-diff-options + (shell-quote-argument file-A) + (shell-quote-argument file-ancestor) + (shell-quote-argument file-B)) t)) (emerge-prepare-error-list emerge-diff3-ok-lines-regexp) (emerge-convert-diffs-to-markers @@ -3171,26 +3173,11 @@ See also `auto-save-file-name-p'." ;; Metacharacters that have to be protected from the shell when executing ;; a diff/diff3 command. -(defcustom emerge-metachars - (if (memq system-type '(ms-dos windows-nt)) - "[ \t\"<>|?*^&=]" - "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]") - "Characters that must be quoted when used in a shell command line. -More precisely, a [...] regexp to match any one such character." +(defcustom emerge-metachars nil + "Obsolete, emerge now uses `shell-quote-argument'." :type 'regexp :group 'emerge) - -;; Quote metacharacters (using \) when executing a diff/diff3 command. -(defun emerge-protect-metachars (s) - (if (memq system-type '(ms-dos windows-nt)) - (shell-quote-argument s) - (let ((limit 0)) - (while (string-match emerge-metachars s limit) - (setq s (concat (substring s 0 (match-beginning 0)) - "\\" - (substring s (match-beginning 0)))) - (setq limit (1+ (match-end 0))))) - s)) +(make-obsolete-variable 'emerge-metachars nil "26.1") (provide 'emerge) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 34ffb3c93b5..44b8e0b0f3e 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -200,8 +200,6 @@ If it is nil, `log-view-toggle-entry-display' does nothing.") (t (:weight bold))) "Face for the file header line in `log-view-mode'." :group 'log-view) -(define-obsolete-face-alias 'log-view-file-face 'log-view-file "22.1") -(defvar log-view-file-face 'log-view-file) (defface log-view-message '((((class color) (background light)) @@ -209,9 +207,6 @@ If it is nil, `log-view-toggle-entry-display' does nothing.") (t (:weight bold))) "Face for the message header line in `log-view-mode'." :group 'log-view) -;; backward-compatibility alias -(define-obsolete-face-alias 'log-view-message-face 'log-view-message "22.1") -(defvar log-view-message-face 'log-view-message) (defvar log-view-file-re (concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS. @@ -246,8 +241,8 @@ The match group number 1 should match the revision number itself.") ;; and log-view-message-re, if applicable. '((eval . `(,log-view-file-re (1 (if (boundp 'cvs-filename-face) cvs-filename-face)) - (0 log-view-file-face append))) - (eval . `(,log-view-message-re . log-view-message-face)))) + (0 'log-view-file append))) + (eval . `(,log-view-message-re . 'log-view-message)))) (defconst log-view-font-lock-defaults '(log-view-font-lock-keywords t nil nil nil)) @@ -542,7 +537,7 @@ If called interactively, visit the version at point." (setq en (point)) (or (log-view-current-entry nil t) (throw 'beginning-of-buffer nil)) - (cond ((memq backend '(SCCS RCS CVS MCVS SVN)) + (cond ((memq backend '(SCCS RCS CVS SVN)) (forward-line 2)) ((eq backend 'Hg) (forward-line 4) diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 1abc7729045..6bb1370682e 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -69,7 +69,6 @@ to confuse some users sometimes." (t (:weight bold))) "PCL-CVS face used to highlight directory changes." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-header-face 'cvs-header "22.1") (defface cvs-filename '((((class color) (background dark)) @@ -79,7 +78,6 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight file names." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-filename-face 'cvs-filename "22.1") (defface cvs-unknown '((((class color) (background dark)) @@ -89,7 +87,6 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight unknown file status." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-unknown-face 'cvs-unknown "22.1") (defface cvs-handled '((((class color) (background dark)) @@ -99,7 +96,6 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight handled file status." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-handled-face 'cvs-handled "22.1") (defface cvs-need-action '((((class color) (background dark)) @@ -109,7 +105,6 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight status of files needing action." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-need-action-face 'cvs-need-action "22.1") (defface cvs-marked '((((min-colors 88) (class color) (background dark)) @@ -121,13 +116,11 @@ to confuse some users sometimes." (t (:weight bold))) "PCL-CVS face used to highlight marked file indicator." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1") (defface cvs-msg '((t :slant italic)) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) -(define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1") (defvar cvs-fi-up-to-date-face 'cvs-handled) (defvar cvs-fi-unknown-face 'cvs-unknown) @@ -465,7 +458,7 @@ DIR can also be a file." ((equal date "Result of merge") (setq subtype 'MERGED)) ((let ((mtime (nth 5 (file-attributes (concat dir f)))) (system-time-locale "C")) - (setq timestamp (format-time-string "%c" mtime 'utc)) + (setq timestamp (format-time-string "%c" mtime t)) ;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep 5". ;; See "grep '[^a-z_]ctime' cvs/src/*.c" for reference. (if (= (aref timestamp 8) ?0) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 573feedd047..b0ad5ea588d 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -551,7 +551,7 @@ If non-nil, NEW means to create a new buffer no matter what." ;; is accessed via SSH, a bad interaction between libc, ;; CVS and SSH can lead to garbled output. ;; It might be a glibc-specific problem (but it can also happens - ;; under Mac OS X, it seems). + ;; under macOS, it seems). ;; It seems that using a pty can help circumvent the problem, ;; but at the cost of screwing up when the process thinks it ;; can ask for user input (such as password or host-key @@ -696,7 +696,7 @@ SUBDIR is the subdirectory (if any) where this command was run. OLD-FIS is the list of fileinfos on which the cvs command was applied and which should be considered up-to-date if they are missing from the output." (when (eq system-type 'darwin) - ;; Fixup the ^D^H^H inserted at beginning of buffer sometimes on MacOSX + ;; Fixup the ^D^H^H inserted at beginning of buffer sometimes on macOS ;; because of the call to `process-send-eof'. (save-excursion (goto-char (point-min)) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 5198624ea7f..1a7decead25 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -82,7 +82,7 @@ Used in `smerge-diff-base-upper' and related functions." (((class color)) :foreground "red")) "Face for the `upper' version of a conflict.") -(define-obsolete-face-alias 'smerge-mine 'smerge-upper "25.2") +(define-obsolete-face-alias 'smerge-mine 'smerge-upper "26.1") (defvar smerge-upper-face 'smerge-upper) (defface smerge-lower @@ -93,7 +93,7 @@ Used in `smerge-diff-base-upper' and related functions." (((class color)) :foreground "green")) "Face for the `lower' version of a conflict.") -(define-obsolete-face-alias 'smerge-other 'smerge-lower "25.2") +(define-obsolete-face-alias 'smerge-other 'smerge-lower "26.1") (defvar smerge-lower-face 'smerge-lower) (defface smerge-base @@ -702,7 +702,7 @@ this keeps \"LLL\"." (smerge-keep-n 3) (smerge-auto-leave)) -(define-obsolete-function-alias 'smerge-keep-other 'smerge-keep-lower "25.2") +(define-obsolete-function-alias 'smerge-keep-other 'smerge-keep-lower "26.1") (defun smerge-keep-upper () "Keep the \"upper\" version of a merge conflict. @@ -719,7 +719,7 @@ this keeps \"UUU\"." (smerge-keep-n 1) (smerge-auto-leave)) -(define-obsolete-function-alias 'smerge-keep-mine 'smerge-keep-upper "25.2") +(define-obsolete-function-alias 'smerge-keep-mine 'smerge-keep-upper "26.1") (defun smerge-get-current () (let ((i 3)) @@ -760,7 +760,7 @@ this keeps \"UUU\"." (smerge-diff 2 1)) (define-obsolete-function-alias 'smerge-diff-base-mine - 'smerge-diff-base-upper "25.2") + 'smerge-diff-base-upper "26.1") (defun smerge-diff-base-lower () "Diff `base' and `lower' version in current conflict region." @@ -768,7 +768,7 @@ this keeps \"UUU\"." (smerge-diff 2 3)) (define-obsolete-function-alias 'smerge-diff-base-other - 'smerge-diff-base-lower "25.2") + 'smerge-diff-base-lower "26.1") (defun smerge-diff-upper-lower () "Diff `upper' and `lower' version in current conflict region." @@ -776,7 +776,7 @@ this keeps \"UUU\"." (smerge-diff 1 3)) (define-obsolete-function-alias 'smerge-diff-mine-other - 'smerge-diff-upper-lower "25.2") + 'smerge-diff-upper-lower "26.1") (defun smerge-match-conflict () "Get info about the conflict. Puts the info in the `match-data'. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index ed038f1d4e5..774453f8b54 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -432,6 +432,15 @@ should be applied to the background or to the foreground." (with-output-to-temp-buffer temp-buffer-name (let ((backend (or vc-bk (vc-backend file))) (coding-system-for-read buffer-file-coding-system)) + ;; For a VC backend running on DOS/Windows, it's normal to + ;; produce CRLF EOLs even if the original file has Unix EOLs, + ;; which will show ^M characters in the Annotate buffer. (One + ;; known case in point is "svn annotate".) Prevent that by + ;; forcing DOS EOL decoding. + (if (memq system-type '(windows-nt ms-dos)) + (setq coding-system-for-read + (coding-system-change-eol-conversion coding-system-for-read + 'dos))) (vc-call-backend backend 'annotate-command file (get-buffer temp-buffer-name) rev) ;; we must setup the mode first, and then set our local diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 03c134a100e..0fee6df2aa6 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -50,6 +50,11 @@ (require 'vc-dispatcher) (require 'vc-dir)) ; vc-dir-at-event +(declare-function vc-deduce-fileset "vc" + (&optional observer allow-unregistered + state-model-only-files)) + + ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. (put 'Bzr 'vc-functions nil) @@ -367,7 +372,12 @@ If PROMPT is non-nil, prompt for the Bzr command to run." args (cddr args))) (require 'vc-dispatcher) (let ((buf (apply 'vc-bzr-async-command command args))) - (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr))) + (with-current-buffer buf + (vc-run-delayed + (vc-compilation-mode 'bzr) + (setq-local compile-command + (concat vc-bzr-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buf)))) (defun vc-bzr-pull (prompt) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 2dca708dc38..6a010b34f26 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -27,6 +27,12 @@ (eval-when-compile (require 'vc)) +(declare-function vc-branch-p "vc" (rev)) +(declare-function vc-checkout "vc" (file &optional rev)) +(declare-function vc-expand-dirs "vc" (file-or-dir-list backend)) +(declare-function vc-read-revision "vc" + (prompt &optional files backend default initial-input)) + ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. (put 'CVS 'vc-functions nil) @@ -121,7 +127,7 @@ This is only meaningful if you don't use the implicit checkout model :version "21.1" :group 'vc-cvs) -(defcustom vc-stay-local 'only-file +(defcustom vc-cvs-stay-local 'only-file "Non-nil means use local operations when possible for remote repositories. This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. @@ -131,11 +137,11 @@ server, but heuristics will be used to determine the status for all other VC operations. The value can also be a regular expression or list of regular -expressions to match against the host name of a repository; then VC -only stays local for hosts that match it. Alternatively, the value -can be a list of regular expressions where the first element is the -symbol `except'; then VC always stays local except for hosts matched -by these regular expressions." +expressions to match against the host name of a repository; then +vc-cvs only stays local for hosts that match it. Alternatively, +the value can be a list of regular expressions where the first +element is the symbol `except'; then vc-cvs always stays local +except for hosts matched by these regular expressions." :type '(choice (const :tag "Always stay local" t) (const :tag "Only for file operations" only-file) (const :tag "Don't stay local" nil) @@ -789,8 +795,7 @@ If FILE is a list of files, return non-nil if any of them individually should stay local." (if (listp file) (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file)) - (let* ((sym (vc-make-backend-sym 'CVS 'stay-local)) - (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local))) + (let ((stay-local vc-cvs-stay-local)) (if (symbolp stay-local) stay-local (let ((dirname (if (file-directory-p file) (directory-file-name file) @@ -939,103 +944,32 @@ state." (t 'edited)))))))) (defun vc-cvs-after-dir-status (update-function) - ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack. - ;; This needs a lot of testing. - (let ((status nil) - (status-str nil) - (file nil) - (result nil) - (missing nil) - (ignore-next nil) - (subdir default-directory)) + (let ((result nil) + (translation '((?? . unregistered) + (?A . added) + (?C . conflict) + (?M . edited) + (?P . needs-merge) + (?R . removed) + (?U . needs-update)))) (goto-char (point-min)) - (while - ;; Look for either a file entry, an unregistered file, or a - ;; directory change. - (re-search-forward - "\\(^=+\n\\([^=c?\n].*\n\\|\n\\)+\\)\\|\\(\\(^?? .*\n\\)+\\)\\|\\(^cvs status: \\(Examining\\|nothing\\) .*\n\\)" - nil t) - ;; FIXME: get rid of narrowing here. - (narrow-to-region (match-beginning 0) (match-end 0)) - (goto-char (point-min)) - ;; The subdir - (when (looking-at "cvs status: Examining \\(.+\\)") - (setq subdir (expand-file-name (match-string 1)))) - ;; Unregistered files - (while (looking-at "? \\(.*\\)") - (setq file (file-relative-name - (expand-file-name (match-string 1) subdir))) - (push (list file 'unregistered) result) - (forward-line 1)) - (when (looking-at "cvs status: nothing known about") - ;; We asked about a non existent file. The output looks like this: - - ;; cvs status: nothing known about `lisp/v.diff' - ;; =================================================================== - ;; File: no file v.diff Status: Unknown - ;; - ;; Working revision: No entry for v.diff - ;; Repository revision: No revision control file - ;; - - ;; Due to narrowing in this iteration we only see the "cvs - ;; status:" line, so just set a flag so that we can ignore the - ;; file in the next iteration. - (setq ignore-next t)) - ;; A file entry. - (when (re-search-forward "^File: \\(no file \\)?\\(.*[^ \t]\\)[ \t]+Status: \\(.*\\)" nil t) - (setq missing (match-string 1)) - (setq file (file-relative-name - (expand-file-name (match-string 2) subdir))) - (setq status-str (match-string 3)) - (setq status - (cond - ((string-match "Up-to-date" status-str) 'up-to-date) - ((string-match "Locally Modified" status-str) 'edited) - ((string-match "Needs Merge" status-str) 'needs-merge) - ((string-match "Needs \\(Checkout\\|Patch\\)" status-str) - (if missing 'missing 'needs-update)) - ((string-match "Locally Added" status-str) 'added) - ((string-match "Locally Removed" status-str) 'removed) - ((string-match "File had conflicts " status-str) 'conflict) - ((string-match "Unknown" status-str) 'unregistered) - (t 'edited))) - (if ignore-next - (setq ignore-next nil) - (unless (eq status 'up-to-date) - (push (list file status) result)))) - (goto-char (point-max)) - (widen)) - (funcall update-function result)) - ;; Alternative implementation: use the "update" command instead of - ;; the "status" command. - ;; (let ((result nil) - ;; (translation '((?? . unregistered) - ;; (?A . added) - ;; (?C . conflict) - ;; (?M . edited) - ;; (?P . needs-merge) - ;; (?R . removed) - ;; (?U . needs-update)))) - ;; (goto-char (point-min)) - ;; (while (not (eobp)) - ;; (if (looking-at "^[ACMPRU?] \\(.*\\)$") - ;; (push (list (match-string 1) - ;; (cdr (assoc (char-after) translation))) - ;; result) - ;; (cond - ;; ((looking-at "cvs update: warning: \\(.*\\) was lost") - ;; ;; Format is: - ;; ;; cvs update: warning: FILENAME was lost - ;; ;; U FILENAME - ;; (push (list (match-string 1) 'missing) result) - ;; ;; Skip the "U" line - ;; (forward-line 1)) - ;; ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored") - ;; (push (list (match-string 1) 'unregistered) result)))) - ;; (forward-line 1)) - ;; (funcall update-function result))) - ) + (while (not (eobp)) + (if (looking-at "^[ACMPRU?] \\(.*\\)$") + (push (list (match-string 1) + (cdr (assoc (char-after) translation))) + result) + (cond + ((looking-at "cvs update: warning: \\(.*\\) was lost") + ;; Format is: + ;; cvs update: warning: FILENAME was lost + ;; U FILENAME + (push (list (match-string 1) 'missing) result) + ;; Skip the "U" line + (forward-line 1)) + ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored") + (push (list (match-string 1) 'unregistered) result)))) + (forward-line 1)) + (funcall update-function result))) ;; Based on vc-cvs-dir-state-heuristic from Emacs 22. ;; FIXME does not mention unregistered files. @@ -1072,16 +1006,12 @@ state." Query all files in DIR if files is nil." (let ((local (vc-cvs-stay-local-p dir))) (if (and (not files) local (not (eq local 'only-file))) - (vc-cvs-dir-status-heuristic dir update-function) - (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS))) - (vc-cvs-command (current-buffer) 'async files "-f" "status") - ;; Alternative implementation: use the "update" command instead of - ;; the "status" command. - ;; (vc-cvs-command (current-buffer) 'async - ;; (file-relative-name dir) - ;; "-f" "-n" "update" "-d" "-P") - (vc-run-delayed - (vc-cvs-after-dir-status update-function))))) + (vc-cvs-dir-status-heuristic dir update-function)) + (vc-cvs-command (current-buffer) 'async + files + "-f" "-n" "-q" "update") + (vc-run-delayed + (vc-cvs-after-dir-status update-function)))) (defun vc-cvs-file-to-string (file) "Read the content of FILE and return it as a string." diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 59f2ae329ed..a5515420a1b 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -669,7 +669,7 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (make-local-variable 'vc-log-after-operation-hook) (when after-hook (setq vc-log-after-operation-hook after-hook)) - (setq vc-log-operation action) + (set (make-local-variable 'vc-log-operation) action) (when comment (erase-buffer) (when (stringp comment) (insert comment))) @@ -711,6 +711,7 @@ the buffer contents as a comment." (funcall log-operation log-fileset log-entry)) + (setq vc-log-operation nil) ;; Quit windows on logbuf. (cond diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8498cc82761..514b97c2632 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -165,8 +165,20 @@ matching the resulting Git log output, and KEYWORDS is a list of :type '(list string string (repeat sexp)) :version "24.1") -(defvar vc-git-commits-coding-system 'utf-8 - "Default coding system for git commits.") +(defcustom vc-git-commits-coding-system 'utf-8 + "Default coding system for sending commit log messages to Git. + +Should be consistent with the Git config value i18n.commitEncoding, +and should also be consistent with `locale-coding-system'." + :type '(coding-system :tag "Coding system to encode Git commit logs") + :version "25.1") + +(defcustom vc-git-log-output-coding-system 'utf-8 + "Default coding system for receiving log output from Git. + +Should be consistent with the Git config value i18n.logOutputEncoding." + :type '(coding-system :tag "Coding system to decode Git log output") + :version "25.1") ;; History of Git commands. (defvar vc-git-history nil) @@ -266,13 +278,13 @@ matching the resulting Git log output, and KEYWORDS is a list of (defun vc-git-mode-line-string (file) "Return a string for `vc-mode-line' to put in the mode line for FILE." - (let* ((rev (vc-working-revision file)) + (let* ((rev (vc-working-revision file 'Git)) (disp-rev (or (vc-git--symbolic-ref file) (substring rev 0 7))) (def-ml (vc-default-mode-line-string 'Git file)) (help-echo (get-text-property 0 'help-echo def-ml)) (face (get-text-property 0 'face def-ml))) - (propertize (replace-regexp-in-string (concat rev "\\'") disp-rev def-ml t t) + (propertize (concat (substring def-ml 0 4) disp-rev) 'face face 'help-echo (concat help-echo "\nCurrent revision: " rev)))) @@ -680,21 +692,45 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (default-directory (expand-file-name root)) (only (or (cdr files) (not (equal root (abbreviate-file-name file1))))) - (coding-system-for-write vc-git-commits-coding-system)) + (pcsw coding-system-for-write) + (coding-system-for-write + ;; On MS-Windows, we must encode command-line arguments in + ;; the system codepage. + (if (eq system-type 'windows-nt) + locale-coding-system + (or coding-system-for-write vc-git-commits-coding-system))) + (msg-file + ;; On MS-Windows, pass the commit log message through a + ;; file, to work around the limitation that command-line + ;; arguments must be in the system codepage, and therefore + ;; might not support the non-ASCII characters in the log + ;; message. Handle also remote files. + (if (eq system-type 'windows-nt) + (let ((default-directory (file-name-directory file1))) + (file-local-name (make-nearby-temp-file "git-msg")))))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. (apply 'vc-git-command nil 0 (if only files) - (nconc (list "commit" "-m") - (log-edit-extract-headers - `(("Author" . "--author") - ("Date" . "--date") - ("Amend" . ,(boolean-arg-fn "--amend")) - ("Sign-Off" . ,(boolean-arg-fn "--signoff"))) - comment) - (if only (list "--only" "--") '("-a"))))))) + (nconc (if msg-file (list "commit" "-F" msg-file) + (list "commit" "-m")) + (let ((args + (log-edit-extract-headers + `(("Author" . "--author") + ("Date" . "--date") + ("Amend" . ,(boolean-arg-fn "--amend")) + ("Sign-Off" . ,(boolean-arg-fn "--signoff"))) + comment))) + (when msg-file + (let ((coding-system-for-write + (or pcsw vc-git-commits-coding-system))) + (write-region (car args) nil msg-file)) + (setq args (cdr args))) + args) + (if only (list "--only" "--") '("-a"))))) + (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -756,7 +792,12 @@ If PROMPT is non-nil, prompt for the Git command to run." args (cddr args))) (require 'vc-dispatcher) (apply 'vc-do-async-command buffer root git-program command args) - (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git))) + (with-current-buffer buffer + (vc-run-delayed + (vc-compilation-mode 'git) + (setq-local compile-command + (concat git-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buffer))) (defun vc-git-pull (prompt) @@ -847,13 +888,19 @@ This prompts for a branch to merge from." (autoload 'vc-setup-buffer "vc-dispatcher") +(defcustom vc-git-print-log-follow nil + "If true, follow renames in Git logs for files." + :type 'boolean + :version "26.1") + (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) "Print commit log associated with FILES into specified BUFFER. If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. \(This requires at least Git version 1.5.6, for the --graph option.) If START-REVISION is non-nil, it is the newest revision to show. If LIMIT is non-nil, show no more than this many entries." - (let ((coding-system-for-read vc-git-commits-coding-system)) + (let ((coding-system-for-read + (or coding-system-for-read vc-git-log-output-coding-system))) ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -866,6 +913,12 @@ If LIMIT is non-nil, show no more than this many entries." 'async files (append '("log" "--no-color") + (when (and vc-git-print-log-follow + (not (cl-some #'file-directory-p files))) + ;; "--follow" on directories is broken + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=8756 + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16422 + (list "--follow")) (when shortlog `("--graph" "--decorate" "--date=short" ,(format "--pretty=tformat:%s" @@ -1049,6 +1102,13 @@ or BRANCH^ (where \"^\" can be repeated)." (cons 'vc-git-region-history-font-lock-keywords (cdr font-lock-defaults)))) +(defun vc-git--asciify-coding-system () + ;; Try to reconcile the content encoding with the encoding of Git's + ;; auxiliary output (which is ASCII or ASCII-compatible), bug#23595. + (unless (let ((samp "Binary files differ")) + (string-equal samp (decode-coding-string + samp coding-system-for-read t))) + (setq coding-system-for-read 'undecided))) (autoload 'vc-switches "vc") @@ -1056,6 +1116,7 @@ or BRANCH^ (where \"^\" can be repeated)." "Get a difference report using Git between two revisions of FILES." (let (process-file-side-effects (command "diff-tree")) + (vc-git--asciify-coding-system) (if rev2 ;; Diffing against the empty tree. (unless rev1 (setq rev1 "4b825dc642cb6eb9a060e54bf8d69288fbee4904")) @@ -1094,6 +1155,7 @@ or BRANCH^ (where \"^\" can be repeated)." table)) (defun vc-git-annotate-command (file buf &optional rev) + (vc-git--asciify-coding-system) (let ((name (file-relative-name file))) (apply #'vc-git-command buf 'async nil "blame" "--date=short" (append (vc-switches 'git 'annotate) @@ -1387,8 +1449,11 @@ This command shares argument histories with \\[rgrep] and \\[grep]." "A wrapper around `vc-do-command' for use in vc-git.el. The difference to vc-do-command is that this function always invokes `vc-git-program'." - (let ((coding-system-for-read vc-git-commits-coding-system) - (coding-system-for-write vc-git-commits-coding-system)) + (let ((coding-system-for-read + (or coding-system-for-read vc-git-log-output-coding-system)) + (coding-system-for-write + (or coding-system-for-write vc-git-commits-coding-system)) + (process-environment (cons "GIT_DIR" process-environment))) (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program ;; http://debbugs.gnu.org/16897 (unless (and (not (cdr-safe file-or-list)) @@ -1411,9 +1476,12 @@ The difference to vc-do-command is that this function always invokes ;; directories. We enable `inhibit-null-byte-detection', otherwise ;; Tramp's eol conversion might be confused. (let ((inhibit-null-byte-detection t) - (coding-system-for-read vc-git-commits-coding-system) - (coding-system-for-write vc-git-commits-coding-system) + (coding-system-for-read + (or coding-system-for-read vc-git-log-output-coding-system)) + (coding-system-for-write + (or coding-system-for-write vc-git-commits-coding-system)) (process-environment (cons "PAGER=" process-environment))) + (push "GIT_DIR" process-environment) (apply 'process-file vc-git-program nil buffer nil command args))) (defun vc-git--out-ok (command &rest args) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 702772cf5ab..29f8df04698 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -106,6 +106,8 @@ (require 'vc) (require 'vc-dir)) +(declare-function vc-compilation-mode "vc-dispatcher" (backend)) + ;;; Customization options (defgroup vc-hg nil @@ -278,16 +280,16 @@ If no list entry produces a useful revision, return `nil'." (const :tag "Active bookmark" 'bookmark) (string :tag "Hg template") (function :tag "Custom"))) - :version "25.2" + :version "26.1" :group 'vc-hg) (defcustom vc-hg-use-file-version-for-mode-line-version nil - "When enabled, the modeline will contain revision informtion for the visited file. + "When enabled, the modeline contains revision information for the visited file. When not, the revision in the modeline is for the repository working copy. `nil' is the much faster setting for large repositories." :type 'boolean - :version "25.2" + :version "26.1" :group 'vc-hg) (defun vc-hg--active-bookmark-internal (rev) @@ -572,7 +574,7 @@ directly instead of always running Mercurial. We try to be safe against Mercurial data structure format changes and always fall back to running Mercurial directly." :type 'boolean - :version "25.2" + :version "26.1" :group 'vc-hg) (defsubst vc-hg--read-u8 () @@ -1345,7 +1347,11 @@ commands, which only operated on marked files." args (cddr args))) (apply 'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer - (vc-run-delayed (vc-compilation-mode 'hg))) + (vc-run-delayed + (vc-compilation-mode 'hg) + (setq-local compile-command + (concat hg-program " " command " " + (if args (mapconcat 'identity args " ") ""))))) (vc-set-async-update buffer))))) (defun vc-hg-pull (prompt) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 0c1718e94cb..f59b4632e70 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -40,7 +40,7 @@ :group 'mode-line :version "25.1") -(defface vc-state-base-face +(defface vc-state-base '((default)) "Base face for VC state indicator." :group 'vc-faces @@ -48,50 +48,50 @@ :version "25.1") (defface vc-up-to-date-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file is up to date." :version "25.1" :group 'vc-faces) (defface vc-needs-update-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file needs update." :version "25.1" :group 'vc-faces) (defface vc-locked-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file locked." :version "25.1" :group 'vc-faces) (defface vc-locally-added-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file is locally added." :version "25.1" :group 'vc-faces) (defface vc-conflict-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file contains merge conflicts." :version "25.1" :group 'vc-faces) (defface vc-removed-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file was removed from the VC system." :version "25.1" :group 'vc-faces) (defface vc-missing-state - '((default :inherit vc-state-base-face)) + '((default :inherit vc-state-base)) "Face for VC modeline state when the file is missing from the file system." :version "25.1" :group 'vc-faces) (defface vc-edited-state - '((default :inherit vc-state-base-face)) - "Face for VC modeline state when the file is up to date." + '((default :inherit vc-state-base)) + "Face for VC modeline state when the file is edited." :version "25.1" :group 'vc-faces) @@ -122,7 +122,7 @@ An empty list disables VC altogether." :group 'vc) ;; Note: we don't actually have a darcs back end yet. -;; Also, Meta-CVS (corresponding to MCVS) and Arch are unsupported. +;; Also, Arch is unsupported, and the Meta-CVS back end has been removed. ;; The Arch back end will be retrieved and fixed if it is ever required. (defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS" ".src" ".svn" ".git" ".hg" ".bzr" @@ -206,17 +206,17 @@ VC commands are globally reachable under the prefix `\\[vc-prefix-map]': (not (memq property vc-touched-properties))) (setq vc-touched-properties (append (list property) vc-touched-properties))) - (put (intern file vc-file-prop-obarray) property value)) + (put (intern (expand-file-name file) vc-file-prop-obarray) property value)) (defun vc-file-getprop (file property) "Get per-file VC PROPERTY for FILE." - (get (intern file vc-file-prop-obarray) property)) + (get (intern (expand-file-name file) vc-file-prop-obarray) property)) (defun vc-file-clearprops (file) "Clear all VC properties of FILE." (if (boundp 'vc-parent-buffer) (kill-local-variable 'vc-parent-buffer)) - (setplist (intern file vc-file-prop-obarray) nil)) + (setplist (intern (expand-file-name file) vc-file-prop-obarray) nil)) ;; We keep properties on each symbol naming a backend as follows: @@ -394,7 +394,7 @@ For registered files, the possible values are: (defun vc-user-login-name (file) "Return the name under which the user accesses the given FILE." - (or (and (eq (string-match tramp-file-name-regexp file) 0) + (or (and (file-remote-p file) ;; tramp case: execute "whoami" via tramp (let ((default-directory (file-name-directory file)) process-file-side-effects) @@ -468,16 +468,20 @@ status of this file. Otherwise, the value returned is one of: `unregistered' The file is not under version control." - ;; Note: in Emacs 22 and older, return of nil meant the file was - ;; unregistered. This is potentially a source of - ;; backward-compatibility bugs. + ;; Note: we usually return nil here for unregistered files anyway + ;; when called with only one argument. This doesn't seem to cause + ;; any problems. But if we wanted to change that, we should + ;; probably opt for redefining the `registered' command to return + ;; non-nil even for unregistered files (maybe also rename it), and + ;; then make sure that all `state' implementations handle + ;; unregistered file appropriately. ;; FIXME: New (sub)states needed (?): ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) (when (> (length file) 0) ;Why?? --Stef - (setq backend (or backend (vc-responsible-backend file))) - (when backend + (setq backend (or backend (vc-backend file))) + (when backend (vc-state-refresh file backend))))) (defun vc-state-refresh (file backend) @@ -495,10 +499,11 @@ status of this file. Otherwise, the value returned is one of: If FILE is not registered, this function always returns nil." (or (vc-file-getprop file 'vc-working-revision) (progn - (setq backend (or backend (vc-responsible-backend file))) - (when backend - (vc-file-setprop file 'vc-working-revision - (vc-call-backend backend 'working-revision file)))))) + (setq backend (or backend (vc-backend file))) + (when backend + (vc-file-setprop file 'vc-working-revision + (vc-call-backend + backend 'working-revision file)))))) ;; Backward compatibility. (define-obsolete-function-alias diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 8d58611cb5b..fcb1849d743 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -41,6 +41,13 @@ (require 'cl-lib) (require 'vc)) +(declare-function vc-branch-p "vc" (rev)) +(declare-function vc-read-revision "vc" + (prompt &optional files backend default initial-input)) +(declare-function vc-buffer-context "vc-dispatcher" ()) +(declare-function vc-restore-buffer-context "vc-dispatcher" (context)) +(declare-function vc-setup-buffer "vc-dispatcher" (buf)) + (defgroup vc-rcs nil "VC RCS backend." :version "24.1" @@ -120,7 +127,9 @@ For a description of possible values, see `vc-check-master-templates'." (setq result (vc-file-getprop file 'vc-checkout-model))) (or result (progn (vc-rcs-fetch-master-state file) - (vc-file-getprop file 'vc-checkout-model))))) + (vc-file-getprop file 'vc-checkout-model)) + ;; For non-existing files we assume strict locking. + 'locking))) ;;; ;;; State-querying functions diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 23290428043..8b82b56a6c8 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -85,6 +85,8 @@ (require 'cl-lib) (require 'vc)) +(declare-function vc-setup-buffer "vc-dispatcher" (buf)) + (defgroup vc-src nil "VC SRC backend." :version "25.1" diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 25b41e34e64..2ddf4e19e1f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -552,7 +552,7 @@ ;; argument, since on no system since RCS has setting the initial ;; revision been even possible, let alone sane. ;; -;; INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did +;; - INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did ;; not take an async-mode flag as a fourth optional argument. (This ;; change eliminated a particularly ugly global.) ;; @@ -563,12 +563,12 @@ ;; SVN.) ;; ;; - INCOMPATIBLE CHANGE: The old fourth 'default-state' argument of -;; vc-dir-status-files is gone; none of the back ends actually used it. +;; dir-status-files is gone; none of the back ends actually used it. ;; -;; - vc-dir-status is no longer a public method; it has been replaced -;; by vc-dir-status-files. +;; - dir-status is no longer a public method; it has been replaced by +;; dir-status-files. ;; -;; - vc-state-heuristic is no longer a public method (the CVS backend +;; - state-heuristic is no longer a public method (the CVS backend ;; retains it as a private one). ;; ;; - the vc-mistrust-permissions configuration variable is gone; the @@ -577,8 +577,8 @@ ;; only affected back ends were SCCS and RCS. ;; ;; - vc-stay-local-p and repository-hostname are no longer part -;; of the public API. The vc-stay-local configuration variable -;; remains but only affects the CVS back end. +;; of the public API. The vc-cvs-stay-local configuration variable +;; remains and only affects the CVS back end. ;; ;; - The init-revision function and the default-initial-revision ;; variable are gone. These have't made sense on anything shipped @@ -959,7 +959,11 @@ use." If FILE is already registered, return the backend of FILE. If FILE is not registered, then the first backend in `vc-handled-backends' that declares itself -responsible for FILE is returned." +responsible for FILE is returned. + +Note that if FILE is a symbolic link, it will not be resolved -- +the responsible backend system for the symbolic link itself will +be reported." (or (and (not (file-directory-p file)) (vc-backend file)) (catch 'found ;; First try: find a responsible backend. If this is for registration, @@ -2393,7 +2397,7 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." "Show the history of the region FROM..TO." (interactive "r") (let* ((lfrom (line-number-at-pos from)) - (lto (line-number-at-pos to)) + (lto (line-number-at-pos (1- to))) (file buffer-file-name) (backend (vc-backend file)) (buf (get-buffer-create "*VC-history*"))) diff --git a/lisp/version.el b/lisp/version.el index dc228870d1e..d4cb92ec86a 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -116,18 +116,6 @@ or if we could not determine the revision.") (looking-at "[0-9a-fA-F]\\{40\\}")) (match-string 0))))) -(defun emacs-repository--version-git-1 (file dir) - "Internal subroutine of `emacs-repository-get-version'." - (when (file-readable-p file) - (with-temp-buffer - (insert-file-contents file) - (cond ((looking-at "[0-9a-fA-F]\\{40\\}") - (match-string 0)) - ((looking-at "ref: \\(.*\\)") - (emacs-repository--version-git-1 - (expand-file-name (match-string 1) dir) - dir)))))) - (defun emacs-repository-get-version (&optional dir external) "Try to return as a string the repository revision of the Emacs sources. The format of the returned string is dependent on the VCS in use. @@ -137,42 +125,8 @@ this reports on the current state of the sources, which may not correspond to the running Emacs. Optional argument DIR is a directory to use instead of `source-directory'. -Optional argument EXTERNAL non-nil means to just ask the VCS itself, -if the sources appear to be under version control. Otherwise only ask -the VCS if we cannot find any information ourselves." - (or dir (setq dir source-directory)) - (let* ((base-dir (expand-file-name ".git" dir)) - (in-main-worktree (file-directory-p base-dir)) - (in-linked-worktree nil) - sub-dir) - ;; If the sources are in a linked worktree, .git is a file that points to - ;; the location of the main worktree and the repo's administrative files. - (when (and (not in-main-worktree) - (file-regular-p base-dir) - (file-readable-p base-dir)) - (with-temp-buffer - (insert-file-contents base-dir) - (when (looking-at "gitdir: \\(.*\.git\\)\\(.*\\)$") - (setq base-dir (match-string 1) - sub-dir (concat base-dir (match-string 2)) - in-linked-worktree t)))) - ;; We've found a worktree, either main or linked. - (when (or in-main-worktree in-linked-worktree) - (if external - (emacs-repository-version-git dir) - (or (if in-linked-worktree - (emacs-repository--version-git-1 - (expand-file-name "HEAD" sub-dir) base-dir) - (let ((files '("HEAD" "refs/heads/master")) - file rev) - (while (and (not rev) - (setq file (car files))) - (setq file (expand-file-name file base-dir) - files (cdr files) - rev (emacs-repository--version-git-1 file base-dir))) - rev)) - ;; AFAICS this doesn't work during dumping (bug#20799). - (emacs-repository-version-git dir)))))) +Optional argument EXTERNAL is ignored." + (emacs-repository-version-git (or dir source-directory))) ;; We put version info into the executable in the form that `ident' uses. (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) diff --git a/lisp/view.el b/lisp/view.el index 830073a0639..92cbd146d77 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -48,7 +48,7 @@ "Peruse file or buffer without editing." :link '(function-link view-mode) :link '(custom-manual "(emacs)Misc File Ops") - :group 'wp) + :group 'text) (defcustom view-highlight-face 'highlight "The face used for highlighting the match found by View mode search." @@ -429,7 +429,7 @@ x exchanges point and mark. Mark ring is pushed at start of every successful search and when jump to line occurs. The mark is set on jump to buffer start or end. \\[point-to-register] save current position in character register. -' go to position saved in character register. +\\=' go to position saved in character register. s do forward incremental search. r do reverse incremental search. \\[View-search-regexp-forward] searches forward for regular expression, starting after current page. diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 472355741b8..91c02530427 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -31,9 +31,9 @@ ;;;; Function keys -(declare-function set-message-beep "w32fns.c") -(declare-function w32-get-locale-info "w32proc.c") -(declare-function w32-get-valid-locale-ids "w32proc.c") +(declare-function set-message-beep "w32fns.c" (sound)) +(declare-function w32-get-locale-info "w32proc.c" (lcid &optional longform)) +(declare-function w32-get-valid-locale-ids "w32proc.c" ()) ;; Map all versions of a filename (8.3, longname, mixed case) to the ;; same buffer. @@ -121,7 +121,7 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'after-init-hook 'w32-check-shell-configuration) ;; Override setting chosen at startup. -(defun set-default-process-coding-system () +(defun w32-set-default-process-coding-system () ;; Most programs on Windows will accept Unix line endings on input ;; (and some programs ported from Unix require it) but most will ;; produce DOS line endings on output. @@ -142,8 +142,9 @@ You should set this to t when using a non-system shell.\n\n")))) . ,(if (default-value 'enable-multibyte-characters) '(undecided-dos . undecided-dos) '(raw-text-dos . raw-text-dos))))) - -(add-hook 'before-init-hook 'set-default-process-coding-system) +(define-obsolete-function-alias 'set-default-process-coding-system + #'w32-set-default-process-coding-system "26.1") +(add-hook 'before-init-hook #'w32-set-default-process-coding-system) ;;; Basic support functions for managing Emacs's locale setting @@ -200,8 +201,7 @@ certain patterns. This function is called by `convert-standard-filename'. Replace invalid characters and turn Cygwin names into native -names, and also turn slashes into backslashes if the shell -requires it (see `w32-shell-dos-semantics')." +names." (save-match-data (let ((name (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) @@ -216,16 +216,9 @@ requires it (see `w32-shell-dos-semantics')." (while (string-match "[?*:<>|\"\000-\037]" name start) (aset name (match-beginning 0) ?!) (setq start (match-end 0))) - ;; convert directory separators to Windows format - ;; (but only if the shell in use requires it) - (when (w32-shell-dos-semantics) - (setq start 0) - (while (string-match "/" name start) - (aset name (match-beginning 0) ?\\) - (setq start (match-end 0)))) name))) -(defun set-w32-system-coding-system (coding-system) +(defun w32-set-system-coding-system (coding-system) "Set the coding system used by the Windows system to CODING-SYSTEM. This is used for things like passing font names with non-ASCII characters in them to the system. For a list of possible values of @@ -241,6 +234,8 @@ This function is provided for backward compatibility, since default)))) (check-coding-system coding-system) (setq locale-coding-system coding-system)) +(define-obsolete-function-alias 'set-w32-system-coding-system + #'w32-set-system-coding-system "26.1") ;; locale-coding-system was introduced to do the same thing as ;; w32-system-coding-system. Use that instead. diff --git a/lisp/wdired.el b/lisp/wdired.el index 91093032125..f059ab774a5 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -1,4 +1,4 @@ -;;; wdired.el --- Rename files editing their names in dired buffers +;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*- ;; Copyright (C) 2004-2016 Free Software Foundation, Inc. @@ -158,7 +158,7 @@ If non-nil, when you rename a file to a destination path within a nonexistent directory, wdired will create any parent directories necessary. When nil, attempts to rename a file into a nonexistent directory will fail." - :version "25.2" + :version "26.1" :type 'boolean :group 'wdired) @@ -590,7 +590,7 @@ Optional arguments are ignored." "Move down lines then position at filename or the current column. See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (with-no-warnings (next-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement @@ -603,7 +603,7 @@ says how many lines to move; default is one line." "Move up lines then position at filename or the current column. See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (with-no-warnings (previous-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement @@ -685,7 +685,7 @@ If OLD, return the old target. If MOVE, move point before it." (funcall command 1) (setq arg (1- arg))) (error - (if (forward-word) + (if (forward-word-strictly) ;; Skip any non-word characters to avoid triggering a read-only ;; error which would cause skipping the next word characters too. (skip-syntax-forward "^w") diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 53bf363daa4..29d60c9a0df 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -178,48 +178,17 @@ ;; ;; `whitespace-cleanup' ;; Cleanup some blank problems in all buffer or at region. +;; See the function's docstring for more information. ;; ;; `whitespace-cleanup-region' ;; Cleanup some blank problems at region. ;; -;; The problems, which are cleaned up, are: -;; -;; 1. empty lines at beginning of buffer. -;; 2. empty lines at end of buffer. -;; If `whitespace-style' includes the value `empty', remove all -;; empty lines at beginning and/or end of buffer. -;; -;; 3. 8 or more SPACEs at beginning of line. -;; If `whitespace-style' includes the value `indentation': -;; replace 8 or more SPACEs at beginning of line by TABs, if -;; `indent-tabs-mode' is non-nil; otherwise, replace TABs by -;; SPACEs. -;; If `whitespace-style' includes the value `indentation::tab', -;; replace 8 or more SPACEs at beginning of line by TABs. -;; If `whitespace-style' includes the value `indentation::space', -;; replace TABs by SPACEs. -;; -;; 4. SPACEs before TAB. -;; If `whitespace-style' includes the value `space-before-tab': -;; replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; -;; otherwise, replace TABs by SPACEs. -;; If `whitespace-style' includes the value -;; `space-before-tab::tab', replace SPACEs by TABs. -;; If `whitespace-style' includes the value -;; `space-before-tab::space', replace TABs by SPACEs. -;; -;; 5. SPACEs or TABs at end of line. -;; If `whitespace-style' includes the value `trailing', remove all -;; SPACEs or TABs at end of line. -;; -;; 6. 8 or more SPACEs after TAB. -;; If `whitespace-style' includes the value `space-after-tab': -;; replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; -;; otherwise, replace TABs by SPACEs. -;; If `whitespace-style' includes the value `space-after-tab::tab', -;; replace SPACEs by TABs. -;; If `whitespace-style' includes the value -;; `space-after-tab::space', replace TABs by SPACEs. +;; +;; Options +;; ------- +;; +;; Whitespace's behavior can be changed with `M-x customize-group +;; whitespace', which see for the full list of options. ;; ;; ;; Hooks @@ -237,83 +206,6 @@ ;; It is evaluated after whitespace package is loaded. ;; ;; -;; Options -;; ------- -;; -;; Below it's shown a brief description of whitespace options, please, -;; see the options declaration in the code for a long documentation. -;; -;; `whitespace-style' Specify which kind of blank is -;; visualized. -;; -;; `whitespace-space' Face used to visualize SPACE. -;; -;; `whitespace-hspace' Face used to visualize HARD SPACE. -;; -;; `whitespace-tab' Face used to visualize TAB. -;; -;; `whitespace-newline' Face used to visualize NEWLINE char -;; mapping. -;; -;; `whitespace-trailing' Face used to visualize trailing -;; blanks. -;; -;; `whitespace-line' Face used to visualize "long" lines. -;; -;; `whitespace-space-before-tab' Face used to visualize SPACEs -;; before TAB. -;; -;; `whitespace-indentation' Face used to visualize 8 or more -;; SPACEs at beginning of line. -;; -;; `whitespace-big-indent' Face used to visualize big indentation. -;; -;; `whitespace-empty' Face used to visualize empty lines at -;; beginning and/or end of buffer. -;; -;; `whitespace-space-after-tab' Face used to visualize 8 or more -;; SPACEs after TAB. -;; -;; `whitespace-space-regexp' Specify SPACE characters regexp. -;; -;; `whitespace-hspace-regexp' Specify HARD SPACE characters regexp. -;; -;; `whitespace-tab-regexp' Specify TAB characters regexp. -;; -;; `whitespace-trailing-regexp' Specify trailing characters regexp. -;; -;; `whitespace-space-before-tab-regexp' Specify SPACEs before TAB -;; regexp. -;; -;; `whitespace-indentation-regexp' Specify regexp for 8 or more -;; SPACEs at beginning of line. -;; -;; `whitespace-big-indent-regexp' Specify big indentation at beginning of line -;; regexp. -;; -;; `whitespace-empty-at-bob-regexp' Specify regexp for empty lines -;; at beginning of buffer. -;; -;; `whitespace-empty-at-eob-regexp' Specify regexp for empty lines -;; at end of buffer. -;; -;; `whitespace-space-after-tab-regexp' Specify regexp for 8 or more -;; SPACEs after TAB. -;; -;; `whitespace-line-column' Specify column beyond which the line -;; is highlighted. -;; -;; `whitespace-display-mappings' Specify an alist of mappings -;; for displaying characters. -;; -;; `whitespace-global-modes' Modes for which global -;; `whitespace-mode' is automagically -;; turned on. -;; -;; `whitespace-action' Specify which action is taken when a -;; buffer is visited or written. -;; -;; ;; Acknowledgments ;; --------------- ;; @@ -440,8 +332,8 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. - indentation::tab 8 or more SPACEs at beginning of line are - visualized via faces. + indentation::tab `tab-width' or more SPACEs at beginning of line + are visualized via faces. It has effect only if `face' (see above) is present in `whitespace-style'. @@ -450,10 +342,10 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. - indentation 8 or more SPACEs at beginning of line are - visualized, if `indent-tabs-mode' (which see) - is non-nil; otherwise, TABs at beginning of - line are visualized via faces. + indentation `tab-width' or more SPACEs at beginning of line + are visualized, if `indent-tabs-mode' (which + see) is non-nil; otherwise, TABs at beginning + of line are visualized via faces. It has effect only if `face' (see above) is present in `whitespace-style'. @@ -461,18 +353,19 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. - space-after-tab::tab 8 or more SPACEs after a TAB are - visualized via faces. + space-after-tab::tab `tab-width' or more SPACEs after a TAB + are visualized via faces. It has effect only if `face' (see above) is present in `whitespace-style'. - space-after-tab::space TABs are visualized when 8 or more - SPACEs occur after a TAB, via faces. + space-after-tab::space TABs are visualized when `tab-width' or + more SPACEs occur after a TAB, via + faces. It has effect only if `face' (see above) is present in `whitespace-style'. - space-after-tab 8 or more SPACEs after a TAB are - visualized, if `indent-tabs-mode' + space-after-tab `tab-width' or more SPACEs after a TAB + are visualized, if `indent-tabs-mode' (which see) is non-nil; otherwise, the TABs are visualized via faces. It has effect only if `face' (see above) @@ -528,14 +421,14 @@ these values is: 2. space-before-tab::tab 3. space-before-tab::space -So, for example, if indentation and indentation::space are -included in `whitespace-style' list, the indentation value is -evaluated instead of indentation::space value. +For example, if `indentation' and `indentation::space' are +included in `whitespace-style', the `indentation' value is used +instead of the `indentation::space' value. -One reason for not visualize spaces via faces (if `face' is not -included in `whitespace-style') is to use exclusively for -cleaning up a buffer. See `whitespace-cleanup' and -`whitespace-cleanup-region' for documentation. +One reason to not use faces to visualize spaces (i.e., not +include `face' in `whitespace-style') is to use `whitespace-mode' +only for cleaning up a buffer. See `whitespace-cleanup' and +`whitespace-cleanup-region'. See also `whitespace-display-mappings' for documentation." :type '(set :tag "Kind of Blank" @@ -677,14 +570,14 @@ Used when `whitespace-style' includes the value `space-before-tab'.") (defvar whitespace-indentation 'whitespace-indentation - "Symbol face used to visualize 8 or more SPACEs at beginning of line. -Used when `whitespace-style' includes the value `indentation'.") + "Symbol face used to visualize `tab-width' or more SPACEs at beginning of +line. Used when `whitespace-style' includes the value `indentation'.") (make-obsolete-variable 'whitespace-indentation "use the face instead." "24.4") (defface whitespace-indentation '((((class mono)) :inverse-video t :weight bold :underline t) (t :background "yellow" :foreground "firebrick")) - "Face used to visualize 8 or more SPACEs at beginning of line." + "Face used to visualize `tab-width' or more SPACEs at beginning of line." :group 'whitespace) (defface whitespace-big-indent @@ -707,7 +600,7 @@ Used when `whitespace-style' includes the value `empty'.") (defvar whitespace-space-after-tab 'whitespace-space-after-tab - "Symbol face used to visualize 8 or more SPACEs after TAB. + "Symbol face used to visualize `tab-width' or more SPACEs after TAB. Used when `whitespace-style' includes the value `space-after-tab'.") (make-obsolete-variable 'whitespace-space-after-tab "use the face instead." "24.4") @@ -715,7 +608,7 @@ Used when `whitespace-style' includes the value `space-after-tab'.") (defface whitespace-space-after-tab '((((class mono)) :inverse-video t :weight bold :underline t) (t :background "yellow" :foreground "firebrick")) - "Face used to visualize 8 or more SPACEs after TAB." + "Face used to visualize `tab-width' or more SPACEs after TAB." :group 'whitespace) @@ -816,7 +709,7 @@ Used when `whitespace-style' includes `space-before-tab', (defcustom whitespace-indentation-regexp '("^\t*\\(\\( \\{%d\\}\\)+\\)[^\n\t]" . "^ *\\(\t+\\)[^\n]") - "Specify regexp for 8 or more SPACEs at beginning of line. + "Specify regexp for `tab-width' or more SPACEs at beginning of line. It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. @@ -828,7 +721,7 @@ Used when `whitespace-style' includes `indentation', :group 'whitespace) -(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)" +(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" "Specify regexp for empty lines at beginning of buffer. Used when `whitespace-style' includes `empty'." @@ -836,7 +729,7 @@ Used when `whitespace-style' includes `empty'." :group 'whitespace) -(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)" +(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]*\\(\n\\{2,\\}\\|[ \t]+\\)\\)\\'" "Specify regexp for empty lines at end of buffer. Used when `whitespace-style' includes `empty'." @@ -845,9 +738,9 @@ Used when `whitespace-style' includes `empty'." (defcustom whitespace-space-after-tab-regexp - '("\t+\\(\\( \\{%d\\}\\)+\\)" - . "\\(\t+\\) +") - "Specify regexp for 8 or more SPACEs after TAB. + '("\t+\\(\\( \\{%d,\\}\\)+\\)" + . "\\(\t+\\) \\{%d,\\}") + "Specify regexp for `tab-width' or more SPACEs after TAB. It is a cons where the cons car is used for SPACEs visualization and the cons cdr is used for TABs visualization. @@ -1031,8 +924,10 @@ Any other value is treated as nil." (define-minor-mode whitespace-mode "Toggle whitespace visualization (Whitespace mode). With a prefix argument ARG, enable Whitespace mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'." @@ -1054,8 +949,10 @@ See also `whitespace-style', `whitespace-newline' and (define-minor-mode whitespace-newline-mode "Toggle newline visualization (Whitespace Newline mode). With a prefix argument ARG, enable Whitespace Newline mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. +is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. Use `whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE @@ -1082,8 +979,10 @@ See also `whitespace-newline' and `whitespace-display-mappings'." (define-minor-mode global-whitespace-mode "Toggle whitespace visualization globally (Global Whitespace mode). With a prefix argument ARG, enable Global Whitespace mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable it if ARG is omitted or nil. +is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'." @@ -1141,8 +1040,10 @@ This variable is normally modified via `add-function'.") (define-minor-mode global-whitespace-newline-mode "Toggle global newline visualization (Global Whitespace Newline mode). With a prefix argument ARG, enable Global Whitespace Newline mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable it if ARG is omitted or nil. +if ARG is positive, and disable it otherwise. + +If called from Lisp, also enables the mode if ARG is omitted or nil, +and toggles it if ARG is `toggle'. Use `global-whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including @@ -1445,13 +1346,13 @@ The problems cleaned up are: If `whitespace-style' includes the value `empty', remove all empty lines at beginning and/or end of buffer. -3. 8 or more SPACEs at beginning of line. +3. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by + TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -1468,7 +1369,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -6. 8 or more SPACEs after TAB. +6. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -1489,10 +1390,10 @@ documentation." current-prefix-arg) mark-active) ;; PROBLEMs 1 and 2 are not handled in region - ;; PROBLEM 3: 8 or more SPACEs at bol + ;; PROBLEM 3: `tab-width' or more SPACEs at bol ;; PROBLEM 4: SPACEs before TAB ;; PROBLEM 5: SPACEs or TABs at eol - ;; PROBLEM 6: 8 or more SPACEs after TAB + ;; PROBLEM 6: `tab-width' or more SPACEs after TAB (whitespace-cleanup-region (region-beginning) (region-end))) ;; whole buffer (t @@ -1507,12 +1408,12 @@ documentation." (when (looking-at whitespace-empty-at-bob-regexp) (delete-region (match-beginning 1) (match-end 1))) (when (re-search-forward - (concat whitespace-empty-at-eob-regexp "\\'") nil t) + whitespace-empty-at-eob-regexp nil t) (delete-region (match-beginning 1) (match-end 1))))))) - ;; PROBLEM 3: 8 or more SPACEs at bol + ;; PROBLEM 3: `tab-width' or more SPACEs at bol ;; PROBLEM 4: SPACEs before TAB ;; PROBLEM 5: SPACEs or TABs at eol - ;; PROBLEM 6: 8 or more SPACEs after TAB + ;; PROBLEM 6: `tab-width' or more SPACEs after TAB (whitespace-cleanup-region (point-min) (point-max))))) (defun whitespace-ensure-local-variables () @@ -1528,13 +1429,13 @@ documentation." The problems cleaned up are: -1. 8 or more SPACEs at beginning of line. +1. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by TABs, + if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -1551,7 +1452,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -4. 8 or more SPACEs after TAB. +4. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -1576,9 +1477,9 @@ documentation." tmp) (save-excursion (save-match-data ;FIXME: Why? - ;; PROBLEM 1: 8 or more SPACEs at bol + ;; PROBLEM 1: `tab-width' or more SPACEs at bol (cond - ;; ACTION: replace 8 or more SPACEs at bol by TABs, if + ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs, if ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs ;; by SPACEs. ((memq 'indentation whitespace-style) @@ -1590,7 +1491,7 @@ documentation." (delete-horizontal-space) (unless (eolp) (indent-to tmp))))) - ;; ACTION: replace 8 or more SPACEs at bol by TABs. + ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs. ((memq 'indentation::tab whitespace-style) (whitespace-replace-action 'tabify rstart rend @@ -1606,16 +1507,16 @@ documentation." (whitespace-replace-action 'delete-region rstart rend whitespace-trailing-regexp 1)) - ;; PROBLEM 4: 8 or more SPACEs after TAB + ;; PROBLEM 4: `tab-width' or more SPACEs after TAB (cond - ;; ACTION: replace 8 or more SPACEs by TABs, if + ;; ACTION: replace `tab-width' or more SPACEs by TABs, if ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs ;; by SPACEs. ((memq 'space-after-tab whitespace-style) (whitespace-replace-action (if whitespace-indent-tabs-mode 'tabify 'untabify) rstart rend (whitespace-space-after-tab-regexp) 1)) - ;; ACTION: replace 8 or more SPACEs by TABs. + ;; ACTION: replace `tab-width' or more SPACEs by TABs. ((memq 'space-after-tab::tab whitespace-style) (whitespace-replace-action 'tabify rstart rend @@ -1666,13 +1567,15 @@ See also `tab-width'." (defun whitespace-regexp (regexp &optional kind) "Return REGEXP depending on `whitespace-indent-tabs-mode'." - (cond - ((or (eq kind 'tab) - whitespace-indent-tabs-mode) - (format (car regexp) whitespace-tab-width)) - ((or (eq kind 'space) - (not whitespace-indent-tabs-mode)) - (cdr regexp)))) + (format + (cond + ((or (eq kind 'tab) + whitespace-indent-tabs-mode) + (car regexp)) + ((or (eq kind 'space) + (not whitespace-indent-tabs-mode)) + (cdr regexp))) + whitespace-tab-width)) (defun whitespace-indentation-regexp (&optional kind) @@ -1713,15 +1616,15 @@ See also `tab-width'." empty [] [] empty lines at beginning of buffer empty [] [] empty lines at end of buffer trailing [] [] SPACEs or TABs at end of line - indentation [] [] 8 or more SPACEs at beginning of line - indentation::tab [] [] 8 or more SPACEs at beginning of line + indentation [] [] >= `tab-width' SPACEs at beginning of line + indentation::tab [] [] >= `tab-width' SPACEs at beginning of line indentation::space [] [] TABs at beginning of line space-before-tab [] [] SPACEs before TAB space-before-tab::tab [] [] SPACEs before TAB: SPACEs space-before-tab::space [] [] SPACEs before TAB: TABs - space-after-tab [] [] 8 or more SPACEs after TAB - space-after-tab::tab [] [] 8 or more SPACEs after TAB: SPACEs - space-after-tab::space [] [] 8 or more SPACEs after TAB: TABs + space-after-tab [] [] >= `tab-width' SPACEs after TAB + space-after-tab::tab [] [] >= `tab-width' SPACEs after TAB: SPACEs + space-after-tab::space [] [] >= `tab-width' SPACEs after TAB: TABs indent-tabs-mode = tab-width = \n\n" @@ -1735,14 +1638,14 @@ See also `tab-width'." empty [] [] empty lines at end of buffer trailing [] [] SPACEs or TABs at end of line indentation [] [] TABs at beginning of line - indentation::tab [] [] 8 or more SPACEs at beginning of line + indentation::tab [] [] >= `tab-width' SPACEs at beginning of line indentation::space [] [] TABs at beginning of line space-before-tab [] [] SPACEs before TAB space-before-tab::tab [] [] SPACEs before TAB: SPACEs space-before-tab::space [] [] SPACEs before TAB: TABs - space-after-tab [] [] 8 or more SPACEs after TAB - space-after-tab::tab [] [] 8 or more SPACEs after TAB: SPACEs - space-after-tab::space [] [] 8 or more SPACEs after TAB: TABs + space-after-tab [] [] >= `tab-width' SPACEs after TAB + space-after-tab::tab [] [] >= `tab-width' SPACEs after TAB: SPACEs + space-after-tab::space [] [] >= `tab-width' SPACEs after TAB: TABs indent-tabs-mode = tab-width = \n\n") @@ -1776,13 +1679,8 @@ non-nil. If FORCE is non-nil or \\[universal-argument] was pressed just before calling `whitespace-report-region' interactively, it -forces `whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab +forces all classes of whitespace problem to be considered +significant. If REPORT-IF-BOGUS is t, it reports only when there are any whitespace problems in buffer; if it is `never', it does not @@ -1794,9 +1692,9 @@ Report if some of the following whitespace problems exist: empty 1. empty lines at beginning of buffer. empty 2. empty lines at end of buffer. trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. + indentation 4. line starts with `tab-width' or more SPACEs. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. * If `indent-tabs-mode' is nil: empty 1. empty lines at beginning of buffer. @@ -1804,7 +1702,7 @@ Report if some of the following whitespace problems exist: trailing 3. SPACEs or TABs at end of line. indentation 4. TABS at beginning of line. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. See `whitespace-style' for documentation. See also `whitespace-cleanup' and `whitespace-cleanup-region' for @@ -1816,11 +1714,15 @@ cleaning up these problems." (let* ((has-bogus nil) (rstart (min start end)) (rend (max start end)) + ;; Fall back to whitespace-style so we can run before + ;; before the mode is active. + (style (copy-sequence + (or whitespace-active-style whitespace-style))) (bogus-list (mapcar #'(lambda (option) (when force - (add-to-list 'whitespace-style (car option))) + (add-to-list 'style (car option))) (goto-char rstart) (let ((regexp (cond @@ -1838,8 +1740,10 @@ cleaning up these problems." (whitespace-space-after-tab-regexp 'space)) (t (cdr option))))) - (and (re-search-forward regexp rend t) - (setq has-bogus t)))) + (when (re-search-forward regexp rend t) + (unless has-bogus + (setq has-bogus (memq (car option) style))) + t))) whitespace-report-list))) (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) @@ -1858,7 +1762,7 @@ cleaning up these problems." (dolist (option whitespace-report-list) (forward-line 1) (whitespace-mark-x - 27 (memq (car option) whitespace-style)) + 27 (memq (car option) style)) (whitespace-mark-x 7 (car bogus-list)) (setq bogus-list (cdr bogus-list))) (forward-line 1) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f0054be4c8b..10b10456f3a 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -102,8 +102,6 @@ This exists as a variable so it can be set locally in certain buffers.") "Face used for documentation text." :group 'widget-documentation :group 'widget-faces) -(define-obsolete-face-alias 'widget-documentation-face - 'widget-documentation "22.1") (defvar widget-button-face 'widget-button "Face used for buttons in widgets. @@ -112,7 +110,6 @@ This exists as a variable so it can be set locally in certain buffers.") (defface widget-button '((t (:weight bold))) "Face used for widget buttons." :group 'widget-faces) -(define-obsolete-face-alias 'widget-button-face 'widget-button "22.1") (defcustom widget-mouse-face 'highlight "Face used for widget buttons when the mouse is above them." @@ -135,7 +132,6 @@ This exists as a variable so it can be set locally in certain buffers.") :slant italic)) "Face used for editable fields." :group 'widget-faces) -(define-obsolete-face-alias 'widget-field-face 'widget-field "22.1") (defface widget-single-line-field '((((type tty)) :background "green3" @@ -150,8 +146,6 @@ This exists as a variable so it can be set locally in certain buffers.") :slant italic)) "Face used for editable fields spanning only a single line." :group 'widget-faces) -(define-obsolete-face-alias 'widget-single-line-field-face - 'widget-single-line-field "22.1") ;;; This causes display-table to be loaded, and not usefully. ;;;(defvar widget-single-line-display-table @@ -427,8 +421,6 @@ the :notify function can't know the new value.") '((t :inherit shadow)) "Face used for inactive widgets." :group 'widget-faces) -(define-obsolete-face-alias 'widget-inactive-face - 'widget-inactive "22.1") (defun widget-specify-inactive (widget from to) "Make WIDGET inactive for user modifications." @@ -905,8 +897,6 @@ Note that such modes will need to require wid-edit.") (:weight bold :underline t))) "Face used for pressed buttons." :group 'widget-faces) -(define-obsolete-face-alias 'widget-button-pressed-face - 'widget-button-pressed "22.1") (defvar widget-button-click-moves-point nil "If non-nil, `widget-button-click' moves point to a button after invoking it. @@ -1789,7 +1779,13 @@ If END is omitted, it defaults to the length of LIST." "An embedded link." :button-prefix 'widget-link-prefix :button-suffix 'widget-link-suffix - :follow-link 'mouse-face + ;; The `follow-link' property should only be used in those contexts where the + ;; mouse-1 event normally doesn't follow the link, yet the `link' widget + ;; seems to almost always be used in contexts where (down-)mouse-1 is bound + ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is + ;; not necessary (and can even be harmful). So let's not add a :follow-link + ;; by default. See (bug#22434). + ;; :follow-link 'mouse-face :help-echo "Follow the link." :format "%[%t%]") diff --git a/lisp/widget.el b/lisp/widget.el index 2db645ab08d..1574fb265c6 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -68,7 +68,6 @@ ;; :button-face-get :button-face :value-face :keymap :entry-from ;; :entry-to :help-echo :documentation-property :tab-order) -(put 'define-widget 'doc-string-elt 3) ;`declare' doesn't work in functions. (defun define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. @@ -80,9 +79,10 @@ create identical widgets: * (widget-create NAME) -* (apply \\='widget-create CLASS ARGS) +* (apply #\\='widget-create CLASS ARGS) The third argument DOC is a documentation string for the widget." + (declare (doc-string 3)) ;; (unless (or (null doc) (stringp doc)) (error "widget documentation must be nil or a string.")) @@ -91,7 +91,7 @@ The third argument DOC is a documentation string for the widget." name) ;; This is used by external widget code (in W3, at least). -(defalias 'widget-plist-member 'plist-member) +(define-obsolete-function-alias 'widget-plist-member #'plist-member "26.1") ;;; The End. diff --git a/lisp/window.el b/lisp/window.el index 1d41d821dc4..5255905f457 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,4 +1,4 @@ -;;; window.el --- GNU Emacs window commands aside from those written in C +;;; window.el --- GNU Emacs window commands aside from those written in C -*- lexical-binding:t -*- ;; Copyright (C) 1985, 1989, 1992-1994, 2000-2016 Free Software ;; Foundation, Inc. @@ -651,13 +651,13 @@ failed." (window-combination-limit t) (window-combination-resize 'atom) (window (cdr (assq 'window alist))) - (side (cdr (assq 'side alist))) + (side (or (cdr (assq 'side alist)) 'below)) (atom (when window (window-parameter window 'window-atom))) root new) (setq window (window-normalize-window window)) (setq root (window-atom-root window)) ;; Split off new window. - (when (setq new (split-window window nil side)) + (when (setq new (split-window-no-error window nil side)) (window-make-atom (if (and root (not (eq root window))) ;; When WINDOW was part of an atomic window and we did not @@ -709,24 +709,50 @@ no child windows or one of its child windows is not atomic." (window--atom-check-1 (frame-root-window frame))) ;; Side windows. -(defvar window-sides '(left top right bottom) - "Window sides.") - (defcustom window-sides-vertical nil - "If non-nil, left and right side windows are full height. -Otherwise, top and bottom side windows are full width." + "If non-nil, left and right side windows occupy full frame height. +If nil, top and bottom side windows occupy full frame width." :type 'boolean + :initialize 'custom-initialize-default + :set 'window--sides-verticalize :group 'windows - :version "24.1") + :version "26.1") + +(defcustom window-sides-reversed nil + "Whether top/bottom side windows appear in reverse order. +When this is nil, side windows on the top and bottom of a frame +are always drawn from left to right with increasing slot values. +When this is t, side windows on the top and bottom of a frame are +always drawn from right to left with increasing slot values. + +When this is `bidi', the drawing order is like that for the value +t if the value of `bidi-paragraph-direction' is `right-to-left' +in the buffer most recently shown in the window selected within +the main window area of this frame. + +The layout of side windows on the left or right of a frame is not +affected by the value of this variable." + :type + '(choice (const :tag "Never" nil) + (const :tag "Bidi" bidi) + (const :tag "Always" t)) + :initialize 'custom-initialize-default + :set 'window--sides-reverse + :group 'windows + :version "26.1") (defcustom window-sides-slots '(nil nil nil nil) - "Maximum number of side window slots. -The value is a list of four elements specifying the number of -side window slots on (in this order) the left, top, right and -bottom side of each frame. If an element is a number, this means -to display at most that many side windows on the corresponding -side. If an element is nil, this means there's no bound on the -number of slots on that side." + "Number of available side window slots on each side of a frame. +The value is a list of four elements specifying the maximum +number of side windows that may be created on the left, top, +right and bottom side of any frame. + +If an element is a number, `display-buffer-in-side-window' will +refrain from making a new side window if the number of windows on +that side is equal to or exceeds that number. Rather, it will +reuse the window whose `window-slot' value is nearest to the slot +specified via its ALIST argument. If an element is nil, this +means there's no bound on the number of windows on that side." :version "24.1" :risky t :type @@ -734,56 +760,94 @@ number of slots on that side." :value (nil nil nil nil) (choice :tag "Left" - :help-echo "Maximum slots of left side window." + :help-echo "Maximum number of left side windows." :value nil :format "%[Left%] %v\n" (const :tag "Unlimited" :format "%t" nil) (integer :tag "Number" :value 2 :size 5)) (choice :tag "Top" - :help-echo "Maximum slots of top side window." + :help-echo "Maximum number of top side windows." :value nil :format "%[Top%] %v\n" (const :tag "Unlimited" :format "%t" nil) (integer :tag "Number" :value 3 :size 5)) (choice :tag "Right" - :help-echo "Maximum slots of right side window." + :help-echo "Maximum number of right side windows." :value nil :format "%[Right%] %v\n" (const :tag "Unlimited" :format "%t" nil) (integer :tag "Number" :value 2 :size 5)) (choice :tag "Bottom" - :help-echo "Maximum slots of bottom side window." + :help-echo "Maximum number of bottom side windows." :value nil :format "%[Bottom%] %v\n" (const :tag "Unlimited" :format "%t" nil) (integer :tag "Number" :value 3 :size 5))) :group 'windows) -(defun window--side-window-p (window) - "Return non-nil if WINDOW is a side window or the parent of one." - (or (window-parameter window 'window-side) - (and (window-child window) - (or (window-parameter - (window-child window) 'window-side) - (window-parameter - (window-last-child window) 'window-side))))) - -(defun window--major-non-side-window (&optional frame) - "Return the major non-side window of frame FRAME. +(defvar-local window--sides-shown nil + "Non-nil if this buffer was shown in a side window once. +If this variable is non-nil in a buffer, `switch-to-prev-buffer' +and `switch-to-next-buffer' will refrain from showing this buffer +within the main window area. `display-buffer-in-side-window' +sets this variable automatically. + +Killing buffer local variables after showing the buffer in a side +window annihilates any effect provided by this variable.") + +(defvar window--sides-inhibit-check nil + "Non-nil means inhibit any checks on side windows.") + +(defun window--sides-reverse-on-frame-p (frame) + "Return non-nil when side windows should appear reversed on FRAME. +This uses some heuristics to guess the user's intentions when the +selected window of FRAME is a side window ." + (cond + ;; Reverse when `window-sides-reversed' is t. Do not reverse when + ;; `window-sides-reversed' is nil. + ((memq window-sides-reversed '(nil t)) + window-sides-reversed) + ;; Reverse when FRAME's selected window shows a right-to-left buffer. + ((let ((window (frame-selected-window frame))) + (when (and (not (window-parameter window 'window-side)) + (or (not (window-minibuffer-p window)) + (setq window (minibuffer-selected-window)))) + (with-current-buffer (window-buffer window) + (eq bidi-paragraph-direction 'right-to-left))))) + ;; Reverse when FRAME's `window-sides-main-selected-window' parameter + ;; specifies a live window showing a right-to-left buffer. + ((let ((window (frame-parameter + frame 'window-sides-main-selected-window))) + (when (window-live-p window) + (with-current-buffer (window-buffer window) + (eq bidi-paragraph-direction 'right-to-left))))) + ;; Reverse when all windows in FRAME's main window show right-to-left + ;; buffers. + (t + (catch 'found + (walk-window-subtree + (lambda (window) + (with-current-buffer (window-buffer window) + (when (eq bidi-paragraph-direction 'left-to-right) + (throw 'found nil)))) + (window-main-window frame)) + t)))) + +(defun window-main-window (&optional frame) + "Return the main window of specified FRAME. The optional argument FRAME must be a live frame and defaults to the selected one. -If FRAME has at least one side window, the major non-side window -is either an internal non-side window such that all other -non-side windows on FRAME descend from it, or the single live -non-side window of FRAME. If FRAME has no side windows, return -its root window." +If FRAME has no side windows, return FRAME's root window. +Otherwise, return either an internal non-side window such that +all other non-side windows on FRAME descend from it, or the +single live non-side window of FRAME." (let ((frame (window-normalize-frame frame)) - major sibling) - ;; Set major to the _last_ window found by `walk-window-tree' that + main sibling) + ;; Set main to the _last_ window found by `walk-window-tree' that ;; is not a side window but has a side window as its sibling. (walk-window-tree (lambda (window) @@ -792,16 +856,20 @@ its root window." (window-parameter sibling 'window-side)) (and (setq sibling (window-next-sibling window)) (window-parameter sibling 'window-side))) - (setq major window))) + (setq main window))) frame t 'nomini) - (or major (frame-root-window frame)))) + (or main (frame-root-window frame)))) -(defun window--major-side-window (side) - "Return major side window on SIDE. +(defun window--make-major-side-window-next-to (side) + "Return window to split for making a major side window. SIDE must be one of the symbols `left', `top', `right' or -`bottom'. Return nil if no such window exists." +`bottom'. + +This is an auxiliary function of `window--make-major-side-window' +and must not be called when a window on SIDE exists already." (let ((root (frame-root-window)) - window) + (window--sides-inhibit-check t) + window) ;; (1) If a window on the opposite side exists, return that window's ;; sibling. ;; (2) If the new window shall span the entire side, return the @@ -839,35 +907,37 @@ SIDE must be one of the symbols `left', `top', `right' or (window-prev-sibling window)) (t root)))))) -(defun display-buffer-in-major-side-window (buffer side slot &optional alist) - "Display BUFFER in a new window on SIDE of the selected frame. +(defun window--make-major-side-window (buffer side slot &optional alist) + "Display BUFFER in a new major side window on the selected frame. SIDE must be one of `left', `top', `right' or `bottom'. SLOT specifies the slot to use. ALIST is an association list of symbols and values as passed to `display-buffer-in-side-window'. -This function may be called only if no window on SIDE exists yet. -The new window automatically becomes the \"major\" side window on -SIDE. Return the new window, nil if its creation window failed." +Return the new window, nil if its creation failed. + +This is an auxiliary function of `display-buffer-in-side-window' +and may be called only if no window on SIDE exists yet." (let* ((left-or-right (memq side '(left right))) - (major (window--major-side-window side)) + (next-to (window--make-major-side-window-next-to side)) (on-side (cond ((eq side 'top) 'above) ((eq side 'bottom) 'below) (t side))) + (window--sides-inhibit-check t) ;; The following two bindings will tell `split-window' to take - ;; the space for the new window from `major' and not make a new - ;; parent window unless needed. + ;; the space for the new window from the selected frame's main + ;; window and not make a new parent window unless needed. (window-combination-resize 'side) (window-combination-limit nil) - (new (split-window major nil on-side))) - (when new - ;; Initialize `window-side' parameter of new window to SIDE. - (set-window-parameter new 'window-side side) - ;; Install `window-slot' parameter of new window. - (set-window-parameter new 'window-slot slot) - ;; Install `delete-window' parameter thus making sure that when - ;; the new window is deleted, a side window on the opposite side - ;; does not get resized. - (set-window-parameter new 'delete-window 'delete-side-window) + (window (split-window-no-error next-to nil on-side))) + (when window + ;; Initialize `window-side' parameter of new window to SIDE and + ;; make that parameter persistent. + (set-window-parameter window 'window-side side) + (add-to-list 'window-persistent-parameters '(window-side . writable)) + ;; Install `window-slot' parameter of new window and make that + ;; parameter persistent. + (set-window-parameter window 'window-slot slot) + (add-to-list 'window-persistent-parameters '(window-slot . writable)) ;; Auto-adjust height/width of new window unless a size has been ;; explicitly requested. (unless (if left-or-right @@ -882,15 +952,10 @@ SIDE. Return the new window, nil if its creation window failed." ;; root window. 4)) alist))) - ;; Install BUFFER in new window and return NEW. - (window--display-buffer buffer new 'window alist 'side)))) - -(defun delete-side-window (window) - "Delete side window WINDOW." - (let ((window-combination-resize - (window-parameter (window-parent window) 'window-side)) - (ignore-window-parameters t)) - (delete-window window))) + (with-current-buffer buffer + (setq window--sides-shown t)) + ;; Install BUFFER in new window and return WINDOW. + (window--display-buffer buffer window 'window alist 'side)))) (defun display-buffer-in-side-window (buffer alist) "Display BUFFER in a side window of the selected frame. @@ -906,9 +971,27 @@ following special symbols can be used in ALIST. the specified side. A negative value means use a slot preceding (that is, above or on the left of) the middle slot. A positive value means use a slot following (that is, below or - on the right of) the middle slot. The default is zero." - (let ((side (or (cdr (assq 'side alist)) 'bottom)) - (slot (or (cdr (assq 'slot alist)) 0))) + on the right of) the middle slot. The default is zero. + +If the current frame size or the settings of `window-sides-slots' +do not permit making a new window, a suitable existing window may +be reused and have its `window-slot' parameter value accordingly +modified. + +Unless `display-buffer-mark-dedicated' is non-nil, softly +dedicate the side window used to BUFFER. Return the window used +for displaying BUFFER, nil if no suitable window can be found. + +This function installs the `window-side' and `window-slot' +parameters and makes them persistent. It neither modifies ALIST +nor installs any other window parameters unless they have been +explicitly provided via a `window-parameter' entry in ALIST." + (let* ((side (or (cdr (assq 'side alist)) 'bottom)) + (slot (or (cdr (assq 'slot alist)) 0)) + (left-or-right (memq side '(left right))) + ;; Softly dedicate window to BUFFER unless + ;; `display-buffer-mark-dedicated' already asks for it. + (dedicated (or display-buffer-mark-dedicated 'side))) (cond ((not (memq side '(top bottom left right))) (error "Invalid side %s specified" side)) @@ -918,15 +1001,20 @@ following special symbols can be used in ALIST. (let* ((major (window-with-parameter 'window-side side nil t)) ;; `major' is the major window on SIDE, `windows' the list of ;; life windows on SIDE. - (windows - (when major - (let (windows) - (walk-window-tree - (lambda (window) - (when (eq (window-parameter window 'window-side) side) - (setq windows (cons window windows)))) - nil nil 'nomini) - (nreverse windows)))) + (reversed (window--sides-reverse-on-frame-p (selected-frame))) + (windows + (cond + ((window-live-p major) + (list major)) + ((window-valid-p major) + (let* ((first (window-child major)) + (next (window-next-sibling first)) + (windows (list next first))) + (setq reversed (> (window-parameter first 'window-slot) + (window-parameter next 'window-slot))) + (while (setq next (window-next-sibling next)) + (setq windows (cons next windows))) + (if reversed windows (nreverse windows)))))) (slots (when major (max 1 (window-child-count major)))) (max-slots (nth (cond @@ -935,17 +1023,18 @@ following special symbols can be used in ALIST. ((eq side 'right) 2) ((eq side 'bottom) 3)) window-sides-slots)) + (window--sides-inhibit-check t) window this-window this-slot prev-window next-window best-window best-slot abs-slot) (cond ((and (numberp max-slots) (<= max-slots 0)) - ;; No side-slots available on this side. Don't create an error, + ;; No side-slots available on this side. Don't raise an error, ;; just return nil. nil) ((not windows) - ;; No major window exists on this side, make one. - (display-buffer-in-major-side-window buffer side slot alist)) + ;; No major side window exists on this side, make one. + (window--make-major-side-window buffer side slot alist)) (t ;; Scan windows on SIDE. (catch 'found @@ -953,7 +1042,7 @@ following special symbols can be used in ALIST. (setq this-slot (window-parameter window 'window-slot)) (cond ;; The following should not happen and probably be checked - ;; by window--side-check. + ;; by window--sides-check. ((not (numberp this-slot))) ((= this-slot slot) ;; A window with a matching slot has been found. @@ -970,131 +1059,241 @@ following special symbols can be used in ALIST. (unless (and best-slot (<= best-slot abs-slot)) (setq best-window window) (setq best-slot abs-slot)) - (cond - ((<= this-slot slot) - (setq prev-window window)) - ((not next-window) - (setq next-window window))))))) - - ;; `this-window' is the first window with the same SLOT. + (if reversed + (cond + ((<= this-slot slot) + (setq next-window window)) + ((not prev-window) + (setq prev-window window))) + (cond + ((<= this-slot slot) + (setq prev-window window)) + ((not next-window) + (setq next-window window)))))))) + + ;; `this-window' is the first window with the same SLOT. ;; `prev-window' is the window with the largest slot < SLOT. A new ;; window will be created after it. ;; `next-window' is the window with the smallest slot > SLOT. A new ;; window will be created before it. ;; `best-window' is the window with the smallest absolute difference ;; of its slot and SLOT. - - ;; Note: We dedicate the window used softly to its buffer to - ;; avoid that "other" (non-side) buffer display functions steal - ;; it from us. This must eventually become customizable via - ;; ALIST (or, better, avoided in the "other" functions). (or (and this-window ;; Reuse `this-window'. - (window--display-buffer buffer this-window 'reuse alist 'side)) + (with-current-buffer buffer + (setq window--sides-shown t)) + (window--display-buffer + buffer this-window 'reuse alist dedicated)) (and (or (not max-slots) (< slots max-slots)) (or (and next-window ;; Make new window before `next-window'. - (let ((next-side - (if (memq side '(left right)) 'above 'left)) + (let ((next-side (if left-or-right 'above 'left)) (window-combination-resize 'side)) - (setq window (split-window next-window nil next-side)) - ;; When the new window is deleted, its space - ;; is returned to other side windows. - (set-window-parameter - window 'delete-window 'delete-side-window) - window)) + (setq window (split-window-no-error + next-window nil next-side)))) (and prev-window ;; Make new window after `prev-window'. - (let ((prev-side - (if (memq side '(left right)) 'below 'right)) + (let ((prev-side (if left-or-right 'below 'right)) (window-combination-resize 'side)) - (setq window (split-window prev-window nil prev-side)) - ;; When the new window is deleted, its space - ;; is returned to other side windows. - (set-window-parameter - window 'delete-window 'delete-side-window) - window))) + (setq window (split-window-no-error + prev-window nil prev-side))))) (set-window-parameter window 'window-slot slot) - (window--display-buffer buffer window 'window alist 'side)) + (with-current-buffer buffer + (setq window--sides-shown t)) + (window--display-buffer + buffer window 'window alist dedicated)) (and best-window ;; Reuse `best-window'. (progn ;; Give best-window the new slot value. (set-window-parameter best-window 'window-slot slot) - (window--display-buffer - buffer best-window 'reuse alist 'side))))))))) - -(defun window--side-check (&optional frame) - "Check the side window configuration of FRAME. -FRAME defaults to the selected frame. - -A valid side window configuration preserves the following two -invariants: - -- If there exists a window whose window-side parameter is - non-nil, there must exist at least one live window whose - window-side parameter is nil. - -- If a window W has a non-nil window-side parameter (i) it must - have a parent window and that parent's window-side parameter - must be either nil or the same as for W, and (ii) any child - window of W must have the same window-side parameter as W. - -If the configuration is invalid, reset the window-side parameters -of all windows on FRAME to nil." - (let (left top right bottom none side parent parent-side) - (when (or (catch 'reset - (walk-window-tree - (lambda (window) - (setq side (window-parameter window 'window-side)) - (setq parent (window-parent window)) - (setq parent-side - (and parent (window-parameter parent 'window-side))) - ;; The following `cond' seems a bit tedious, but I'd - ;; rather stick to using just the stack. - (cond - (parent-side - (when (not (eq parent-side side)) - ;; A parent whose window-side is non-nil must - ;; have a child with the same window-side. - (throw 'reset t))) - ((not side) - (when (window-buffer window) - ;; Record that we have at least one non-side, - ;; live window. - (setq none t))) - ((if (memq side '(left top)) - (window-prev-sibling window) - (window-next-sibling window)) - ;; Left and top major side windows must not have a - ;; previous sibling, right and bottom major side - ;; windows must not have a next sibling. - (throw 'reset t)) - ;; Now check that there's no more than one major - ;; window for any of left, top, right and bottom. - ((eq side 'left) - (if left (throw 'reset t) (setq left t))) - ((eq side 'top) - (if top (throw 'reset t) (setq top t))) - ((eq side 'right) - (if right (throw 'reset t) (setq right t))) - ((eq side 'bottom) - (if bottom (throw 'reset t) (setq bottom t))) - (t - (throw 'reset t)))) - frame t 'nomini)) - ;; If there's a side window, there must be at least one - ;; non-side window. - (and (or left top right bottom) (not none))) - (walk-window-tree - (lambda (window) - (set-window-parameter window 'window-side nil)) - frame t 'nomini)))) + (with-current-buffer buffer + (setq window--sides-shown t)) + (window--display-buffer + buffer best-window 'reuse alist dedicated))))))))) + +(defun window-toggle-side-windows (&optional frame) + "Toggle side windows on specified FRAME. +FRAME must be a live frame and defaults to the selected one. + +If FRAME has at least one side window, save FRAME's state in the +FRAME's `window-state' frame parameter and delete all side +windows on FRAME afterwards. Otherwise, if FRAME has a +`window-state' parameter, use that to restore any side windows on +FRAME leaving FRAME's main window alone. Signal an error if +FRAME has no side window and no saved state is found." + (interactive) + (let* ((frame (window-normalize-frame frame)) + (window--sides-inhibit-check t) + state) + (cond + ((window-with-parameter 'window-side nil frame) + ;; At least one side window exists. Remove all side windows after + ;; saving FRAME's state in its `window-state' parameter. + (set-frame-parameter + frame 'window-state (window-state-get (frame-root-window frame))) + (let ((ignore-window-parameters t)) + (delete-other-windows (window-main-window frame)))) + ((setq state (frame-parameter frame 'window-state)) + ;; A window state was saved for FRAME. Restore it and put the + ;; current root window into its main window. + (let ((main-state (window-state-get (frame-root-window frame)))) + (window-state-put state (frame-root-window frame) t) + (window-state-put main-state (window-main-window frame))) + (window--sides-reverse-frame frame)) + (t + (error "No side windows state found"))))) + +(defun window--sides-reverse-all () + "Maybe reverse side windows on all frames." + (unless window--sides-inhibit-check + (dolist (frame (frame-list)) + (window--sides-reverse-frame frame)))) + +(defun window--sides-reverse-frame (frame) + "Maybe reverse side windows on FRAME." + (when (eq window-sides-reversed 'bidi) + (let ((window (frame-selected-window frame))) + (unless (or (window-parameter window 'window-side) + (window-minibuffer-p window)) + (set-frame-parameter + frame 'window-sides-main-selected-window window)))) + (window--sides-reverse-side frame 'top) + (window--sides-reverse-side frame 'bottom)) + +(defun window--sides-reverse-side (frame side) + "Maybe reverse windows on SIDE of FRAME." + (let ((major (window-with-parameter 'window-side side frame t)) + (window--sides-inhibit-check t)) + (when (and major (not (window-live-p major))) + (let* ((first (window-child major)) + (reversed (> (window-parameter first 'window-slot) + (window-parameter + (window-next-sibling first) 'window-slot))) + (reverse (window--sides-reverse-on-frame-p frame))) + (unless (eq reversed reverse) + ;; We have to reverse. + (let ((last (window-last-child major))) + (while (and (not (eq first last)) + (not (eq first (window-next-sibling last)))) + (window-swap-states first last t) + (setq first (window-next-sibling first)) + (setq last (window-prev-sibling last))))))))) + +(defun window--sides-reverse (symbol value) + "Helper function for customizing `window-sides-reversed'." + (set-default symbol value) + (remove-hook 'buffer-list-update-hook 'window--sides-reverse-all) + (remove-hook 'window-configuration-change-hook 'window--sides-reverse-all) + (dolist (frame (frame-list)) + (set-frame-parameter frame 'window-sides-main-selected-window nil)) + (when (eq value 'bidi) + (add-hook 'buffer-list-update-hook 'window--sides-reverse-all) + (add-hook 'window-configuration-change-hook 'window--sides-reverse-all)) + (window--sides-reverse-all)) + +(defun window--sides-verticalize-frame (&optional frame) + "Maybe change side windows layout on specified FRAME." + (setq frame (window-normalize-frame frame)) + (let ((window--sides-inhibit-check t) + (root (frame-root-window frame)) + (main (window-main-window frame))) + (when (and (not (eq main root)) + (not (eq (window-parent main) root)) + (window-combined-p main window-sides-vertical)) + (let* ((window--sides-inhibit-check t) + (ignore-window-parameters t) + (first (window-child root)) + (first-state + (and first (window-parameter first 'window-side) + (window-state-get first))) + (last (window-last-child root)) + (last-state + (and last (window-parameter last 'window-side) + (window-state-get last))) + (dummy (get-buffer-create " *dummy*")) + major) + (unwind-protect + (progn + (when first-state (delete-window first)) + (when last-state (delete-window last)) + (when first-state + (setq major (window--make-major-side-window + dummy (if window-sides-vertical 'top 'left) 0)) + (window-state-put first-state major t)) + (when last-state + (setq major (window--make-major-side-window + dummy (if window-sides-vertical 'bottom 'right) 0)) + (window-state-put last-state major t))) + (kill-buffer " *dummy*")))))) + +(defun window--sides-verticalize (symbol value) + "Helper function for customizing `window-sides-vertical'." + (set-default symbol value) + (dolist (frame (frame-list)) + (window--sides-verticalize-frame frame))) + +(defun window--sides-check-failed (frame) + "Helper function for `window--sides-check'." + (catch 'failed + ;; FRAME must have a main window. + (unless (window-main-window frame) + (error "Frame %s has no main window" frame) + (throw 'failed t)) + ;; Now check the side windows. + (dolist (side '(left top right bottom)) + (let ((window (window-with-parameter 'window-side side frame t))) + (when window + ;; If WINDOW is live there must be no other window on this frame + ;; with the same `window-side' parameter. + (if (window-live-p window) + (walk-window-tree + (lambda (this) + (when (and (eq (window-parameter this 'window-side) side) + (not (eq this window))) + (error "Window %s has same side %s as window %s but no common parent" + this side window) + (throw 'failed t))) + frame t 'nomini) + (walk-window-tree + (lambda (this) + (if (eq (window-parent this) window) + (unless (eq (window-parameter this 'window-side) side) + (error "Window %s has not same side %s as its parent %s" + this side window) + (throw 'failed t)) + (when (and (eq (window-parameter this 'window-side) side) + (not (eq this window))) + (error "Window %s has same side %s as major side window %s but its parent is %s" + this side window (window-parent this)) + (throw 'failed t)))) + frame t 'nomini))))))) + +(defun window--sides-check (frame) + "Check side windows configuration of FRAME. +In a valid side windows configuration there can be at most one +internal side window on each side and all its children must be +live and have the same `window-side' parameter and no other +window with the same `window-side' parameter exists on FRAME. If +there is no such internal window, there may be at most one window +with this side's `window-side' parameter on FRAME. + +If the configuration is invalid, reset the `window-side' +parameters of all windows on FRAME." + (when (and (not window--sides-inhibit-check) + (window-with-parameter 'window-side nil frame t) + (window--sides-check-failed frame)) + ;; Reset all `window-side' parameters. + (walk-window-tree + (lambda (window) + (set-window-parameter window 'window-side nil)) + frame t 'nomini) + (message "Side windows configuration reset for frame %s" frame))) (defun window--check (&optional frame) "Check atomic and side windows on FRAME. FRAME defaults to the selected frame." - (window--side-check frame) + (window--sides-check frame) (window--atom-check frame)) ;; Dumping frame/window contents. @@ -1333,10 +1532,8 @@ return the minimum pixel-size of WINDOW." (window--min-size-1 (window-normalize-window window) horizontal ignore pixelwise)) -(defun window--min-size-ignore-p (window horizontal ignore) - "Return non-nil if IGNORE says to ignore height restrictions for WINDOW. -HORIZONTAL non-nil means to return non-nil if IGNORE says to -ignore width restrictions for WINDOW." +(defun window--min-size-ignore-p (window ignore) + "Return non-nil if IGNORE says to ignore height restrictions for WINDOW." (if (window-valid-p ignore) (eq window ignore) (not (memq ignore '(nil preserved))))) @@ -1383,10 +1580,21 @@ ignore width restrictions for WINDOW." (let* ((char-size (frame-char-size window t)) (fringes (window-fringes window)) (margins (window-margins window)) + ;; Let the 'min-margins' parameter override the actual + ;; widths of the margins. We allow any number to + ;; replace the values specified by `window-margins'. + ;; See bug#24193 for the rationale of this parameter. + (min-margins (window-parameter window 'min-margins)) + (left-min-margin (and min-margins + (numberp (car min-margins)) + (car min-margins))) + (right-min-margin (and min-margins + (numberp (cdr min-margins)) + (cdr min-margins))) (pixel-width (+ (window-safe-min-size window t t) - (* (or (car margins) 0) char-size) - (* (or (cdr margins) 0) char-size) + (* (or left-min-margin (car margins) 0) char-size) + (* (or right-min-margin(cdr margins) 0) char-size) (car fringes) (cadr fringes) (window-scroll-bar-width window) (window-right-divider-width window)))) @@ -1396,12 +1604,12 @@ ignore width restrictions for WINDOW." pixel-width ;; Round up to next integral of columns. (* (ceiling pixel-width char-size) char-size)) - (if (window--min-size-ignore-p window horizontal ignore) + (if (window--min-size-ignore-p window ignore) 0 (window-min-pixel-width window))) (max (ceiling pixel-width char-size) - (if (window--min-size-ignore-p window horizontal ignore) + (if (window--min-size-ignore-p window ignore) 0 window-min-width))))) ((let ((char-size (frame-char-size window)) @@ -1417,11 +1625,11 @@ ignore width restrictions for WINDOW." pixel-height ;; Round up to next integral of lines. (* (ceiling pixel-height char-size) char-size)) - (if (window--min-size-ignore-p window horizontal ignore) + (if (window--min-size-ignore-p window ignore) 0 (window-min-pixel-height window))) (max (ceiling pixel-height char-size) - (if (window--min-size-ignore-p window horizontal ignore) + (if (window--min-size-ignore-p window ignore) 0 window-min-height)))))))))) @@ -1889,9 +2097,19 @@ the font." (ncols (/ window-width font-width))) (if (and (display-graphic-p) overflow-newline-into-fringe - (/= (frame-parameter nil 'left-fringe) 0) - (/= (frame-parameter nil 'right-fringe) 0)) + (not + (or (eq left-fringe-width 0) + (and (null left-fringe-width) + (= (frame-parameter nil 'left-fringe) 0)))) + (not + (or (eq right-fringe-width 0) + (and (null right-fringe-width) + (= (frame-parameter nil 'right-fringe) 0))))) ncols + ;; FIXME: This should remove 1 more column when there are no + ;; fringes, lines are truncated, and the window is hscrolled, + ;; but EOL is not in the view, because then there are 2 + ;; truncation glyphs, not one. (1- ncols))))) (defun window-current-scroll-bars (&optional window) @@ -2612,10 +2830,7 @@ instead." "Resize WINDOW vertically if it is resizable by DELTA lines. This function is like `window-resize' but does not signal an error when WINDOW cannot be resized. For the meaning of the -optional arguments see the documentation of `window-resize'. - -Optional argument PIXELWISE non-nil means interpret DELTA as -pixels." +optional arguments see the documentation of `window-resize'." (when (window--resizable-p window delta horizontal ignore nil nil nil pixelwise) (window-resize window delta horizontal ignore pixelwise))) @@ -3119,8 +3334,8 @@ routines." pixel-delta (/ pixel-delta (frame-char-height frame))))) -(defun window--sanitize-window-sizes (frame horizontal) - "Assert that all windows on FRAME are large enough. +(defun window--sanitize-window-sizes (horizontal) + "Assert that all windows on selected frame are large enough. If necessary and possible, make sure that every window on frame FRAME has its minimum height. Optional argument HORIZONTAL non-nil means to make sure that every window on frame FRAME has @@ -3205,8 +3420,10 @@ move it as far as possible in the desired direction." (setq left first-left) (while (and left (or (window-size-fixed-p left horizontal 'preserved) - (<= (window-size left horizontal t) - (window-min-size left horizontal 'preserved t)))) + (and (< delta 0) + (<= (window-size left horizontal t) + (window-min-size + left horizontal 'preserved t))))) (setq left (or (window-left left) (progn @@ -3226,7 +3443,8 @@ move it as far as possible in the desired direction." (or (window-size-fixed-p right horizontal) (and (> delta 0) (<= (window-size right horizontal t) - (window-min-size right horizontal 'preserved t))))) + (window-min-size + right horizontal 'preserved t))))) (setq right (or (window-right right) (progn @@ -3240,8 +3458,10 @@ move it as far as possible in the desired direction." (setq right first-right) (while (and right (or (window-size-fixed-p right horizontal 'preserved) - (<= (window-size right horizontal t) - (window-min-size right horizontal 'preserved t)))) + (and (> delta 0) + (<= (window-size right horizontal t) + (window-min-size + right horizontal 'preserved t))))) (setq right (or (window-right right) (progn @@ -3270,8 +3490,9 @@ move it as far as possible in the desired direction." ;; Start resizing. (window--resize-reset frame horizontal) ;; Try to enlarge LEFT first. - (setq this-delta (window--resizable - left delta horizontal ignore 'after nil nil pixelwise)) + (setq this-delta + (window--resizable + left delta horizontal ignore 'after nil nil pixelwise)) (unless (zerop this-delta) (window--resize-this-window left this-delta horizontal ignore t 'before @@ -3498,8 +3719,7 @@ ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too." (bottom (+ top (if pixelwise (window-pixel-height window) (window-total-height window)))) - (bottom-body (and body (+ top-body (window-body-height window t)))) - left-off right-off) + (bottom-body (and body (+ top-body (window-body-height window t))))) (if absolute (let* ((native-edges (frame-edges frame 'native-edges)) (left-off (nth 0 native-edges)) @@ -3722,7 +3942,9 @@ and no others." (defun window-deletable-p (&optional window) "Return t if WINDOW can be safely deleted from its frame. WINDOW must be a valid window and defaults to the selected one. -Return `frame' if deleting WINDOW should also delete its frame." + +Return `frame' if WINDOW is the root window of its frame and that +frame can be safely deleted." (setq window (window-normalize-window window)) (unless (or ignore-window-parameters @@ -3749,10 +3971,14 @@ Return `frame' if deleting WINDOW should also delete its frame." (let ((minibuf (active-minibuffer-window))) (and minibuf (eq frame (window-frame minibuf))))) 'frame)) + ((window-minibuffer-p window) + ;; If WINDOW is the minibuffer window of a non-minibuffer-only + ;; frame, it cannot be deleted separately. + nil) ((or ignore-window-parameters - (not (eq window (window--major-non-side-window frame)))) - ;; WINDOW can be deleted unless it is the major non-side window of - ;; its frame. + (not (eq window (window-main-window frame)))) + ;; Otherwise, WINDOW can be deleted unless it is the main window + ;; of its frame. t)))) (defun window--in-subtree-p (window root) @@ -3808,11 +4034,14 @@ that is its frame's root window." (throw 'done (delete-window atom-root)))) ((not parent) (error "Attempt to delete minibuffer or sole ordinary window")) - ((eq window (window--major-non-side-window frame)) - (error "Attempt to delete last non-side window"))) + ((eq window (window-main-window frame)) + (error "Attempt to delete main window of frame %s" frame))) (let* ((horizontal (window-left-child parent)) (size (window-size window horizontal t)) + (window-combination-resize + (or window-combination-resize + (window-parameter parent 'window-side))) (frame-selected (window--in-subtree-p (frame-selected-window frame) window)) ;; Emacs 23 preferably gives WINDOW's space to its left @@ -3868,8 +4097,7 @@ window signal an error." (setq window (window-normalize-window window)) (let* ((frame (window-frame window)) (function (window-parameter window 'delete-other-windows)) - (window-side (window-parameter window 'window-side)) - atom-root side-main) + atom-root main) (window--check frame) (catch 'done (cond @@ -3887,18 +4115,48 @@ window signal an error." (if (eq atom-root (frame-root-window frame)) (error "Root of atomic window is root window of its frame") (throw 'done (delete-other-windows atom-root)))) - ((memq window-side window-sides) + ((window-parameter window 'window-side) (error "Cannot make side window the only window")) ((and (window-minibuffer-p window) (not (eq window (frame-root-window window)))) (error "Can't expand minibuffer to full frame"))) - ;; If WINDOW is the major non-side window, do nothing. - (if (window-with-parameter 'window-side) - (setq side-main (window--major-non-side-window frame)) - (setq side-main (frame-root-window frame))) - (unless (eq window side-main) - (delete-other-windows-internal window side-main) + (cond + ((or ignore-window-parameters + (not (window-with-parameter 'no-delete-other-window nil frame))) + (setq main (frame-root-window frame))) + ((catch 'tag + (walk-window-tree + (lambda (other) + (when (or (and (window-parameter other 'window-side) + (not (window-parameter + other 'no-delete-other-window))) + (and (not (window-parameter other 'window-side)) + (window-parameter + other 'no-delete-other-window))) + (throw 'tag nil)))) + t) + (setq main (window-main-window frame))) + (t + ;; Delete other windows via `delete-window' because either a + ;; side window is or a non-side-window is not deletable. + (dolist (other (window-list frame)) + (when (and (window-live-p other) + (not (eq other window)) + (not (window-parameter + other 'no-delete-other-window)) + ;; When WINDOW and the other window are part of the + ;; same atomic window, don't delete the other. + (or (not atom-root) + (not (eq (window-atom-root other) atom-root)))) + (condition-case nil + (delete-window other) + (error nil)))) + (throw 'done nil))) + + ;; If WINDOW is the main window of its frame do nothing. + (unless (eq window main) + (delete-other-windows-internal window main) (run-window-configuration-change-hook frame) (window--check frame)) ;; Always return nil. @@ -4048,6 +4306,7 @@ to it." (interactive) (let* ((window (window-normalize-window window t)) (frame (window-frame window)) + (window-side (window-parameter window 'window-side)) (old-buffer (window-buffer window)) ;; Save this since it's destroyed by `set-window-buffer'. (next-buffers (window-next-buffers window)) @@ -4058,7 +4317,7 @@ to it." (unless (setq window (minibuffer-selected-window)) (error "Window %s is a minibuffer window" window))) - (when (window-dedicated-p window) + (unless (memq (window-dedicated-p window) '(nil side)) ;; Don't switch in dedicated window. (error "Window %s is dedicated to buffer %s" window old-buffer)) @@ -4088,23 +4347,27 @@ to it." ;; buffer we don't reverse the global buffer list to avoid showing ;; a buried buffer instead. Otherwise, we must reverse the global ;; buffer list in order to make sure that switching to the - ;; previous/next buffer traverse it in opposite directions. - (dolist (buffer (if bury-or-kill - (buffer-list frame) - (nreverse (buffer-list frame)))) - (when (and (buffer-live-p buffer) - (not (eq buffer old-buffer)) - (or (null pred) (funcall pred buffer)) - (not (eq (aref (buffer-name buffer) 0) ?\s)) - (or bury-or-kill (not (memq buffer next-buffers)))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window buffer frame)) - ;; Try to avoid showing a buffer visible in some other window. - (unless visible - (setq visible buffer)) - (setq new-buffer buffer) - (set-window-buffer-start-and-point window new-buffer) - (throw 'found t)))) + ;; previous/next buffer traverse it in opposite directions. Skip + ;; this step for side windows. + (unless window-side + (dolist (buffer (if bury-or-kill + (buffer-list frame) + (nreverse (buffer-list frame)))) + (when (and (buffer-live-p buffer) + (not (eq buffer old-buffer)) + (or (null pred) (funcall pred buffer)) + (not (eq (aref (buffer-name buffer) 0) ?\s)) + ;; Don't show a buffer shown in a side window before. + (not (buffer-local-value 'window--sides-shown buffer)) + (or bury-or-kill (not (memq buffer next-buffers)))) + (if (and (not switch-to-visible-buffer) + (get-buffer-window buffer frame)) + ;; Try to avoid showing a buffer visible in some other window. + (unless visible + (setq visible buffer)) + (setq new-buffer buffer) + (set-window-buffer-start-and-point window new-buffer) + (throw 'found t))))) (unless bury-or-kill ;; Scan reverted next buffers last (must not use nreverse ;; here!). @@ -4166,6 +4429,7 @@ found." (interactive) (let* ((window (window-normalize-window window t)) (frame (window-frame window)) + (window-side (window-parameter window 'window-side)) (old-buffer (window-buffer window)) (next-buffers (window-next-buffers window)) (pred (frame-parameter frame 'buffer-predicate)) @@ -4175,7 +4439,7 @@ found." (unless (setq window (minibuffer-selected-window)) (error "Window %s is a minibuffer window" window))) - (when (window-dedicated-p window) + (unless (memq (window-dedicated-p window) '(nil side)) ;; Don't switch in dedicated window. (error "Window %s is dedicated to buffer %s" window old-buffer)) @@ -4193,20 +4457,23 @@ found." window new-buffer (nth 1 entry) (nth 2 entry)) (throw 'found t))) ;; Scan the buffer list of WINDOW's frame next, skipping previous - ;; buffers entries. - (dolist (buffer (buffer-list frame)) - (when (and (buffer-live-p buffer) - (not (eq buffer old-buffer)) - (or (null pred) (funcall pred buffer)) - (not (eq (aref (buffer-name buffer) 0) ?\s)) - (not (assq buffer (window-prev-buffers window)))) - (if (and (not switch-to-visible-buffer) - (get-buffer-window buffer frame)) - ;; Try to avoid showing a buffer visible in some other window. - (setq visible buffer) - (setq new-buffer buffer) - (set-window-buffer-start-and-point window new-buffer) - (throw 'found t)))) + ;; buffers entries. Skip this step for side windows. + (unless window-side + (dolist (buffer (buffer-list frame)) + (when (and (buffer-live-p buffer) + (not (eq buffer old-buffer)) + (or (null pred) (funcall pred buffer)) + (not (eq (aref (buffer-name buffer) 0) ?\s)) + ;; Don't show a buffer shown in a side window before. + (not (buffer-local-value 'window--sides-shown buffer)) + (not (assq buffer (window-prev-buffers window)))) + (if (and (not switch-to-visible-buffer) + (get-buffer-window buffer frame)) + ;; Try to avoid showing a buffer visible in some other window. + (setq visible buffer) + (setq new-buffer buffer) + (set-window-buffer-start-and-point window new-buffer) + (throw 'found t))))) ;; Scan WINDOW's reverted previous buffers last (must not use ;; nreverse here!) (dolist (entry (reverse (window-prev-buffers window))) @@ -4682,7 +4949,7 @@ frame. The selected window is not changed by this function." ;; side window, throw an error unless `window-combination-resize' ;; equals 'side. ((and (not (eq window-combination-resize 'side)) - (window--side-window-p window)) + (window-parameter window 'window-side)) (error "Cannot split side window or parent of side window")) ;; If `window-combination-resize' is 'side and window has a side ;; window sibling, bind `window-combination-limit' to t. @@ -4764,7 +5031,7 @@ frame. The selected window is not changed by this function." (window-sizable-p parent (- (+ new-pixel-size divider-width)) horizontal (setq ignore 'preserved) t)) - (error "Window %s too small for splitting (1)" parent))) + (error "Window %s too small for splitting" parent))) ((and (> (+ new-pixel-size divider-width (window-min-size window horizontal nil t)) old-pixel-size) @@ -4773,7 +5040,7 @@ frame. The selected window is not changed by this function." window horizontal (setq ignore 'preserved) t)) old-pixel-size)) ;; SIZE unspecified, no resizing. - (error "Window %s too small for splitting (2)" window)))) + (error "Window %s too small for splitting" window)))) ((and (>= pixel-size 0) (or (>= pixel-size old-pixel-size) (< new-pixel-size @@ -4781,7 +5048,7 @@ frame. The selected window is not changed by this function." ;; SIZE specified as new size of old window. If the new size ;; is larger than the old size or the size of the new window ;; would be less than the safe minimum, signal an error. - (error "Window %s too small for splitting (3)" window)) + (error "Window %s too small for splitting" window)) (resize ;; SIZE specified, resizing. (unless (or (window-sizable-p @@ -4791,13 +5058,13 @@ frame. The selected window is not changed by this function." parent (- (+ new-pixel-size divider-width)) horizontal (setq ignore 'preserved) t)) ;; If we cannot resize the parent give up. - (error "Window %s too small for splitting (4)" parent))) + (error "Window %s too small for splitting" parent))) ((or (< new-pixel-size (window-safe-min-pixel-size window horizontal)) (< (- old-pixel-size new-pixel-size) (window-safe-min-pixel-size window horizontal))) ;; SIZE specification violates minimum size restrictions. - (error "Window %s too small for splitting (5)" window))) + (error "Window %s too small for splitting" window))) (window--resize-reset frame horizontal) @@ -4868,7 +5135,7 @@ frame. The selected window is not changed by this function." ;; Sanitize sizes unless SIZE was specified. (unless size - (window--sanitize-window-sizes frame horizontal)) + (window--sanitize-window-sizes horizontal)) (run-window-configuration-change-hook frame) (run-window-scroll-functions new) @@ -4876,6 +5143,17 @@ frame. The selected window is not changed by this function." ;; Always return the new window. new))))) +(defun split-window-no-error (&optional window size side pixelwise) + "Make a new window adjacent to WINDOW. +This function is like `split-window' but does not signal an error +when WINDOW cannot be split. + +For the meaning of all arguments see the documentation of +`split-window'." + (condition-case nil + (split-window window size side pixelwise) + (error nil))) + ;; I think this should be the default; I think people will prefer it--rms. (defcustom split-window-keep-point t "If non-nil, \\[split-window-below] preserves point in the new window. @@ -5268,12 +5546,17 @@ specific buffers." (scroll-bars . ,(window-scroll-bars window)) (vscroll . ,(window-vscroll window)) (dedicated . ,(window-dedicated-p window)) - (point . ,(if writable point - (copy-marker point - (buffer-local-value - 'window-point-insertion-type - buffer)))) - (start . ,(if writable start (copy-marker start))))))))) + (point . ,(if writable + point + (with-current-buffer buffer + (copy-marker point + (buffer-local-value + 'window-point-insertion-type + buffer))))) + (start . ,(if writable + start + (with-current-buffer buffer + (copy-marker start)))))))))) (tail (when (memq type '(vc hc)) (let (list) @@ -5345,7 +5628,8 @@ value can be also stored on disk and read back in a new session." ((memq type '(vc hc)) (let* ((horizontal (eq type 'hc)) (total (window-size window horizontal pixelwise)) - (first t) + (first t) + (window-combination-limit (cdr (assq 'combination-limit state))) size new) (dolist (item state) ;; Find the next child window. WINDOW always points to the @@ -5388,12 +5672,10 @@ value can be also stored on disk and read back in a new session." (frame-char-height (window-frame window)) 1))))) (if (window-sizable-p window (- size) horizontal 'safe pixelwise) - (let* ((window-combination-limit - (assq 'combination-limit item))) - ;; We must inherit the combination limit, otherwise - ;; we might mess up handling of atomic and side - ;; window. - (setq new (split-window window size horizontal pixelwise))) + (progn + (setq new (split-window-no-error + window size horizontal pixelwise)) + (setq window-combination-limit nil)) ;; Give up if we can't resize window down to safe sizes. (error "Cannot resize window %s" window)) @@ -5444,7 +5726,8 @@ value can be also stored on disk and read back in a new session." (nth 3 scroll-bars) (nth 5 scroll-bars))) (set-window-vscroll window (cdr (assq 'vscroll state))) ;; Adjust vertically. - (if (memq window-size-fixed '(t height)) + (if (or (memq window-size-fixed '(t height)) + (window-preserved-size window)) ;; A fixed height window, try to restore the ;; original size. (let ((delta @@ -5466,7 +5749,8 @@ value can be also stored on disk and read back in a new session." window delta nil ignore nil nil nil pixelwise)) (window-resize window delta nil ignore pixelwise)))) ;; Adjust horizontally. - (if (memq window-size-fixed '(t width)) + (if (or (memq window-size-fixed '(t width)) + (window-preserved-size window t)) ;; A fixed width window, try to restore the original ;; size. (let ((delta @@ -5476,8 +5760,8 @@ value can be also stored on disk and read back in a new session." (window-size window t pixelwise))) window-size-fixed) (when (window--resizable-p - window delta nil nil nil nil nil pixelwise) - (window-resize window delta nil nil pixelwise))) + window delta t nil nil nil nil pixelwise) + (window-resize window delta t nil pixelwise))) ;; Else check whether the window is not wide enough. (let* ((min-size (window-min-size window t ignore pixelwise)) (delta (- min-size (window-size window t pixelwise)))) @@ -5490,7 +5774,9 @@ value can be also stored on disk and read back in a new session." ;; Install positions (maybe we should do this after all ;; windows have been created and sized). (ignore-errors - (set-window-start window (cdr (assq 'start state))) + ;; Set 'noforce argument to avoid that window start + ;; overrides window point set below (Bug#24240). + (set-window-start window (cdr (assq 'start state)) 'noforce) (set-window-point window (cdr (assq 'point state)))) ;; Select window if it's the selected one. (when (cdr (assq 'selected state)) @@ -5520,16 +5806,14 @@ windows can get as small as `window-safe-min-height' and ;; When WINDOW is internal, reduce it to a live one to put STATE into, ;; see Bug#16793. (unless (window-live-p window) - (let ((root (frame-root-window window))) - (if (eq window root) - (setq window (frame-first-window root)) - (setq root window) - (setq window (catch 'live - (walk-window-subtree - (lambda (window) - (when (window-live-p window) - (throw 'live window))) - root)))) + (let ((root window)) + (setq window (catch 'live + (walk-window-subtree + (lambda (window) + (when (and (window-live-p window) + (not (window-parameter window 'window-side))) + (throw 'live window))) + root))) (delete-other-windows-internal window root))) (set-window-dedicated-p window nil) @@ -5614,6 +5898,75 @@ windows can get as small as `window-safe-min-height' and (when (eq (window-deletable-p window) t) (delete-window window)))) (window--check frame)))) + +(defun window-swap-states (&optional window-1 window-2 size) + "Swap the states of live windows WINDOW-1 and WINDOW-2. +WINDOW-1 must specify a live window and defaults to the selected +one. WINDOW-2 must specify a live window and defaults to the +window following WINDOW-1 in the cyclic ordering of windows, +excluding minibuffer windows and including live windows on all +visible frames. + +Optional argument SIZE non-nil means to try swapping the sizes of +WINDOW-1 and WINDOW-2 as well. A value of `height' means to swap +heights only, a value of `width' means to swap widths only, while +t means to swap both widths and heights, if possible. Frames are +not resized by this function." + (interactive) + (setq window-1 (window-normalize-window window-1 t)) + (if window-2 + (unless (window-live-p window-2) + (error "%s is not a live window" window-2)) + (setq window-2 (next-window window-1 'nomini 'visible))) + (unless (eq window-1 window-2) + (let* ((height (memq size '(t height))) + (width (memq size '(t width))) + (state-1 (window-state-get window-1)) + (width-1 (and width (window-text-width window-1 t))) + (height-1 (and height (window-text-height window-1 t))) + (state-2 (window-state-get window-2)) + (width-2 (and width (window-text-width window-2 t))) + (height-2 (and height (window-text-height window-2 t))) + old preserved) + ;; Swap basic states. + (window-state-put state-1 window-2 t) + (window-state-put state-2 window-1 t) + ;; Swap overlays with `window' property. + (with-current-buffer (window-buffer window-1) + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((window (overlay-get overlay 'window))) + (cond + ((not window)) + ((eq window window-1) + (overlay-put overlay 'window window-2)) + ((eq window window-2) + (overlay-put overlay 'window window-1)))))) + (unless (eq (window-buffer window-1) (window-buffer window-2)) + (with-current-buffer (window-buffer window-2) + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((window (overlay-get overlay 'window))) + (cond + ((not window)) + ((eq window window-1) + (overlay-put overlay 'window window-2)) + ((eq window window-2) + (overlay-put overlay 'window window-1))))))) + ;; Try to swap window sizes. + (when size + (unless (= (setq old (window-text-width window-1 t)) width-2) + (window-resize-no-error window-1 (- width-2 old) t t t)) + (unless (= (setq old (window-text-width window-2 t)) width-1) + (setq preserved (window-preserved-size window-1 t)) + (window-preserve-size window-1 t t) + (window-resize-no-error window-2 (- width-1 old) t t t) + (window-preserve-size window-1 t preserved)) + (unless (= (setq old (window-text-height window-1 t)) height-2) + (window-resize-no-error window-1 (- height-2 old) nil t t)) + (unless (= (setq old (window-text-height window-2 t)) height-1) + (setq preserved (window-preserved-size window-1)) + (window-preserve-size window-1 nil t) + (window-resize-no-error window-2 (- height-1 old) nil t t) + (window-preserve-size window-1 nil preserved)))))) (defun display-buffer-record-window (type window buffer) "Record information for window used by `display-buffer'. @@ -6119,7 +6472,8 @@ hold: wide as `split-width-threshold'. - When WINDOW is split evenly, the emanating windows are at least `window-min-width' or two (whichever is larger) columns wide." - (when (and (window-live-p window) (not (window--side-window-p window))) + (when (and (window-live-p window) + (not (window-parameter window 'window-side))) (with-current-buffer (window-buffer window) (if horizontal ;; A window can be split horizontally when its width is not @@ -6294,15 +6648,15 @@ live." (set-window-dedicated-p window dedicated)) (when (memq type '(window frame)) (set-window-prev-buffers window nil))) - (let ((parameter (window-parameter window 'quit-restore)) + (let ((quit-restore (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) (width (cdr (assq 'window-width alist))) (size (cdr (assq 'window-size alist))) (preserve-size (cdr (assq 'preserve-size alist)))) (cond ((or (eq type 'frame) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'frame))) + (and (eq (car quit-restore) 'same) + (eq (nth 1 quit-restore) 'frame))) ;; Adjust size of frame if asked for. (cond ((not size)) @@ -6320,8 +6674,8 @@ live." ((functionp size) (ignore-errors (funcall size window))))) ((or (eq type 'window) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'window))) + (and (eq (car quit-restore) 'same) + (eq (nth 1 quit-restore) 'window))) ;; Adjust height of window if asked for. (cond ((not height)) @@ -6357,8 +6711,12 @@ live." ;; Preserve window size if asked for. (when (consp preserve-size) (window-preserve-size window t (car preserve-size)) - (window-preserve-size window nil (cdr preserve-size)))))) - + (window-preserve-size window nil (cdr preserve-size))))) + ;; Assign any window parameters specified. + (let ((parameters (cdr (assq 'window-parameters alist)))) + (dolist (parameter parameters) + (set-window-parameter + window (car parameter) (cdr parameter))))) window)) (defun window--maybe-raise-frame (frame) @@ -6582,6 +6940,9 @@ Recognized alist entries include: preserve the width of the window, (nil . t) to preserve its height or (t . t) to preserve both. + `window-parameters' -- Value specifies an alist of window + parameters to give the chosen window. + The ACTION argument to `display-buffer' can also have a non-nil and non-list value. This means to display the buffer in a window other than the selected one, even if it is already displayed in @@ -6672,8 +7033,7 @@ that allows the selected frame)." (window--display-buffer buffer window 'frame alist display-buffer-mark-dedicated) (unless (cdr (assq 'inhibit-switch-frame alist)) - (window--maybe-raise-frame frame)))) - )) + (window--maybe-raise-frame frame)))))) (defun display-buffer-same-window (buffer alist) "Display BUFFER in the selected window. @@ -6747,7 +7107,7 @@ displays a buffer that derives from one of the given modes. When ALIST contains no `mode' entry, the current major mode of BUFFER is used. -The behaviour is also controlled by entries for +The behavior is also controlled by entries for `inhibit-same-window', `reusable-frames' and `inhibit-switch-frame' as is done in the function `display-buffer-reuse-window'." @@ -6775,23 +7135,22 @@ The behaviour is also controlled by entries for derived-mode-same-frame derived-mode-other-frame) (dolist (window windows) - (let (mode? frame?) - (with-current-buffer (window-buffer window) - (setq mode? - (cond ((memq major-mode allowed-modes) - 'same) - ((derived-mode-p allowed-modes) - 'derived)))) + (let ((mode? + (with-current-buffer (window-buffer window) + (cond ((memq major-mode allowed-modes) + 'same) + ((derived-mode-p allowed-modes) + 'derived))))) (when (and mode? (not (and inhibit-same-window-p (eq window curwin)))) - (if (eq curframe (window-frame window)) - (if (eq mode? 'same) - (push window same-mode-same-frame) - (push window derived-mode-same-frame)) - (if (eq mode? 'same) - (push window same-mode-other-frame) - (push window derived-mode-other-frame)))))) + (push window (if (eq curframe (window-frame window)) + (if (eq mode? 'same) + same-mode-same-frame + derived-mode-same-frame) + (if (eq mode? 'same) + same-mode-other-frame + derived-mode-other-frame)))))) (let ((window (car (nconc same-mode-same-frame same-mode-other-frame derived-mode-same-frame @@ -6873,7 +7232,6 @@ raising the frame." (defun display-buffer--maybe-pop-up-frame-or-window (buffer alist) "Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'. - If `pop-up-frames' is non-nil (and not `graphic-only' on a text-only terminal), try with `display-buffer-pop-up-frame'. @@ -6888,8 +7246,11 @@ again with `display-buffer-pop-up-window'." (defun display-buffer-below-selected (buffer alist) "Try displaying BUFFER in a window below the selected window. -This either splits the selected window or reuses the window below -the selected one." +If there is a window below the selected one and that window +already displays BUFFER, use that window. Otherwise, try to +create a new window below the selected one and show BUFFER there. +If that attempt fails as well and there is a non-dedicated window +below the selected one, use that window." (let (window) (or (and (setq window (window-in-direction 'below)) (eq buffer (window-buffer window)) @@ -6932,10 +7293,7 @@ selected frame." (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)) (and (not (frame-parameter nil 'unsplittable)) - (setq window - (condition-case nil - (split-window (window--major-non-side-window)) - (error nil))) + (setq window (split-window-no-error (window-main-window))) (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window bottom-window) @@ -7053,12 +7411,12 @@ returned from `display-buffer' in this case." 'fail)) ;;; Display + selection commands: -(defun pop-to-buffer (buffer &optional action norecord) - "Select buffer BUFFER in some window, preferably a different one. -BUFFER may be a buffer, a string (a buffer name), or nil. If it -is a string not naming an existent buffer, create a buffer with -that name. If BUFFER is nil, choose some other buffer. Return -the buffer. +(defun pop-to-buffer (buffer-or-name &optional action norecord) + "Display buffer specified by BUFFER-OR-NAME and select its window. +BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil. +If it is a string not naming an existent buffer, create a buffer +with that name. If BUFFER-OR-NAME is nil, choose some other +buffer. In either case, make that buffer current and return it. This uses `display-buffer' as a subroutine. The optional ACTION argument is passed to `display-buffer' as its ACTION argument. @@ -7067,24 +7425,30 @@ interactively with a prefix argument, which means to pop to a window other than the selected one even if the buffer is already displayed in the selected window. -If the window to show BUFFER is not on the selected -frame, raise that window's frame and give it input focus. +If a suitable window is found, select that window. If it is not +on the selected frame, raise that window's frame and give it +input focus. Optional third arg NORECORD non-nil means do not put this buffer at the front of the list of recently selected ones." (interactive (list (read-buffer "Pop to buffer: " (other-buffer)) (if current-prefix-arg t))) - (setq buffer (window-normalize-buffer-to-switch-to buffer)) - ;; This should be done by `select-window' below. - ;; (set-buffer buffer) - (let* ((old-frame (selected-frame)) - (window (display-buffer buffer action)) - (frame (window-frame window))) - ;; If we chose another frame, make sure it gets input focus. - (unless (eq frame old-frame) - (select-frame-set-input-focus frame norecord)) - ;; Make sure new window is selected (Bug#8615), (Bug#6954). - (select-window window norecord) + (let* ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)) + (old-frame (selected-frame)) + (window (display-buffer buffer action))) + ;; Don't assume that `display-buffer' has supplied us with a window + ;; (Bug#24332). + (if window + (let ((frame (window-frame window))) + ;; If we chose another frame, make sure it gets input focus. + (unless (eq frame old-frame) + (select-frame-set-input-focus frame norecord)) + ;; Make sure the window is selected (Bug#8615), (Bug#6954) + (select-window window norecord)) + ;; If `display-buffer' failed to supply a window, just make the + ;; buffer current. + (set-buffer buffer)) + ;; Return BUFFER even when we got no window. buffer)) (defun pop-to-buffer-same-window (buffer &optional norecord) @@ -7137,7 +7501,7 @@ buffer with the name BUFFER-OR-NAME and return that buffer." buffer)) (other-buffer))) -(defcustom switch-to-buffer-preserve-window-point nil +(defcustom switch-to-buffer-preserve-window-point t "If non-nil, `switch-to-buffer' tries to preserve `window-point'. If this is nil, `switch-to-buffer' displays the buffer at that buffer's `point'. If this is `already-displayed', it tries to @@ -7155,7 +7519,7 @@ the selected window or never appeared in it before, or if (const :tag "If already displayed elsewhere" already-displayed) (const :tag "Always" t)) :group 'windows - :version "24.3") + :version "26.1") (defcustom switch-to-buffer-in-dedicated-window nil "Allow switching to buffer in strongly dedicated windows. @@ -7538,8 +7902,7 @@ FRAME." (setq frame (window-normalize-frame frame)) (when (window-live-p (frame-root-window frame)) (with-selected-window (frame-root-window frame) - (let* ((window (frame-root-window frame)) - (char-width (frame-char-width)) + (let* ((char-width (frame-char-width)) (char-height (frame-char-height)) (monitor-attributes (car (display-monitor-attributes-list (frame-parameter frame 'display)))) @@ -7586,8 +7949,6 @@ FRAME." ;; and the window's body width. This is the space we can't ;; use for fitting. (extra-width (- frame-width window-body-width)) - ;; The maximum width we can use for fitting. - (fit-width (- workarea-width extra-width)) ;; The pixel position of FRAME's left border. We usually ;; try to leave this alone. (left @@ -7606,23 +7967,6 @@ FRAME." ;; The difference in pixels between the frame's pixel ;; height and the window's height. (extra-height (- frame-height window-height)) - ;; When tool-bar-mode is enabled and we just created a new - ;; frame, reserve lines for toolbar resizing. Needed - ;; because for reasons unknown to me Emacs (1) reserves one - ;; line for the toolbar when making the initial frame and - ;; toolbars are enabled, and (2) later adds the remaining - ;; lines needed. Our code runs IN BETWEEN (1) and (2). - ;; YMMV when you're on a system that behaves differently. - (toolbar-extra-height - (let ((quit-restore (window-parameter window 'quit-restore)) - ;; This may have to change when we allow arbitrary - ;; pixel height toolbars. - (lines (tool-bar-height))) - (* char-height - (if (and quit-restore (eq (car quit-restore) 'frame) - (not (zerop lines))) - (1- lines) - 0)))) ;; The pixel position of FRAME's top border. (top (let ((top (frame-parameter nil 'top))) @@ -8544,30 +8888,30 @@ overrides the global or buffer-local value of :group 'windows :version "25.1") -(defun window-adjust-process-window-size (reducer process windows) - "Adjust the process window size of PROCESS. -WINDOWS is a list of windows associated with PROCESS. REDUCER is +(defun window-adjust-process-window-size (reducer windows) + "Adjust the window sizes of a process. +WINDOWS is a list of windows associated with that process. REDUCER is a two-argument function used to combine the widths and heights of the given windows." (when windows - (let ((width (window-body-width (car windows))) + (let ((width (window-max-chars-per-line (car windows))) (height (window-body-height (car windows)))) (dolist (window (cdr windows)) - (setf width (funcall reducer width (window-body-width window))) + (setf width (funcall reducer width (window-max-chars-per-line window))) (setf height (funcall reducer height (window-body-height window)))) (cons width height)))) -(defun window-adjust-process-window-size-smallest (process windows) +(defun window-adjust-process-window-size-smallest (_process windows) "Adjust the process window size of PROCESS. WINDOWS is a list of windows associated with PROCESS. Choose the smallest area available for displaying PROCESS's output." - (window-adjust-process-window-size #'min process windows)) + (window-adjust-process-window-size #'min windows)) -(defun window-adjust-process-window-size-largest (process windows) +(defun window-adjust-process-window-size-largest (_process windows) "Adjust the process window size of PROCESS. WINDOWS is a list of windows associated with PROCESS. Choose the largest area available for displaying PROCESS's output." - (window-adjust-process-window-size #'max process windows)) + (window-adjust-process-window-size #'max windows)) (defun window--process-window-list () "Return an alist mapping processes to associated windows. @@ -8575,38 +8919,40 @@ A window is associated with a process if that window is displaying that processes's buffer." (let ((processes (process-list)) (process-windows nil)) - (walk-windows - (lambda (window) - (let ((buffer (window-buffer window)) - (iter processes)) - (while (let ((process (car iter))) - (if (and (process-live-p process) - (eq buffer (process-buffer process))) - (let ((procwin (assq process process-windows))) - ;; Add this window to the list of windows - ;; displaying process. - (if procwin - (push window (cdr procwin)) - (push (list process window) process-windows)) - ;; We found our process for this window, so - ;; stop iterating over the process list. - nil) - (setf iter (cdr iter))))))) - 1 t) + (if processes + (walk-windows + (lambda (window) + (let ((buffer (window-buffer window)) + (iter processes)) + (while (let ((process (car iter))) + (if (and (process-live-p process) + (eq buffer (process-buffer process))) + (let ((procwin (assq process process-windows))) + ;; Add this window to the list of windows + ;; displaying process. + (if procwin + (push window (cdr procwin)) + (push (list process window) process-windows)) + ;; We found our process for this window, so + ;; stop iterating over the process list. + nil) + (setf iter (cdr iter))))))) + 1 t)) process-windows)) (defun window--adjust-process-windows () "Update process window sizes to match the current window configuration." - (dolist (procwin (window--process-window-list)) - (let ((process (car procwin))) - (with-demoted-errors "Error adjusting window size: %S" - (with-current-buffer (process-buffer process) - (let ((size (funcall - (or (process-get process 'adjust-window-size-function) - window-adjust-process-window-size-function) - process (cdr procwin)))) - (when size - (set-process-window-size process (cdr size) (car size))))))))) + (when (fboundp 'process-list) + (dolist (procwin (window--process-window-list)) + (let ((process (car procwin))) + (with-demoted-errors "Error adjusting window size: %S" + (with-current-buffer (process-buffer process) + (let ((size (funcall + (or (process-get process 'adjust-window-size-function) + window-adjust-process-window-size-function) + process (cdr procwin)))) + (when size + (set-process-window-size process (cdr size) (car size)))))))))) (add-hook 'window-configuration-change-hook 'window--adjust-process-windows) diff --git a/lisp/winner.el b/lisp/winner.el index 4b277008d78..9a6f5d5190b 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -346,7 +346,19 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;###autoload -(define-minor-mode winner-mode nil :global t ; let d-m-m make the doc +(define-minor-mode winner-mode + "Toggle Winner mode on or off. +With a prefix argument ARG, enable Winner mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is ‘toggle’. + +Winner mode is a global minor mode that records the changes in +the window configuration (i.e. how the frames are partitioned +into windows) so that the changes can be \"undone\" using the +command `winner-undo'. By default this one is bound to the key +sequence `C-c <left>'. If you change your mind (while undoing), +you can press `C-c <right>' (calling `winner-redo')." + :global t (if winner-mode (progn (add-hook 'window-configuration-change-hook 'winner-change-fun) diff --git a/lisp/woman.el b/lisp/woman.el index a4a0da209cb..45b03a96be7 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -414,9 +414,8 @@ (substring arg 0 (match-end 1)) arg)))) -(require 'cl-lib) - (eval-when-compile ; to avoid compiler warnings + (require 'cl-lib) (require 'dired) (require 'apropos)) @@ -434,7 +433,7 @@ As a special case, if PATHS is nil then replace it by calling (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))) ((string-match-p ";" paths) ;; Assume DOS-style path-list... - (cl-mapcan ; splice list into list + (mapcan ; splice list into list (lambda (x) (if x (list x) @@ -445,14 +444,14 @@ As a special case, if PATHS is nil then replace it by calling (list paths)) (t ;; Assume UNIX/Cygwin-style path-list... - (cl-mapcan ; splice list into list + (mapcan ; splice list into list (lambda (x) (mapcar 'woman-Cyg-to-Win (if x (list x) (woman-parse-man.conf)))) (let ((path-separator ":")) (parse-colon-path paths))))) ;; Assume host-default-style path-list... - (cl-mapcan ; splice list into list + (mapcan ; splice list into list (lambda (x) (if x (list x) (woman-parse-man.conf))) (parse-colon-path (or paths ""))))) @@ -569,11 +568,11 @@ or "\ ^[ \t]*\\(?:\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)\\|\ MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t) - (add-to-list 'manpath - (if (match-beginning 1) - (match-string 1) - (cons (match-string 2) - (match-string 3))))) + (cl-pushnew (if (match-beginning 1) + (match-string 1) + (cons (match-string 2) + (match-string 3))) + manpath :test #'equal)) manpath)) )) (setq path (cdr path))) @@ -624,11 +623,12 @@ of `woman-expand-locale' on `woman-locale' added, where they exist." (if (consp elem) (cdr elem) elem)))))) - (add-to-list 'lst (if (consp elem) - (cons (car elem) dir) - dir)))) + (cl-pushnew (if (consp elem) + (cons (car elem) dir) + dir) + lst :test #'equal))) ;; Non-locale-specific has lowest precedence. - (add-to-list 'lst elem))))) + (cl-pushnew elem lst :test #'equal))))) (defcustom woman-manpath ;; Locales could also be added in woman-expand-directory-path. @@ -926,25 +926,21 @@ or different fonts." '((t :inherit italic)) "Face for italic font in man pages." :group 'woman-faces) -(define-obsolete-face-alias 'woman-italic-face 'woman-italic "22.1") (defface woman-bold '((t :inherit bold)) "Face for bold font in man pages." :group 'woman-faces) -(define-obsolete-face-alias 'woman-bold-face 'woman-bold "22.1") (defface woman-unknown '((t :inherit font-lock-warning-face)) "Face for all unknown fonts in man pages." :group 'woman-faces) -(define-obsolete-face-alias 'woman-unknown-face 'woman-unknown "22.1") (defface woman-addition '((t :inherit font-lock-builtin-face)) "Face for all WoMan additions to man pages." :group 'woman-faces) -(define-obsolete-face-alias 'woman-addition-face 'woman-addition "22.1") (defun woman-default-faces () "Set foreground colors of italic and bold faces to their default values." @@ -1026,8 +1022,7 @@ Under MS-Windows, the default is ;;; Internal variables: -(defconst woman-justify-list - '(left right center full) +(defconst woman-justify-styles [left right center full] "Justify styles for `fill-region-as-paragraph'.") (defconst woman-adjust-left 0 ; == adjust off, noadjust "Adjustment indicator `l' -- adjust left margin only.") @@ -1042,8 +1037,7 @@ Under MS-Windows, the default is "Current adjustment number-register value.") (defvar woman-adjust-previous woman-adjust "Previous adjustment number-register value.") -(defvar woman-justify - (nth woman-adjust woman-justify-list) ; use vector? +(defvar woman-justify (aref woman-justify-styles woman-adjust) "Current justification style for `fill-region-as-paragraph'.") (defvar woman-justify-previous woman-justify "Previous justification style for `fill-region-as-paragraph'.") @@ -1203,7 +1197,8 @@ Called both to generate and to check the cache!" (setq path (split-string (getenv "PATH") path-separator t))) (setq dir (and (member (car dir) path) (cdr dir)))) - (when dir (add-to-list 'lst (substitute-in-file-name dir))))) + (when dir + (cl-pushnew (substitute-in-file-name dir) lst :test #'equal)))) (mapcar 'substitute-in-file-name woman-path))) (defun woman-read-directory-cache () @@ -1662,7 +1657,7 @@ Do not call directly!" (woman-insert-file-contents filename compressed) ;; Set buffer's default directory to that of the file. (setq default-directory (file-name-directory filename)) - (set (make-local-variable 'backup-inhibited) t) + (setq-local backup-inhibited t) (set-visited-file-name "") (woman-process-buffer))) @@ -1785,7 +1780,7 @@ Leave point at end of new text. Return length of inserted text." (define-key map [remap man] 'woman) (define-key map [remap man-follow] 'woman-follow) map) - "Keymap for woman mode.") + "Keymap for `woman-mode'.") (defun woman-follow (topic) "Get a Un*x manual page of the item under point and put it in a buffer." @@ -1877,15 +1872,15 @@ Argument EVENT is the invoking mouse event." (woman-reformat-last-file)) (defvar bookmark-make-record-function) -(put 'woman-mode 'mode-class 'special) -(defun woman-mode () +(define-derived-mode woman-mode special-mode "WoMan" "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs `man' command running the standard UN*X man and ?roff programs. WoMan author: F.J.Wright@Maths.QMW.ac.uk WoMan version: see `woman-version'. -See `Man-mode' for additional details." +See `Man-mode' for additional details. +\\{woman-mode-map}" (let ((Man-build-page-list (symbol-function 'Man-build-page-list)) (Man-strip-page-headers (symbol-function 'Man-strip-page-headers)) (Man-unindent (symbol-function 'Man-unindent)) @@ -1910,13 +1905,10 @@ See `Man-mode' for additional details." (kill-local-variable 'mode-line-buffer-identification) (use-local-map woman-mode-map) ;; Imenu support: - (set (make-local-variable 'imenu-generic-expression) - ;; `make-local-variable' in case imenu not yet loaded! - woman-imenu-generic-expression) - (set (make-local-variable 'imenu-space-replacement) " ") + (setq imenu-generic-expression woman-imenu-generic-expression) + (setq-local imenu-space-replacement " ") ;; Bookmark support. - (set (make-local-variable 'bookmark-make-record-function) - 'woman-bookmark-make-record) + (setq-local bookmark-make-record-function 'woman-bookmark-make-record) ;; For reformat ... ;; necessary when reformatting a file in its old buffer: (setq imenu--last-menubar-index-alist nil) @@ -1924,9 +1916,7 @@ See `Man-mode' for additional details." (setq woman-imenu-done nil) (if woman-imenu (woman-imenu)) (let ((inhibit-read-only t)) - (Man-highlight-references 'WoMan-xref-man-page)) - (set-buffer-modified-p nil) - (run-mode-hooks 'woman-mode-hook)) + (Man-highlight-references 'WoMan-xref-man-page))) (defun woman-imenu (&optional redraw) "Add a \"Contents\" menu to the menubar. @@ -2242,7 +2232,7 @@ Currently set only from \\='\\\" t in the first line of the source file.") woman-RS-left-margin nil woman-RS-prevailing-indent nil woman-adjust woman-adjust-both - woman-justify (nth woman-adjust woman-justify-list) + woman-justify (aref woman-justify-styles woman-adjust) woman-nofill nil) (setq woman-if-conditions-true @@ -3889,7 +3879,7 @@ Leave 1 blank line. Format paragraphs upto TO." ((eq c ?\t) ; skip (if (eq (following-char) ?\t) (forward-char) ; both tabs, just skip - (dotimes (i woman-tab-width) + (dotimes (_ woman-tab-width) (if (eolp) (insert ?\s) ; extend line (forward-char)) ; skip @@ -4037,7 +4027,7 @@ Format paragraphs upto TO. (Breaks, but should not.)" ((memq (following-char) '(?b ?n)) woman-adjust-both) (t (woman-get-numeric-arg)) ) - woman-justify (nth woman-adjust woman-justify-list)) + woman-justify (aref woman-justify-styles woman-adjust)) (woman-delete-line 1) ; ignore any remaining arguments (woman2-format-paragraphs to)) @@ -4047,7 +4037,7 @@ Format paragraphs upto TO. (Breaks, but should not.)" (setq woman-adjust-previous woman-adjust woman-justify-previous woman-justify woman-adjust woman-adjust-left ; fill but do not adjust - woman-justify (nth woman-adjust woman-justify-list)) + woman-justify (aref woman-justify-styles woman-adjust)) (woman-delete-line 1) ; ignore any arguments (woman2-format-paragraphs to)) diff --git a/lisp/xml.el b/lisp/xml.el index 1802d04dfaf..2563c13094f 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -1,4 +1,4 @@ -;;; xml.el --- XML parser +;;; xml.el --- XML parser -*- lexical-binding: t -*- ;; Copyright (C) 2000-2016 Free Software Foundation, Inc. @@ -401,9 +401,9 @@ Both features can be combined by providing a cons cell parse-dtd) (setq dtd (car result)) (if (cdr result) ; possible leading comment - (add-to-list 'xml (cdr result)))) + (push (cdr result) xml))) (t - (add-to-list 'xml result)))) + (push result xml)))) (goto-char (point-max)))) (if parse-dtd (cons dtd (nreverse xml)) @@ -580,7 +580,7 @@ Return one of: ;; However, if we're parsing incrementally, then we need to deal ;; with stray CDATA. (let ((s (xml-parse-string))) - (when (string-empty-p s) + (when (zerop (length s)) ;; We haven't consumed any input! We must throw an error in ;; order to prevent looping forever. (error "XML: (Not Well-Formed) Could not parse: %s" diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 5975e60272f..d2d0cf5ee06 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -1,4 +1,4 @@ -;;; xt-mouse.el --- support the mouse when emacs run in an xterm +;;; xt-mouse.el --- support the mouse when emacs run in an xterm -*- lexical-binding: t -*- ;; Copyright (C) 1994, 2000-2016 Free Software Foundation, Inc. @@ -70,7 +70,11 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (cond ((null event) nil) ;Unknown/bogus byte sequence! (is-down - (setf (terminal-parameter nil 'xterm-mouse-last-down) event) + (setf (terminal-parameter nil 'xterm-mouse-last-down) + ;; EVENT might be handed back to the input queue, which + ;; might modify it. Copy it into the terminal parameter + ;; to guard against that. + (copy-sequence event)) vec) (is-move vec) (t @@ -134,23 +138,32 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (fdiff (- f (* 1.0 maxwrap dbig)))) (+ (truncate fdiff) (* maxwrap dbig)))))) -(defun xterm-mouse--read-utf8-char (&optional prompt seconds) - "Read an utf-8 encoded character from the current terminal. -This function reads and returns an utf-8 encoded character of -command input. If the user generates an event which is not a -character (i.e., a mouse click or function key event), read-char -signals an error. - -The returned event may come directly from the user, or from a -keyboard macro. It is not decoded by the keyboard's input coding -system and always treated with an utf-8 input encoding. - -The optional arguments PROMPT and SECONDS work like in -`read-event'." - (let ((tmp (keyboard-coding-system))) - (set-keyboard-coding-system 'utf-8) - (prog1 (read-event prompt t seconds) - (set-keyboard-coding-system tmp)))) +(defcustom xterm-mouse-utf-8 nil + "Non-nil if UTF-8 coordinates should be used to read mouse coordinates. +Set this to non-nil if you are sure that your terminal +understands UTF-8 coordinates, but not SGR coordinates." + :version "25.1" + :type 'boolean + :risky t + :group 'xterm) + +(defun xterm-mouse--read-coordinate () + "Read a mouse coordinate from the current terminal. +If `xterm-mouse-utf-8' was non-nil when +`turn-on-xterm-mouse-tracking-on-terminal' was called, reads the +coordinate as an UTF-8 code unit sequence; otherwise, reads a +single byte." + (let ((previous-keyboard-coding-system (keyboard-coding-system))) + (unwind-protect + (progn + (set-keyboard-coding-system + (if (terminal-parameter nil 'xterm-mouse-utf-8) + 'utf-8-unix + 'no-conversion)) + ;; Wait only a little; we assume that the entire escape sequence + ;; has already been sent when this function is called. + (read-char nil nil 0.1)) + (set-keyboard-coding-system previous-keyboard-coding-system)))) ;; In default mode, each numeric parameter of XTerm's mouse report is ;; a single char, possibly encoded as utf-8. The actual numeric @@ -170,7 +183,7 @@ The optional arguments PROMPT and SECONDS work like in (<= ?0 c ?9)) (setq n (+ (* 10 n) c (- ?0)))) (cons n c)) - (cons (- (setq c (xterm-mouse--read-utf8-char)) 32) c)))) + (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c)))) ;; XTerm reports mouse events as ;; <EVENT-CODE> <X> <Y> in default mode, and @@ -314,6 +327,38 @@ down the SHIFT key while pressing the mouse button." (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) (setq mouse-position-function nil))) +(defun xterm-mouse-tracking-enable-sequence () + "Return a control sequence to enable XTerm mouse tracking. +The returned control sequence enables basic mouse tracking, mouse +motion events and finally extended tracking on terminals that +support it. The following escape sequences are understood by +modern xterms: + +\"\\e[?1000h\" \"Basic mouse mode\": Enables reports for mouse + clicks. There is a limit to the maximum row/column + position (<= 223), which can be reported in this + basic mode. + +\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse + motion events during dragging operations. + +\"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an + extension to the basic mouse mode, which uses UTF-8 + characters to overcome the 223 row/column limit. + This extension may conflict with non UTF-8 + applications or non UTF-8 locales. It is only + enabled when the option `xterm-mouse-utf-8' is + non-nil. + +\"\\e[?1006h\" \"SGR coordinate extension\": Enables a newer + alternative extension to the basic mouse mode, which + overcomes the 223 row/column limit without the + drawbacks of the UTF-8 coordinate extension. + +The two extension modes are mutually exclusive, where the last +given escape sequence takes precedence over the former." + (apply #'concat (xterm-mouse--tracking-sequence ?h))) + (defconst xterm-mouse-tracking-enable-sequence "\e[?1000h\e[?1002h\e[?1005h\e[?1006h" "Control sequence to enable xterm mouse tracking. @@ -343,10 +388,34 @@ escape sequences are understood by modern xterms: The two extension modes are mutually exclusive, where the last given escape sequence takes precedence over the former.") +(make-obsolete-variable + 'xterm-mouse-tracking-enable-sequence + "use the function `xterm-mouse-tracking-enable-sequence' instead." + "25.1") + +(defun xterm-mouse-tracking-disable-sequence () + "Return a control sequence to disable XTerm mouse tracking. +The control sequence resets the modes set by +`xterm-mouse-tracking-enable-sequence'." + (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l)))) + (defconst xterm-mouse-tracking-disable-sequence "\e[?1006l\e[?1005l\e[?1002l\e[?1000l" "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") +(make-obsolete-variable + 'xterm-mouse-tracking-disable-sequence + "use the function `xterm-mouse-tracking-disable-sequence' instead." + "25.1") + +(defun xterm-mouse--tracking-sequence (suffix) + "Return a control sequence to enable or disable mouse tracking. +SUFFIX is the last character of each escape sequence (?h to +enable, ?l to disable)." + (mapcar + (lambda (code) (format "\e[?%d%c" code suffix)) + `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) + (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) @@ -360,18 +429,19 @@ given escape sequence takes precedence over the former.") (with-selected-frame (car (frames-on-display-list terminal)) (define-key input-decode-map "\e[M" 'xterm-mouse-translate) (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended)) - (condition-case err - (send-string-to-terminal xterm-mouse-tracking-enable-sequence - terminal) - ;; FIXME: This should use a dedicated error signal. - (error (if (equal (cadr err) "Terminal is currently suspended") - nil ;The sequence will be sent upon resume. - (signal (car err) (cdr err))))) - (push xterm-mouse-tracking-enable-sequence - (terminal-parameter nil 'tty-mode-set-strings)) - (push xterm-mouse-tracking-disable-sequence - (terminal-parameter nil 'tty-mode-reset-strings)) - (set-terminal-parameter terminal 'xterm-mouse-mode t)))) + (let ((enable (xterm-mouse-tracking-enable-sequence)) + (disable (xterm-mouse-tracking-disable-sequence))) + (condition-case err + (send-string-to-terminal enable terminal) + ;; FIXME: This should use a dedicated error signal. + (error (if (equal (cadr err) "Terminal is currently suspended") + nil ; The sequence will be sent upon resume. + (signal (car err) (cdr err))))) + (push enable (terminal-parameter nil 'tty-mode-set-strings)) + (push disable (terminal-parameter nil 'tty-mode-reset-strings)) + (set-terminal-parameter terminal 'xterm-mouse-mode t) + (set-terminal-parameter terminal 'xterm-mouse-utf-8 + xterm-mouse-utf-8))))) (defun turn-off-xterm-mouse-tracking-on-terminal (terminal) "Disable xterm mouse tracking on TERMINAL." diff --git a/lisp/xwidget.el b/lisp/xwidget.el index cd8ec0ec29d..6443954824c 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -34,23 +34,15 @@ (require 'cl-lib) (require 'bookmark) -(defcustom xwidget-webkit-scroll-behavior 'native - "Scrolling behavior of the webkit instance. -The possible values are: `native' or `image'." - :version "25.1" - :group 'frames ; TODO add xwidgets group if more options are added - :type '(choice (const native) (const image))) - (declare-function make-xwidget "xwidget.c" - (beg end type title width height arguments &optional buffer)) -(declare-function xwidget-set-adjustment "xwidget.c" - (xwidget axis relative value)) + (type title width height arguments &optional buffer)) (declare-function xwidget-buffer "xwidget.c" (xwidget)) -(declare-function xwidget-webkit-get-title "xwidget.c" (xwidget)) (declare-function xwidget-size-request "xwidget.c" (xwidget)) (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) -(declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script)) +(declare-function xwidget-webkit-execute-script "xwidget.c" + (xwidget script &optional callback)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) +(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) (declare-function xwidget-view-window "xwidget.c" (xwidget-view)) @@ -66,8 +58,7 @@ See `make-xwidget' for the possible TYPE values. The usage of optional argument ARGS depends on the xwidget. This returns the result of `make-xwidget'." (goto-char pos) - (let ((id (make-xwidget (point) (point) - type title width height args))) + (let ((id (make-xwidget type title width height args))) (put-text-property (point) (+ 1 (point)) 'display (list 'xwidget ':xwidget id)) id)) @@ -116,6 +107,8 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) (define-key map "w" 'xwidget-webkit-current-url) + (define-key map "+" 'xwidget-webkit-zoom-in) + (define-key map "-" 'xwidget-webkit-zoom-out) ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) @@ -131,52 +124,67 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) - ;; (define-key map [remap previous-line] 'image-previous-line) - ;; (define-key map [remap next-line] 'image-next-line) + (define-key map [remap previous-line] 'xwidget-webkit-scroll-down) + (define-key map [remap next-line] 'xwidget-webkit-scroll-up) ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) - ;; (define-key map [remap beginning-of-buffer] 'image-bob) - ;; (define-key map [remap end-of-buffer] 'image-eob) + (define-key map [remap beginning-of-buffer] 'xwidget-webkit-scroll-top) + (define-key map [remap end-of-buffer] 'xwidget-webkit-scroll-bottom) map) "Keymap for `xwidget-webkit-mode'.") +(defun xwidget-webkit-zoom-in () + "Increase webkit view zoom factor." + (interactive) + (xwidget-webkit-zoom (xwidget-webkit-current-session) 0.1)) + +(defun xwidget-webkit-zoom-out () + "Decrease webkit view zoom factor." + (interactive) + (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) + (defun xwidget-webkit-scroll-up () - "Scroll webkit up. -Depending on the value of `xwidget-webkit-scroll-behavior', -this scrolls in `native' fashion, or like `image-mode' would." + "Scroll webkit up." (interactive) - (if (eq xwidget-webkit-scroll-behavior 'native) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50) - (image-scroll-up))) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, 50);")) (defun xwidget-webkit-scroll-down () - "Scroll webkit down. -Depending on the value of `xwidget-webkit-scroll-behavior', -this scrolls in `native' fashion, or like `image-mode' would." + "Scroll webkit down." (interactive) - (if (eq xwidget-webkit-scroll-behavior 'native) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50) - (image-scroll-down))) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, -50);")) (defun xwidget-webkit-scroll-forward () - "Scroll webkit forwards. -Depending on the value of `xwidget-webkit-scroll-behavior', -this scrolls in `native' fashion, or like `image-mode' would." + "Scroll webkit forwards." (interactive) - (if (eq xwidget-webkit-scroll-behavior 'native) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50) - (xwidget-webkit-scroll-forward))) ; FIXME infloop! + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(50, 0);")) (defun xwidget-webkit-scroll-backward () - "Scroll webkit backwards. -Depending on the value of `xwidget-webkit-scroll-behavior', -this scrolls in `native' fashion, or like `image-mode' would." + "Scroll webkit backwards." (interactive) - (if (eq xwidget-webkit-scroll-behavior 'native) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50) - (xwidget-webkit-scroll-backward))) ; FIXME infloop! + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(-50, 0);")) +(defun xwidget-webkit-scroll-top () + "Scroll webkit to the very top." + (interactive) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollTo(pageXOffset, 0);")) + +(defun xwidget-webkit-scroll-bottom () + "Scroll webkit to the very bottom." + (interactive) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollTo(pageXOffset, window.document.body.clientHeight);")) ;; The xwidget event needs to go into a higher level handler ;; since the xwidget can generate an event even if it's offscreen. @@ -210,23 +218,27 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (xwidget-log "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) - (let* ((strarg (nth 3 last-input-event))) - (cond ((eq xwidget-event-type 'document-load-finished) - (xwidget-log "webkit finished loading: '%s'" - (xwidget-webkit-get-title xwidget)) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-dispatch) ;;TODO xwidget arg - (rename-buffer (format "*xwidget webkit: %s *" - (xwidget-webkit-get-title xwidget))) - (pop-to-buffer (current-buffer))) - ((eq xwidget-event-type - 'navigation-policy-decision-requested) + (cond ((eq xwidget-event-type 'load-changed) + (xwidget-webkit-execute-script + xwidget "document.title" + (lambda (title) + (xwidget-log "webkit finished loading: '%s'" title) + ;;TODO - check the native/internal scroll + ;;(xwidget-adjust-size-to-content xwidget) + (xwidget-webkit-adjust-size-to-window xwidget) + (rename-buffer (format "*xwidget webkit: %s *" title)))) + (pop-to-buffer (current-buffer))) + ((eq xwidget-event-type 'decide-policy) + (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget - (match-string 1 strarg)))) - (t (xwidget-log "unhandled event:%s" xwidget-event-type))))))) + (match-string 1 strarg))))) + ((eq xwidget-event-type 'javascript-callback) + (let ((proc (nth 3 last-input-event)) + (arg (nth 4 last-input-event))) + (funcall proc arg))) + (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))) (defvar bookmark-make-record-function) (define-derived-mode xwidget-webkit-mode @@ -300,31 +312,30 @@ function findactiveelement(doc){ ;;TODO the activeelement type needs to be examined, for iframe, etc. ) -(defun xwidget-webkit-insert-string (xw str) - "Insert string STR in the active field in the webkit XW." +(defun xwidget-webkit-insert-string () + "Prompt for a string and insert it in the active field in the +current webkit widget." ;; Read out the string in the field first and provide for edit. - (interactive - (let* ((xww (xwidget-webkit-current-session)) - - (field-value - (progn - (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js) - (xwidget-webkit-execute-script-rv - xww - "findactiveelement(document).value;"))) - (field-type (xwidget-webkit-execute-script-rv - xww - "findactiveelement(document).type;"))) - (list xww - (cond ((equal "text" field-type) - (read-string "Text: " field-value)) - ((equal "password" field-type) - (read-passwd "Password: " nil field-value)) - ((equal "textarea" field-type) - (xwidget-webkit-begin-edit-textarea xww field-value)))))) - (xwidget-webkit-execute-script - xw - (format "findactiveelement(document).value='%s'" str))) + (interactive) + (let ((xww (xwidget-webkit-current-session))) + (xwidget-webkit-execute-script + xww + (concat xwidget-webkit-activeelement-js " +(function () { + var res = findactiveelement(document); + return [res.value, res.type]; +})();") + (lambda (field) + (let ((str (pcase field + (`[,val "text"] + (read-string "Text: " val)) + (`[,val "password"] + (read-passwd "Password: " nil val)) + (`[,val "textarea"] + (xwidget-webkit-begin-edit-textarea xww val))))) + (xwidget-webkit-execute-script + xww + (format "findactiveelement(document).value='%s'" str))))))) (defvar xwidget-xwbl) (defun xwidget-webkit-begin-edit-textarea (xw text) @@ -348,67 +359,75 @@ XW is the xwidget identifier, TEXT is retrieved from the webkit." ;;TODO convert linefeed to \n ) +(defun xwidget-webkit-show-element (xw element-selector) + "Make webkit xwidget XW show a named element ELEMENT-SELECTOR. +The ELEMENT-SELECTOR must be a valid CSS selector. For example, +use this to display an anchor." + (interactive (list (xwidget-webkit-current-session) + (read-string "Element selector: "))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.querySelector(query); + if (el !== null) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-selector))) + (defun xwidget-webkit-show-named-element (xw element-name) "Make webkit xwidget XW show a named element ELEMENT-NAME. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element name: "))) - ;;TODO since an xwidget is an Emacs object, it is not trivial to do - ;; some things that are taken for granted in a normal browser. - ;; scrolling an anchor/named-element into view is one such thing. - ;; This function implements a proof-of-concept for this. Problems - ;; remaining: - The selected window is scrolled but this is not - ;; always correct - This needs to be interfaced into browse-url - ;; somehow. The tricky part is that we need to do this in two steps: - ;; A: load the base url, wait for load signal to arrive B: navigate - ;; to the anchor when the base url is finished rendering - - ;; This part figures out the Y coordinate of the element - (let ((y (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format - "document.getElementsByName('%s')[0].getBoundingClientRect().top" - element-name) - 0)))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y) - (set-window-vscroll (selected-window) y t))) + ;; TODO: This needs to be interfaced into browse-url somehow. The + ;; tricky part is that we need to do this in two steps: A: load the + ;; base url, wait for load signal to arrive B: navigate to the + ;; anchor when the base url is finished rendering + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementsByName(query)[0]; + if (el !== undefined) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-name))) (defun xwidget-webkit-show-id-element (xw element-id) "Make webkit xwidget XW show an id-element ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Element id: "))) - (let ((y (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementById('%s').getBoundingClientRect().top" - element-id) - 0)))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y) - (set-window-vscroll (selected-window) y t))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementById(query); + if (el !== null) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-id))) (defun xwidget-webkit-show-id-or-named-element (xw element-id) "Make webkit xwidget XW show a name or element id ELEMENT-ID. For example, use this to display an anchor." (interactive (list (xwidget-webkit-current-session) (read-string "Name or element id: "))) - (let* ((y1 (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id) - "0"))) - (y2 (string-to-number - (xwidget-webkit-execute-script-rv - xw - (format "document.getElementById('%s').getBoundingClientRect().top" element-id) - "0"))) - (y3 (max y1 y2))) - ;; Now we need to tell Emacs to scroll the element into view. - (xwidget-log "scroll: %d" y3) - (set-window-vscroll (selected-window) y3 t))) + (xwidget-webkit-execute-script + xw + (format " +(function (query) { + var el = document.getElementById(query) || + document.getElementsByName(query)[0]; + if (el !== undefined) { + window.scrollTo(0, el.offsetTop); + } +})('%s');" + element-id))) (defun xwidget-webkit-adjust-size-to-content () "Adjust webkit to content size." @@ -418,20 +437,18 @@ For example, use this to display an anchor." (defun xwidget-webkit-adjust-size-dispatch () "Adjust size according to mode." (interactive) - (if (eq xwidget-webkit-scroll-behavior 'native) - (xwidget-webkit-adjust-size-to-window) - (xwidget-webkit-adjust-size-to-content)) + (xwidget-webkit-adjust-size-to-window (xwidget-webkit-current-session)) ;; The recenter is intended to correct a visual glitch. ;; It errors out if the buffer isn't visible, but then we don't get ;; the glitch, so silence errors. (ignore-errors (recenter-top-bottom))) -(defun xwidget-webkit-adjust-size-to-window () - "Adjust webkit to window." - (interactive) - (xwidget-resize (xwidget-webkit-current-session) (window-pixel-width) - (window-pixel-height))) +(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) + "Adjust the size of the webkit XWIDGET to fit the WINDOW." + (xwidget-resize xwidget + (window-pixel-width window) + (window-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." @@ -446,6 +463,21 @@ For example, use this to display an anchor." (car (window-inside-pixel-edges))) 1000)) +(defun xwidget-webkit-auto-adjust-size (window) + "Adjust the size of the webkit widget in the given WINDOW." + (with-current-buffer (window-buffer window) + (when (eq major-mode 'xwidget-webkit-mode) + (let ((xwidget (xwidget-webkit-current-session))) + (xwidget-webkit-adjust-size-to-window xwidget window))))) + +(defun xwidget-webkit-adjust-size-in-frame (frame) + "Dynamically adjust webkit widget for all windows of the FRAME." + (walk-windows 'xwidget-webkit-auto-adjust-size 'no-minibuf frame)) + +(eval-after-load 'xwidget-webkit-mode + (add-to-list 'window-size-change-functions + 'xwidget-webkit-adjust-size-in-frame)) + (defun xwidget-webkit-new-session (url) "Create a new webkit session buffer with URL." (let* @@ -453,8 +485,12 @@ For example, use this to display an anchor." xw) (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname))) - (insert " 'a' adjusts the xwidget size.") - (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000)) + ;; The xwidget id is stored in a text property, so we need to have + ;; at least character in this buffer. + (insert " ") + (setq xw (xwidget-insert 1 'webkit bufname + (window-pixel-width) + (window-pixel-height))) (xwidget-put xw 'callback 'xwidget-webkit-callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) @@ -482,45 +518,24 @@ For example, use this to display an anchor." (defun xwidget-webkit-current-url () "Get the webkit url and place it on the kill-ring." (interactive) - (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) - "document.URL")) - (url (kill-new (or rv "")))) - (message "url: %s" url) - url)) - -(defun xwidget-webkit-execute-script-rv (xw script &optional default) - "Same as `xwidget-webkit-execute-script' but with return value. -XW is the webkit instance. SCRIPT is the script to execute. -DEFAULT is the default return value." - ;; Notice the ugly "title" hack. It is needed because the Webkit - ;; API at the time of writing didn't support returning values. This - ;; is a wrapper for the title hack so it's easy to remove should - ;; Webkit someday support JS return values or we find some other way - ;; to access the DOM. - - ;; Reset webkit title. Not very nice. - (let* ((emptytag "titlecantbewhitespaceohthehorror") - title) - (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" - (or default emptytag))) - (xwidget-webkit-execute-script xw (format "document.title=%s;" script)) - (setq title (xwidget-webkit-get-title xw)) - (if (equal emptytag title) - (setq title "")) - (unless title - (setq title default)) - title)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "document.URL" (lambda (rv) + (let ((url (kill-new (or rv "")))) + (message "url: %s" url))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun xwidget-webkit-get-selection () - "Get the webkit selection." - (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session) - "window.getSelection().toString();")) +(defun xwidget-webkit-get-selection (proc) + "Get the webkit selection and pass it to PROC." + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.getSelection().toString();" + proc)) (defun xwidget-webkit-copy-selection-as-kill () "Get the webkit selection and put it on the kill-ring." (interactive) - (kill-new (xwidget-webkit-get-selection))) + (xwidget-webkit-get-selection (lambda (selection) (kill-new selection)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |