diff options
Diffstat (limited to 'lisp')
599 files changed, 34740 insertions, 30272 deletions
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 296e98e859f..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> @@ -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/Makefile.in b/lisp/Makefile.in index f33dd011eda..34f2b2c8cfc 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -81,23 +81,23 @@ AUTOGENEL = loaddefs.el \ cus-load.el \ finder-inf.el \ subdirs.el \ + ps-print-loaddefs.el \ emacs-lisp/cl-loaddefs.el \ calc/calc-loaddefs.el \ eshell/esh-groups.el \ cedet/semantic/loaddefs.el \ cedet/ede/loaddefs.el \ cedet/srecode/loaddefs.el \ - org/org-loaddefs.el - -# Value of max-lisp-eval-depth when compiling initially. -# During bootstrapping the byte-compiler is run interpreted when compiling -# itself, and uses more stack than usual. -# -BIG_STACK_DEPTH = 2200 -BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" + org/org-loaddefs.el \ + textmodes/reftex-loaddefs.el \ + mail/rmail-loaddefs.el \ + ibuffer-loaddefs.el \ + htmlfontify-loaddefs \ + emacs-lisp/eieio-loaddefs.el \ + dired-loaddefs.el # Set load-prefer-newer for the benefit of the non-bootstrappers. -BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) \ +BYTE_COMPILE_FLAGS = \ --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to @@ -185,6 +185,13 @@ $(lisp)/loaddefs.el: $(LOADDEFS) --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ -f batch-update-autoloads ${SUBDIRS_ALMOST} +# autoloads only runs when loaddefs.el is nonexistent, although it +# generates a number of different files. Provide a force option to enable +# regeneration of all these files. +autoloads-force .PHONY: + rm loaddefs.el + $(MAKE) autoloads + # This is required by the bootstrap-emacs target in ../src/Makefile, so # we know that if we have an emacs executable, we also have a subdirs.el. $(lisp)/subdirs.el: @@ -218,25 +225,28 @@ update-gnus-news: "$(top_srcdir)/doc/misc/gnus-news.texi" \ "$(top_srcdir)/etc/GNUS-NEWS" -ETAGS = ../lib-src/etags +FORCE: +.PHONY: FORCE + +tagsfiles = $(shell find ${srcdir} -name '*.el') +tagsfiles := $(filter-out ${srcdir}/%loaddefs.el,${tagsfiles}) +tagsfiles := $(filter-out ${srcdir}/ldefs-boot%.el,${tagsfiles}) +tagsfiles := $(filter-out ${srcdir}/eshell/esh-groups.el,${tagsfiles}) + +ETAGS = ../lib-src/etags${EXEEXT} -lisptagsfiles1 = $(srcdir)/*.el -lisptagsfiles2 = $(srcdir)/*/*.el -lisptagsfiles3 = $(srcdir)/*/*/*.el -lisptagsfiles4 = $(srcdir)/*/*/*/*.el +${ETAGS}: FORCE + ${MAKE} -C ../lib-src $(notdir $@) -## The ls | sed | xargs is to stop the command line getting too long +## The use of xargs is to stop the command line getting too long ## on MS Windows, when the MSYS Bash passes it to a MinGW compiled ## etags. It might be better to use find in a similar way to ## compile-main. But maybe this is not even necessary any more now ## that this uses relative filenames. -TAGS: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) +TAGS: ${ETAGS} ${tagsfiles} rm -f $@ touch $@ - ls $(lisptagsfiles1) $(lisptagsfiles2) \ - $(lisptagsfiles3) $(lisptagsfiles4) | \ - sed -e '/loaddefs/d; /\/ldefs-boot/d; /esh-groups\.el/d' | \ - xargs $(XARGS_LIMIT) "$(ETAGS)" -a -o $@ + ls ${tagsfiles} | xargs $(XARGS_LIMIT) "${ETAGS}" -a -o $@ # The src/Makefile.in has its own set of dependencies and when they decide @@ -273,7 +283,7 @@ $(THEFILE)c: .PHONY: compile-first compile-main compile compile-always -compile-first: $(COMPILE_FIRST) +compile-first: loaddefs.el $(COMPILE_FIRST) # In 'compile-main' we could directly do # ... | xargs $(MAKE) @@ -399,7 +409,7 @@ $(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) CAL_DIR = $(lisp)/calendar ## Those files that may contain internal calendar autoload cookies. CAL_SRC = $(addprefix ${CAL_DIR}/,diary-lib.el holidays.el lunar.el solar.el) -CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal*.el)) +CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal-*.el)) CAL_SRC := $(filter-out ${CAL_DIR}/cal-loaddefs.el,${CAL_SRC}) $(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC) @@ -440,7 +450,7 @@ check-declare: check-defun-dups: sed -n -e '/^(defun /s/\(.\)(.*/\1/p' \ $$(find . -name '*.el' -print | \ - grep -Ev '(loaddefs|ldefs-boot)\.el') | sort | uniq -d + grep -Ev '(loaddefs|ldefs-boot*)\.el') | sort | uniq -d # Dependencies diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 165b24735a0..df817aeae22 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -33,6 +33,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'obarray) (defgroup abbrev-mode nil "Word abbreviations mode." @@ -87,7 +88,7 @@ be replaced by its expansion." "Make a new abbrev-table with the same abbrevs as TABLE. Does not copy property lists." (let ((new-table (make-abbrev-table))) - (mapatoms + (obarray-map (lambda (symbol) (define-abbrev new-table (symbol-name symbol) @@ -406,12 +407,12 @@ A prefix argument means don't query; expand all abbrevs." (defun abbrev-table-get (table prop) "Get the PROP property of abbrev table TABLE." - (let ((sym (intern-soft "" table))) + (let ((sym (obarray-get table ""))) (if sym (get sym prop)))) (defun abbrev-table-put (table prop val) "Set the PROP property of abbrev table TABLE to VAL." - (let ((sym (intern "" table))) + (let ((sym (obarray-put table ""))) (set sym nil) ; Make sure it won't be confused for an abbrev. (put sym prop val))) @@ -435,8 +436,7 @@ See `define-abbrev' for the effect of some special properties. (defun make-abbrev-table (&optional props) "Create a new, empty abbrev table object. PROPS is a list of properties." - ;; The value 59 is an arbitrary prime number. - (let ((table (make-vector 59 0))) + (let ((table (obarray-make))) ;; Each abbrev-table has a `modiff' counter which can be used to detect ;; when an abbreviation was added. An example of use would be to ;; construct :regexp dynamically as the union of all abbrev names, so @@ -451,7 +451,7 @@ PROPS is a list of properties." (defun abbrev-table-p (object) "Return non-nil if OBJECT is an abbrev table." - (and (vectorp object) + (and (obarrayp object) (numberp (abbrev-table-get object :abbrev-table-modiff)))) (defun abbrev-table-empty-p (object &optional ignore-system) @@ -460,12 +460,12 @@ If IGNORE-SYSTEM is non-nil, system definitions are ignored." (unless (abbrev-table-p object) (error "Non abbrev table object")) (not (catch 'some - (mapatoms (lambda (abbrev) - (unless (or (zerop (length (symbol-name abbrev))) - (and ignore-system - (abbrev-get abbrev :system))) - (throw 'some t))) - object)))) + (obarray-map (lambda (abbrev) + (unless (or (zerop (length (symbol-name abbrev))) + (and ignore-system + (abbrev-get abbrev :system))) + (throw 'some t))) + object)))) (defvar global-abbrev-table (make-abbrev-table) "The abbrev table whose abbrevs affect all buffers. @@ -529,12 +529,12 @@ the current abbrev table before abbrev lookup happens." (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." (setq abbrevs-changed t) - (let* ((sym (intern-soft "" table))) + (let* ((sym (obarray-get table ""))) (dotimes (i (length table)) (aset table i 0)) ;; Preserve the table's properties. (cl-assert sym) - (let ((newsym (intern "" table))) + (let ((newsym (obarray-put table ""))) (set newsym nil) ; Make sure it won't be confused for an abbrev. (setplist newsym (symbol-plist sym))) (abbrev-table-put table :abbrev-table-modiff @@ -583,7 +583,7 @@ An obsolete but still supported calling form is: (setq props (plist-put props :abbrev-table-modiff (abbrev-table-get table :abbrev-table-modiff))) (let ((system-flag (plist-get props :system)) - (sym (intern name table))) + (sym (obarray-put table name))) ;; Don't override a prior user-defined abbrev with a system abbrev, ;; unless system-flag is `force'. (unless (and (not (memq system-flag '(nil force))) @@ -673,10 +673,10 @@ The value is nil if that abbrev is not defined." ;; abbrevs do, we have to be careful. (sym ;; First try without case-folding. - (or (intern-soft abbrev table) + (or (obarray-get table abbrev) (when case-fold ;; We didn't find any abbrev, try case-folding. - (let ((sym (intern-soft (downcase abbrev) table))) + (let ((sym (obarray-get table (downcase abbrev)))) ;; Only use it if it doesn't require :case-fixed. (and sym (not (abbrev-get sym :case-fixed)) sym)))))) @@ -849,7 +849,7 @@ be the abbrev symbol if expansion occurred, else nil.)" 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)) @@ -1006,17 +1006,17 @@ PROMPT is the prompt to use for the keymap. SORTFUN is passed to `sort' to change the default ordering." (unless sortfun (setq sortfun 'string-lessp)) (let ((entries ())) - (mapatoms (lambda (abbrev) - (when (symbol-value abbrev) - (let ((name (symbol-name abbrev))) - (push `(,(intern name) menu-item ,name - (lambda () (interactive) - (abbrev-insert ',abbrev))) - entries)))) - table) + (obarray-map (lambda (abbrev) + (when (symbol-value abbrev) + (let ((name (symbol-name abbrev))) + (push `(,(intern name) menu-item ,name + (lambda () (interactive) + (abbrev-insert ',abbrev))) + entries)))) + table) (nconc (make-sparse-keymap prompt) (sort entries (lambda (x y) - (funcall sortfun (nth 2 x) (nth 2 y))))))) + (funcall sortfun (nth 2 x) (nth 2 y))))))) ;; Keep it after define-abbrev-table, since define-derived-mode uses ;; define-abbrev-table. diff --git a/lisp/align.el b/lisp/align.el index f09f57032d4..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. @@ -802,6 +802,9 @@ See the variable `align-exclude-rules-list' for more details.") (defvar align-highlight-overlays nil "The current overlays highlighting the text matched by a rule.") +(defvar align-regexp-history nil + "Input history for the full user-entered regex in `align-regexp'") + ;; Sample extension rule set, for vhdl-mode. This should properly be ;; in vhdl-mode.el itself. @@ -946,7 +949,7 @@ construct a rule to pass to `align-region', which does the real work." (list (region-beginning) (region-end)) (if current-prefix-arg (list (read-string "Complex align using regexp: " - "\\(\\s-*\\)") + "\\(\\s-*\\)" 'align-regexp-history) (string-to-number (read-string "Parenthesis group to modify (justify if negative): " "1")) 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 72357742b60..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)) diff --git a/lisp/gnus/auth-source.el b/lisp/auth-source.el index df8f61ff380..62d9a4521c0 100644 --- a/lisp/gnus/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. @@ -40,10 +40,8 @@ ;;; Code: (require 'password-cache) -(require 'mm-util) -(require 'gnus-util) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'eieio) (autoload 'secrets-create-item "secrets") @@ -365,18 +363,14 @@ 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) (while (not (memq k choices)) - (setq k (cond - ((fboundp 'read-char-choice) - (read-char-choice full-prompt choices)) - (t (message "%s" full-prompt) - (setq k (read-char)))))) + (setq k (read-char-choice full-prompt choices))) k))) ;; (auth-source-pick nil :host "any" :port 'imap :user "joe") @@ -544,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 @@ -687,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) @@ -701,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 @@ -818,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) @@ -872,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") @@ -947,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) @@ -989,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) @@ -1008,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)) @@ -1092,12 +1083,10 @@ Note that the MAX parameter is used so we can exit the parse early." (when (setq item2 (auth-source-netrc-parse-one)) ;; Did we get a "machine" value? (if (equal item2 "machine") - (progn - (gnus-error 1 - "%s: Unexpected `machine' token at line %d" - "auth-source-netrc-parse-entries" - (auth-source-current-line)) - (forward-line 1)) + (error + "%s: Unexpected `machine' token at line %d" + "auth-source-netrc-parse-entries" + (auth-source-current-line)) (push (cons item item2) alist))))) ;; Clean up: if there's an entry left over, use it. @@ -1126,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)))) @@ -1163,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) @@ -1182,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 @@ -1199,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)) @@ -1207,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 @@ -1253,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) @@ -1276,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) @@ -1288,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))))) @@ -1300,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)) @@ -1331,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: ") @@ -1390,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)))) @@ -1408,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") @@ -1422,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))) @@ -1462,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 @@ -1534,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 @@ -1577,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 @@ -1601,16 +1583,17 @@ authentication tokens: (list k (plist-get spec k)))) search-keys)))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + (returned-keys (delete-dups (append + '(: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 @@ -1619,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 @@ -1661,11 +1644,9 @@ 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) +(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 @@ -1706,21 +1687,23 @@ entries for git.gnus.org: (auth-source-search :max 1 :host \"git.gnus.org\")) " ;; TODO - (assert (not create) nil + (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 + (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 - (ignored-keys '(:create :delete :max :backend :label)) - (search-keys (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 + ;; Filter out ignored keys from the spec + (ignored-keys '(:create :delete :max :backend :label :host :port)) + ;; Build a search spec without the ignored keys + ;; 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) (if (or (null (plist-get spec k)) @@ -1729,14 +1712,28 @@ entries for git.gnus.org: (list k (plist-get spec k)))) search-keys))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) - (items (apply #'auth-source-macos-keychain-search-items - coll - type - max - search-spec)) + (returned-keys (delete-dups (append + '(:host :login :port :secret) + search-keys))) + ;; Extract host and port from spec + (hosts (plist-get spec :host)) + (hosts (if (and hosts (listp hosts)) hosts `(,hosts))) + (ports (plist-get spec :port)) + (ports (if (and ports (listp ports)) ports `(,ports))) + ;; Loop through all combinations of host/port and pass each of these to + ;; auth-source-macos-keychain-search-items + (items (catch 'match + (dolist (host hosts) + (dolist (port ports) + (let* ((port (if port (format "%S" port))) + (items (apply #'auth-source-macos-keychain-search-items + coll + type + max + host port + search-spec))) + (when items + (throw 'match items))))))) ;; ensure each item has each key in `returned-keys' (items (mapcar (lambda (plist) @@ -1751,11 +1748,26 @@ entries for git.gnus.org: items))) items)) -(defun* auth-source-macos-keychain-search-items (coll _type _max - &key label type - host user port - &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" @@ -1784,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 @@ -1831,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 @@ -1856,9 +1869,9 @@ entries for git.gnus.org: (list k v)))) search-keys))) ;; needed keys (always including host, login, port, and secret) - (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + (returned-keys (delete-dups (append + '(:host :login :port :secret) + search-keys))) (items (plstore-find store search-spec)) (item-names (mapcar #'car items)) (items (butlast items (- (length items) max))) @@ -1869,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)) @@ -1907,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 @@ -1930,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) @@ -1942,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))))) @@ -1954,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)) @@ -1985,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: ") @@ -2014,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 d2a6213c3a8..f399ada5714 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 buffer 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 buffer 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. @@ -354,8 +360,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))) @@ -377,11 +389,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), @@ -434,7 +446,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)" @@ -443,12 +455,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. @@ -467,11 +479,7 @@ specifies in the mode line." :global t :group 'auto-revert :lighter global-auto-revert-mode-text (auto-revert-set-timer) (if global-auto-revert-mode - (progn - ;; Disable file notification because it could use too many resources. - ;; See Bug#22814. - (setq auto-revert-use-notify nil) - (auto-revert-buffers)) + (auto-revert-buffers) (dolist (buf (buffer-list)) (with-current-buffer buf (when auto-revert-use-notify @@ -586,16 +594,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)))) @@ -749,7 +760,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 20f3017fc45..74f06e8c6fc 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -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. @@ -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 9e8e745ec63..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" @@ -430,11 +434,9 @@ Major modes that edit things other than ordinary files may change this (make-variable-buffer-local 'mode-line-buffer-identification) (defvar mode-line-misc-info - '((which-func-mode ("" which-func-format " ")) - (global-mode-string ("" global-mode-string " "))) + '((global-mode-string ("" global-mode-string " "))) "Mode line construct for miscellaneous information. -By default, this shows the information specified by -`which-func-mode' and `global-mode-string'.") +By default, this shows the information specified by `global-mode-string'.") (put 'mode-line-misc-info 'risky-local-variable t) (defvar mode-line-end-spaces '(:eval (unless (display-graphic-p) "-%-")) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index f3c8b2a755f..7d45832f58c 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2123,7 +2123,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (current-buffer)))) (read-string "Pattern: ") (when timer (cancel-timer timer) (setq timer nil))) - (when timer ;; Signalled an error or a `quit'. + (when timer ;; Signaled an error or a `quit'. (cancel-timer timer) (bookmark-bmenu-list) (bookmark-bmenu-goto-bookmark bmk))))) 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/calculator.el b/lisp/calculator.el index bba52e22544..523bf98180a 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -161,6 +161,8 @@ This makes it possible to paste big integers since they will be read as floats, otherwise the Emacs reader will fail on them." :type 'boolean :group 'calculator) +(make-obsolete-variable 'calculator-paste-decimals + "it is no longer used." nil) (defcustom calculator-copy-displayer nil "If non-nil, this is any value that can be used for @@ -195,9 +197,9 @@ For example, use this to define the golden ratio number: before you load calculator." :type '(repeat (cons character number)) :set (lambda (_ val) - (and (boundp 'calculator-registers) - (setq calculator-registers - (append val calculator-registers))) + (when (boundp 'calculator-registers) + (setq calculator-registers + (append val calculator-registers))) (setq calculator-user-registers val)) :group 'calculator) @@ -221,10 +223,10 @@ Examples: (\"tF\" mt-to-ft (/ X 0.3048) 1) (\"tM\" ft-to-mt (* X 0.3048) 1))) -* Using a function-like form is very simple: use `X' for the argument - (`Y' for the second in case of a binary operator), `TX' is a truncated +* Using a function-like form is simple: use `X' for the argument (`Y' + for a second one in case of a binary operator), `TX' is a truncated version of `X' and `F' for a recursive call. Here is a [very - inefficient] Fibonacci number calculation: + inefficient] Fibonacci number operator: (add-to-list \\='calculator-user-operators \\='(\"F\" fib @@ -290,7 +292,8 @@ user-defined operators, use `calculator-user-operators' instead.") (defvar calculator-operators nil "The calculator operators, each a list with: -1. The key that is bound to for this operation (usually a string); +1. The key(s) that is bound to for this operation, a string that is + used with `kbd'; 2. The displayed symbol for this function; @@ -312,8 +315,8 @@ user-defined operators, use `calculator-user-operators' instead.") It it possible have a unary prefix version of a binary operator if it comes later in this list. If the list begins with the symbol `nobind', -then no key binding will take place -- this is only useful for -predefined keys. +then no key binding will take place -- this is only used for predefined +keys. Use `calculator-user-operators' to add operators to this list, see its documentation for an example.") @@ -370,73 +373,96 @@ Used for repeating operations in calculator-repR/L.") (list (cons ?e float-e) (cons ?p float-pi))) "The association list of calculator register values.") -(defvar calculator-saved-global-map nil - "Saved global key map.") - (defvar calculator-restart-other-mode nil "Used to hack restarting with the electric mode changed.") ;;;--------------------------------------------------------------------- ;;; Key bindings +(defun calculator-define-key (key cmd map) + ;; Arranges for unbound alphabetic keys to be used as their un/shifted + ;; versions if those are bound (mimics the usual Emacs global bindings). + ;; FIXME: We should adjust Emacs's native "fallback to unshifted binding" + ;; such that it can also be used here, rather than having to use a hack like + ;; this one. + (let* ((key (if (stringp key) (kbd key) key)) + (omap (keymap-parent map))) + (define-key map key cmd) + ;; "other" map, used for case-flipped bindings + (unless omap + (setq omap (make-sparse-keymap)) + (suppress-keymap omap t) + (set-keymap-parent map omap)) + (let ((m omap)) + ;; Bind all case-flipped versions. + (dotimes (i (length key)) + (let* ((c (aref key i)) + (k (vector c)) + (b (lookup-key m k)) + (defkey (lambda (x) + (define-key m k x) + (when (and (characterp c) + (or (<= ?A c ?Z) (<= ?a c ?z))) + (define-key m (vector (logxor 32 c)) x))))) + (cond ((= i (1- (length key))) + ;; Prefer longer sequences. + (unless (keymapp b) (funcall defkey cmd))) + ((keymapp b) (setq m b)) + (t (let ((sub (make-sparse-keymap))) + (funcall defkey sub) + (setq m sub))))))))) + (defvar calculator-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map t) - (define-key map "i" nil) - (define-key map "o" nil) - (let ((p - '((calculator-open-paren "[") - (calculator-close-paren "]") - (calculator-op-or-exp "+" "-" [kp-add] [kp-subtract]) - (calculator-digit "0" "1" "2" "3" "4" "5" "6" "7" "8" - "9" "a" "b" "c" "d" "f" - [kp-0] [kp-1] [kp-2] [kp-3] [kp-4] - [kp-5] [kp-6] [kp-7] [kp-8] [kp-9]) - (calculator-op [kp-divide] [kp-multiply]) - (calculator-decimal "." [kp-decimal]) - (calculator-exp "e" "E") - (calculator-dec/deg-mode "D") - (calculator-set-register "s") - (calculator-get-register "g") - (calculator-radix-mode "H" "X" "O" "B") - (calculator-radix-input-mode "id" "ih" "ix" "io" "ib" - "iD" "iH" "iX" "iO" "iB") - (calculator-radix-output-mode "od" "oh" "ox" "oo" "ob" - "oD" "oH" "oX" "oO" "oB") - (calculator-rotate-displayer "'") - (calculator-rotate-displayer-back "\"") - (calculator-displayer-prev "{") - (calculator-displayer-next "}") - (calculator-saved-up [up] [?\C-p]) - (calculator-saved-down [down] [?\C-n]) - (calculator-quit "q" [?\C-g]) - (calculator-enter [enter] [linefeed] [kp-enter] - [return] [?\r] [?\n]) - (calculator-save-on-list " " [space]) - (calculator-clear-saved [?\C-c] [(control delete)]) - (calculator-save-and-quit [(control return)] - [(control kp-enter)]) - (calculator-paste [insert] [(shift insert)] - [paste] [mouse-2] [?\C-y]) - (calculator-clear [delete] [?\C-?] [?\C-d]) - (calculator-help [?h] [??] [f1] [help]) - (calculator-copy [(control insert)] [copy]) - (calculator-backspace [backspace]) - ))) - (while p - ;; reverse the keys so earlier definitions come last -- makes - ;; the more sensible bindings visible in the menu - (let ((func (caar p)) (keys (reverse (cdar p)))) - (while keys - (define-key map (car keys) func) - (setq keys (cdr keys)))) - (setq p (cdr p)))) + (dolist (x '((calculator-digit + "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c" + "d" "f" "<kp-0>" "<kp-1>" "<kp-2>" "<kp-3>" "<kp-4>" + "<kp-5>" "<kp-6>" "<kp-7>" "<kp-8>" "<kp-9>") + (calculator-open-paren "[") + (calculator-close-paren "]") + (calculator-op-or-exp "+" "-" + "<kp-add>" "<kp-subtract>") + (calculator-op "<kp-divide>" "<kp-multiply>") + (calculator-decimal "." "<kp-decimal>") + (calculator-exp "e") + (calculator-dec/deg-mode "D") + (calculator-set-register "s") + (calculator-get-register "g") + (calculator-radix-mode "H" "X" "O" "B") + (calculator-radix-input-mode "iD" "iH" "iX" "iO" "iB") + (calculator-radix-output-mode "oD" "oH" "oX" "oO" "oB") + (calculator-rotate-displayer "'") + (calculator-rotate-displayer-back "\"") + (calculator-displayer-prev "{") + (calculator-displayer-next "}") + (calculator-saved-up "<up>" "C-p") + (calculator-saved-down "<down>" "C-n") + (calculator-quit "q" "C-g") + (calculator-enter "<enter>" "<linefeed>" + "<kp-enter>" "<return>" + "RET" "LFD") + (calculator-save-on-list "SPC" "<space>") + (calculator-clear-saved "C-c" "<C-delete>") + (calculator-save-and-quit "<C-return>" "<C-kp-enter>") + (calculator-paste "<insert>" "<S-insert>" + "<paste>" "<mouse-2>" "C-y") + (calculator-clear "<delete>" "DEL" "C-d") + (calculator-help "h" "?" "<f1>" "<help>") + (calculator-copy "<C-insert>" "<copy>") + (calculator-backspace "<backspace>") + )) + ;; reverse the keys so earlier definitions come last -- makes the + ;; more sensible bindings visible in the menu + (dolist (k (reverse (cdr x))) + (calculator-define-key k (car x) map))) (if calculator-bind-escape - (progn (define-key map [?\e] 'calculator-quit) - (define-key map [escape] 'calculator-quit)) - (define-key map [?\e ?\e ?\e] 'calculator-quit)) + (progn (calculator-define-key "ESC" 'calculator-quit map) + (calculator-define-key "<escape>" 'calculator-quit map)) + (calculator-define-key "ESC ESC ESC" 'calculator-quit map)) ;; make C-h work in text-mode - (or window-system (define-key map [?\C-h] 'calculator-backspace)) + (unless window-system + (calculator-define-key "C-h" 'calculator-backspace map)) ;; set up a menu (when (and calculator-use-menu (not (boundp 'calculator-menu))) (let ((radix-selectors @@ -530,9 +556,9 @@ Used for repeating operations in calculator-repR/L.") ("Modes" ["Radians" (progn - (and (or calculator-input-radix calculator-output-radix) - (calculator-radix-mode "D")) - (and calculator-deg (calculator-dec/deg-mode))) + (when (or calculator-input-radix calculator-output-radix) + (calculator-radix-mode "D")) + (when calculator-deg (calculator-dec/deg-mode))) :keys "D" :style radio :selected (not (or calculator-input-radix @@ -540,9 +566,9 @@ Used for repeating operations in calculator-repR/L.") calculator-deg))] ["Degrees" (progn - (and (or calculator-input-radix calculator-output-radix) - (calculator-radix-mode "D")) - (or calculator-deg (calculator-dec/deg-mode))) + (when (or calculator-input-radix calculator-output-radix) + (calculator-radix-mode "D")) + (unless calculator-deg (calculator-dec/deg-mode))) :keys "D" :style radio :selected (and calculator-deg @@ -619,16 +645,17 @@ argument. hex/oct/bin modes can be set for input and for display separately. Another toggle-able mode is for using degrees instead of radians for trigonometric functions. -The keys to switch modes are (`X' is shortcut for `H'): +The keys to switch modes are (both `H' and `X' are for hex): * `D' switch to all-decimal mode, or toggle degrees/radians * `B' `O' `H' `X' binary/octal/hexadecimal modes for input & display * `i' `o' followed by one of `D' `B' `O' `H' `X' (case insensitive) sets only the input or display radix mode The prompt indicates the current modes: -* \"D=\": degrees mode; -* \"?=\": (? is B/O/H) this is the radix for both input and output; -* \"=?\": (? is B/O/H) the display radix (when input is decimal); -* \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display. +* \"==\": decimal mode (using radians); +* \"D=\": decimal mode using degrees; +* \"?=\": ? is B/O/H, the radix for both input and output; +* \"=?\": ? is B/O/H, the display radix (with decimal input); +* \"??\": ? is D/B/O/H, 1st char for input radix, 2nd for display. Also, the quote key can be used to switch display modes for decimal numbers (double-quote rotates back), and the two brace characters @@ -688,19 +715,14 @@ See the documentation for `calculator-mode' for more information." (if calculator-electric-mode (save-window-excursion (require 'electric) (message nil) ; hide load message - (let (old-g-map old-l-map - (old-buf (window-buffer (minibuffer-window))) + (let ((old-buf (window-buffer (minibuffer-window))) (echo-keystrokes 0) (garbage-collection-messages nil)) ; no gc msg when electric (set-window-buffer (minibuffer-window) calculator-buffer) (select-window (minibuffer-window)) (calculator-reset) (calculator-update-display) - (setq old-l-map (current-local-map)) - (setq old-g-map (current-global-map)) - (setq calculator-saved-global-map (current-global-map)) - (use-local-map nil) - (use-global-map calculator-mode-map) + (use-local-map calculator-mode-map) (run-hooks 'calculator-mode-hook) (unwind-protect (catch 'calculator-done @@ -711,9 +733,7 @@ See the documentation for `calculator-mode' for more information." nil (lambda (_x _y) (calculator-update-display)))) (set-window-buffer (minibuffer-window) old-buf) - (kill-buffer calculator-buffer) - (use-local-map old-l-map) - (use-global-map old-g-map)))) + (kill-buffer calculator-buffer)))) (progn (cond ((not (get-buffer-window calculator-buffer)) @@ -780,25 +800,11 @@ Defaults to 1." Adds MORE-OPS to `calculator-operator', called initially to handle `calculator-initial-operators' and `calculator-user-operators'." (let ((added-ops nil)) - (while more-ops - (or (eq (caar more-ops) 'nobind) - (let ((i -1) (key (caar more-ops))) - ;; make sure the key is undefined, so it's easy to define - ;; prefix keys - (while (< (setq i (1+ i)) (length key)) - (or (keymapp - (lookup-key calculator-mode-map - (substring key 0 (1+ i)))) - (progn - (define-key - calculator-mode-map (substring key 0 (1+ i)) nil) - (setq i (length key))))) - (define-key calculator-mode-map key 'calculator-op))) - (setq added-ops (cons (if (eq (caar more-ops) 'nobind) - (cdar more-ops) - (car more-ops)) - added-ops)) - (setq more-ops (cdr more-ops))) + (dolist (op more-ops) + (unless (eq (car op) 'nobind) + (calculator-define-key (car op) 'calculator-op calculator-mode-map)) + (push (if (eq (car op) 'nobind) (cdr op) op) + added-ops)) ;; added-ops come first, but in correct order (setq calculator-operators (append (nreverse added-ops) calculator-operators)))) @@ -808,11 +814,11 @@ Adds MORE-OPS to `calculator-operator', called initially to handle (defun calculator-reset () "Reset calculator variables." - (or calculator-restart-other-mode - (setq calculator-stack nil - calculator-curnum nil - calculator-stack-display nil - calculator-display-fragile nil)) + (unless calculator-restart-other-mode + (setq calculator-stack nil + calculator-curnum nil + calculator-stack-display nil + calculator-display-fragile nil)) (setq calculator-restart-other-mode nil) (calculator-update-display)) @@ -831,7 +837,7 @@ The result should not exceed the screen width." (cond ((or in-r out-r) (concat (or in-r "=") (if (equal in-r out-r) "=" - (or out-r "=")))) + (or out-r "D")))) (calculator-deg "D=") (t "==")))) (expr @@ -852,39 +858,13 @@ The result should not exceed the screen width." "Convert the given STR to a number, according to the value of `calculator-input-radix'." (if calculator-input-radix - (let ((radix - (cdr (assq calculator-input-radix - '((bin . 2) (oct . 8) (hex . 16))))) - (i -1) (value 0) (new-value 0)) - ;; assume mostly valid input (e.g., characters in range) - (while (< (setq i (1+ i)) (length str)) - (setq new-value - (let* ((ch (upcase (aref str i))) - (n (cond ((< ch ?0) nil) - ((<= ch ?9) (- ch ?0)) - ((< ch ?A) nil) - ((<= ch ?Z) (- ch (- ?A 10))) - (t nil)))) - (if (and n (<= 0 n) (< n radix)) - (+ n (* radix value)) - (progn - (calculator-message - "Warning: Ignoring bad input character `%c'." ch) - (sit-for 1) - value)))) - (when (if (< new-value 0) (> value 0) (< value 0)) - (calculator-message "Warning: Overflow in input.")) - (setq value new-value)) - value) - (car (read-from-string - (cond ((equal "." str) "0.0") - ((string-match-p "[eE][+-]?$" str) (concat str "0")) - ((string-match-p "\\.[0-9]\\|[eE]" str) str) - ((string-match-p "\\." str) - ;; do this because Emacs reads "23." as an integer - (concat str "0")) - ((stringp str) (concat str ".0")) - (t "0.0")))))) + (string-to-number str (cadr (assq calculator-input-radix + '((bin 2) (oct 8) (hex 16))))) + (let* ((str (replace-regexp-in-string + "\\.\\([^0-9].*\\)?$" ".0\\1" str)) + (str (replace-regexp-in-string + "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str))) + (string-to-number str)))) (defun calculator-push-curnum () "Push the numeric value of the displayed number to the stack." @@ -911,9 +891,7 @@ If radix output mode is active, toggle digit grouping." (if (and new-disp (memq new-disp calculator-displayers)) (let ((tmp nil)) (while (not (eq (car calculator-displayers) new-disp)) - (setq tmp (cons (car calculator-displayers) tmp)) - (setq calculator-displayers - (cdr calculator-displayers))) + (push (pop calculator-displayers) tmp)) (setq calculator-displayers (nconc calculator-displayers (nreverse tmp)))) (nconc (cdr calculator-displayers) @@ -938,11 +916,11 @@ If radix output mode is active, increase the grouping size." (progn (setq calculator-radix-grouping-digits (1+ calculator-radix-grouping-digits)) (calculator-enter)) - (and (car calculator-displayers) - (let ((disp (caar calculator-displayers))) - (cond ((symbolp disp) (funcall disp 'left)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'left))))))) + (when (car calculator-displayers) + (let ((disp (caar calculator-displayers))) + (cond ((symbolp disp) (funcall disp 'left)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'left))))))) (defun calculator-displayer-next () "Send the current displayer function a `right' argument. @@ -954,11 +932,11 @@ If radix output mode is active, decrease the grouping size." (progn (setq calculator-radix-grouping-digits (max 2 (1- calculator-radix-grouping-digits))) (calculator-enter)) - (and (car calculator-displayers) - (let ((disp (caar calculator-displayers))) - (cond ((symbolp disp) (funcall disp 'right)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'right))))))) + (when (car calculator-displayers) + (let ((disp (caar calculator-displayers))) + (cond ((symbolp disp) (funcall disp 'right)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'right))))))) (defun calculator-remove-zeros (numstr) "Get a number string NUMSTR and remove unnecessary zeros. @@ -1003,10 +981,10 @@ The special `left' and `right' symbols will make it change the current number of digits displayed (`calculator-number-digits')." (if (symbolp num) (cond ((eq num 'left) - (and (> calculator-number-digits 0) - (setq calculator-number-digits - (1- calculator-number-digits)) - (calculator-enter))) + (when (> calculator-number-digits 0) + (setq calculator-number-digits + (1- calculator-number-digits)) + (calculator-enter))) ((eq num 'right) (setq calculator-number-digits (1+ calculator-number-digits)) @@ -1054,7 +1032,7 @@ the `left' or `right' when one of the standard modes is used." (while (< i 0) (setq num (/ num 1000.0)) (setq exp (+ exp 3)) (setq i (1+ i)))))) - (or calculator-eng-tmp-show (setq calculator-eng-extra nil)) + (unless calculator-eng-tmp-show (setq calculator-eng-extra nil)) (let ((str (format (format "%%.%sf" calculator-number-digits) num))) (concat (let ((calculator-remove-zeros @@ -1206,7 +1184,7 @@ arguments." (DX (if (and X calculator-deg) (degrees-to-radians X) X)) (L calculator-saved-list) (fF `(calculator-funcall ',f x y)) - (fD `(if calculator-deg (* radians-to-degrees x) x))) + (fD `(if calculator-deg (radians-to-degrees x) x))) (eval `(cl-flet ((F (&optional x y) ,fF) (D (x) ,fD)) (let ((X ,X) (Y ,Y) (DX ,DX) (TX ,TX) (TY ,TY) (L ',L)) ,f)) @@ -1216,19 +1194,20 @@ arguments." ;;; Input interaction (defun calculator-last-input (&optional keys) - "Last char (or event or event sequence) that was read. -Use KEYS if given, otherwise use `this-command-keys'." - (let ((inp (or keys (this-command-keys)))) - (if (or (stringp inp) (not (arrayp inp)) (member inp '([f1] [help]))) + "Return the last key sequence that was used to invoke this command, or +the input KEYS. Uses the `function-key-map' translate keypad numbers to +plain ones." + (let* ((inp (or keys (this-command-keys))) + (inp (or (and (arrayp inp) (not (stringp inp)) + (lookup-key function-key-map inp)) + inp))) + (if (or (not inp) (stringp inp) (not (arrayp inp)) + (catch 'done ; any non-chars? + (dotimes (i (length inp)) + (unless (characterp (aref inp i)) (throw 'done t))) + nil)) inp - ;; Translates kp-x to x and [tries to] create a string to lookup - ;; operators; assume all symbols are translatable via - ;; `function-key-map'. This is needed because we have key - ;; bindings for kp-* (which might be the wrong thing to do) so - ;; they don't get translated in `this-command-keys'. - (concat (mapcar (lambda (k) - (if (numberp k) k (error "??bad key?? (%S)" k))) - (or (lookup-key function-key-map inp) inp)))))) + (concat inp)))) (defun calculator-clear-fragile (&optional op) "Clear the fragile flag if it was set, then maybe reset all. @@ -1270,7 +1249,7 @@ OP is the operator (if any) that caused this call." (calculator-update-display))) (defun calculator-exp () - "Enter an `E' exponent character, or a digit in hex input mode." + "Enter an exponent, or an \"E\" digit in hex input mode." (interactive) (cond (calculator-input-radix (calculator-digit)) @@ -1312,18 +1291,13 @@ Optional string argument KEYS will force using it as the keys entered." (throw 'op-error nil)) (push op calculator-stack) (calculator-reduce-stack (calculator-op-prec op)) - (and (= (length calculator-stack) 1) - (numberp (car calculator-stack)) - ;; the display is fragile if it contains only one number - (setq calculator-display-fragile t) - ;; add number to the saved-list - calculator-add-saved - (if (= 0 calculator-saved-ptr) - (setq calculator-saved-list - (cons (car calculator-stack) calculator-saved-list)) - (let ((p (nthcdr (1- calculator-saved-ptr) - calculator-saved-list))) - (setcdr p (cons (car calculator-stack) (cdr p)))))) + (when (and (= (length calculator-stack) 1) + (numberp (car calculator-stack))) + ;; the display is fragile if it contains only one number + (setq calculator-display-fragile t) + (when calculator-add-saved ; add number to the saved-list + (push (car calculator-stack) + (nthcdr calculator-saved-ptr calculator-saved-list)))) (calculator-update-display)))) (defun calculator-op-or-exp () @@ -1332,7 +1306,8 @@ Used with +/- for entering them as digits in numbers like 1e-3 (there is no need for negative numbers since these are handled by unary operators)." (interactive) - (if (and (not calculator-display-fragile) + (if (and (not calculator-input-radix) + (not calculator-display-fragile) calculator-curnum (string-match-p "[eE]$" calculator-curnum)) (calculator-digit) @@ -1346,8 +1321,8 @@ operators)." (interactive) (calculator-push-curnum) (if (or calculator-input-radix calculator-output-radix) - (progn (setq calculator-input-radix nil) - (setq calculator-output-radix nil)) + (setq calculator-input-radix nil + calculator-output-radix nil) ;; already decimal -- toggle degrees mode (setq calculator-deg (not calculator-deg))) (calculator-update-display t)) @@ -1393,8 +1368,8 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-clear-saved () "Clear the list of saved values in `calculator-saved-list'." (interactive) - (setq calculator-saved-list nil) - (setq calculator-saved-ptr 0) + (setq calculator-saved-list nil + calculator-saved-ptr 0) (calculator-update-display t)) (defun calculator-saved-move (n) @@ -1492,21 +1467,6 @@ Optional string argument KEYS will force using it as the keys entered." (kill-new (replace-regexp-in-string "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" "\\1" s)))))) -(defun calculator-set-register (reg) - "Set a register value for REG." - ;; FIXME: this should use `register-read-with-preview', but it uses - ;; calculator-registers rather than `register-alist'. (Maybe - ;; dynamically rebinding it will get blessed?) Also in to - ;; `calculator-get-register'. - (interactive "cRegister to store into: ") - (let* ((as (assq reg calculator-registers)) - (val (progn (calculator-enter) (car calculator-stack)))) - (if as - (setcdr as val) - (setq calculator-registers - (cons (cons reg val) calculator-registers))) - (calculator-message "[%c] := %S" reg val))) - (defun calculator-put-value (val) "Paste VAL as if entered. Used by `calculator-paste' and `get-register'." @@ -1515,31 +1475,55 @@ Used by `calculator-paste' and `get-register'." (or calculator-display-fragile (not (numberp (car calculator-stack))))) (calculator-clear-fragile) - (setq calculator-curnum (let ((calculator-displayer "%S")) - (calculator-number-to-string val))) + (setq calculator-curnum + (let ((calculator-displayer "%S") + (calculator-radix-grouping-mode nil) + (calculator-output-radix calculator-input-radix)) + (calculator-number-to-string val))) (calculator-update-display))) -(defun calculator-paste () - "Paste a value from the `kill-ring'." - (interactive) - (calculator-put-value - (let ((str (replace-regexp-in-string - "^ *\\(.+[^ ]\\) *$" "\\1" (current-kill 0)))) - (and (not calculator-input-radix) - calculator-paste-decimals - (string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?" - str) - (or (match-string 1 str) - (match-string 2 str) - (match-string 3 str)) - (setq str (concat (or (match-string 1 str) "0") - (or (match-string 2 str) ".0") - (or (match-string 3 str) "")))) - (ignore-errors (calculator-string-to-number str))))) +(defun calculator-paste (arg) + "Paste a value from the `kill-ring'. + +With a prefix argument, paste the raw string as a sequence of key +presses, which can be used to paste expressions. Note that this +is literal; examples: spaces will store values, pasting \"1+2\" +will not produce 3 if it's done you're entering a number or after +a multiplication." + (interactive "P") + (let ((str (current-kill 0))) + (if arg + (setq unread-command-events + `(,@(listify-key-sequence str) ,@unread-command-events)) + (calculator-put-value (calculator-string-to-number str))))) + +(defun calculator-register-read-with-preview (prompt) + "Similar to `register-read-with-preview' but for calculator +registers." + (let ((register-alist calculator-registers) + (register-preview-delay 1) + (register-preview-function + (lambda (r) + (format "%s: %s\n" + (single-key-description (car r)) + (calculator-number-to-string (cdr r)))))) + (register-read-with-preview prompt))) + +(defun calculator-set-register (reg) + "Set a register value for REG." + (interactive (list (calculator-register-read-with-preview + "Register to store value into: "))) + (let* ((as (assq reg calculator-registers)) + (val (progn (calculator-enter) (car calculator-stack)))) + (if as + (setcdr as val) + (push (cons reg val) calculator-registers)) + (calculator-message "[%c] := %S" reg val))) (defun calculator-get-register (reg) "Get a value from a register REG." - (interactive "cRegister to get value from: ") + (interactive (list (calculator-register-read-with-preview + "Register to get value from: "))) (calculator-put-value (cdr (assq reg calculator-registers)))) (declare-function electric-describe-mode "ehelp" ()) @@ -1551,10 +1535,11 @@ Used by `calculator-paste' and `get-register'." + - * / \\(div) %(rem) _(-X,postfix) ;(1/X,postfix) ^(exp) L(og) Q(sqrt) !(fact) S(in) C(os) T(an) |(or) #(xor) &(and) ~(not) * >/< repeats last binary operation with its 2nd (1st) arg as postfix op -* I inverses next trig function * \\='/\"/{} - display/display args +* I inverse the next trig function \ +* \\='/\"/{/} - display/display args * D - switch to all-decimal, or toggle deg/rad mode -* B/O/H/X - binary/octal/hex mode for i/o (X is a shortcut for H) -* i/o - prefix for d/b/o/x - set only input/output modes +* B/O/H/X - binary/octal/hex mode for i/o (both H and X are for hex) +* i/o - prefix for D/B/O/X - set only input/output modes * enter/= - evaluate current expr. * s/g - set/get a register * space - evaluate & save on list * l/v - list total/average * up/down/C-p/C-n - browse saved * C-delete - clear all saved @@ -1566,15 +1551,11 @@ Used by `calculator-paste' and `get-register'." (if (eq last-command 'calculator-help) (let ((mode-name "Calculator") (major-mode 'calculator-mode) - (g-map (current-global-map)) (win (selected-window))) (require 'ehelp) - (when calculator-electric-mode - (use-global-map calculator-saved-global-map)) - (if calculator-electric-mode - (electric-describe-mode) - (describe-mode)) - (when calculator-electric-mode (use-global-map g-map)) + (if (not calculator-electric-mode) + (describe-mode) + (electric-describe-mode)) (select-window win) (message nil)) (let ((one (one-window-p t)) diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index fff63d3b15c..36ebd2d8812 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -482,7 +482,9 @@ Usually just deletes the appointment buffer." (and window (or (eq window (frame-root-window (window-frame window))) (delete-window window)))) - (kill-buffer appt-buffer-name) + (let ((buffer (get-buffer appt-buffer-name))) + (when buffer + (kill-buffer buffer))) (if appt-audible (beep 1))) diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index acb6368beca..48221439e11 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -595,7 +595,7 @@ Hebrew date diary entries must be prefaced by `diary-hebrew-entry-symbol' of the Hebrew calendar entries, except that the Hebrew month names cannot be abbreviated. The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being -Adar II; you must use `Adar I' if you want Adar of a common +Adar II; you must use \"Adar I\" if you want Adar of a common Hebrew year. If a Hebrew date diary entry begins with `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index d2680828fe5..d7c9a6d9e95 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -33,7 +33,7 @@ (defun calendar-iso-to-absolute (date) "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. -The `ISO year' corresponds approximately to the Gregorian year, but +The \"ISO year\" corresponds approximately to the Gregorian year, but weeks start on Monday and end on Sunday. The first week of the ISO year is the first such week in which at least 4 days are in a year. The ISO commercial DATE has the form (week day year) in which week is in the range @@ -49,7 +49,7 @@ Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." ;;;###cal-autoload (defun calendar-iso-from-absolute (date) - "Compute the `ISO commercial date' corresponding to the absolute DATE. + "Compute the \"ISO commercial date\" corresponding to the absolute DATE. The ISO year corresponds approximately to the Gregorian year, but weeks start on Monday and end on Sunday. The first week of the ISO year is the first such week in which at least 4 days are in a year. The ISO commercial diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 4f2eb989010..c7729dc9429 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1710,8 +1710,8 @@ non-nil, means add to end of buffer without erasing current contents." (cal-tex-cmd "\\hspace*" space)) (defun cal-tex-comment (&optional comment) - "Insert `% ', followed by optional string COMMENT, followed by newline. -COMMENT may contain newlines, which are prefixed by `% ' in the output." + "Insert \"% \", followed by optional string COMMENT, followed by newline. +COMMENT may contain newlines, which are prefixed by \"% \" in the output." (insert (format "%% %s\n" (if comment (replace-regexp-in-string "\n" "\n% " comment) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 7a2b3fe1563..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. @@ -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 c88f4abcb6e..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. @@ -2389,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..ef7758df442 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 @@ -195,7 +202,7 @@ unknown are returned as nil." (time-minute 2digit) (time-second 2digit) (time-secfrac "\\(\\.[0-9]+\\)?") - (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute)) + (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) (time-offset (concat "Z" time-numoffset)) (partial-time (concat time-hour colon time-minute colon time-second time-secfrac)) @@ -204,19 +211,22 @@ unknown are returned as nil." (date-time (concat full-date "T" full-time))) (list (concat "^" full-date) (concat "T" partial-time) - (concat "Z" time-numoffset))) + (concat "\\(Z\\|" time-numoffset "\\)"))) "List of regular expressions matching ISO 8601 dates. 1st regular expression matches the date. 2nd regular expression matches the time. 3rd regular expression matches the (optional) timezone specification.") (defun parse-iso8601-time-string (date-string) + "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00. +If DATE-STRING cannot be parsed, it falls back to +`parse-time-string'." (let* ((date-re (nth 0 parse-time-iso8601-regexp)) (time-re (nth 1 parse-time-iso8601-regexp)) (tz-re (nth 2 parse-time-iso8601-regexp)) - re-start - time seconds minute hour fractional-seconds - day month year day-of-week dst tz) + re-start + time seconds minute hour fractional-seconds + day month year day-of-week dst tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -235,10 +245,19 @@ unknown are returned as nil." "0")) re-start (match-end 0)) (when (string-match tz-re date-string re-start) - (setq tz (match-string 1 date-string))) + (if (string= "Z" (match-string 1 date-string)) + (setq tz 0) ;; UTC timezone indicated by Z + (setq tz (+ + (* 3600 + (string-to-number (match-string 3 date-string))) + (* 60 + (string-to-number + (or (match-string 4 date-string) "0"))))) + (when (string= "-" (match-string 2 date-string)) + (setq tz (- tz))))) (setq time (list seconds minute hour day month year day-of-week dst tz)))) - ;; Fall back to having Gnus do fancy things for us. + ;; Fall back to having `parse-time-string' do fancy things for us. (when (not time) (setq time (parse-time-string date-string))) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index e92a4dc3f18..6fec8055319 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -65,10 +65,10 @@ and `am-pm' and `time-zone', both alphabetic strings. For example, the form - \\='(24-hours \":\" minutes + (24-hours \":\" minutes (if time-zone \" (\") time-zone (if time-zone \")\")) -would give military-style times like `21:07 (UTC)'." +would give military-style times like \"21:07 (UTC)\"." :type 'sexp :risky t :group 'calendar) 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/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/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 4f424313ab7..71e146880b1 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -31,7 +31,7 @@ ;; This library permits the setting of override functions for tasks of ;; that nature, and also provides reasonable defaults. ;; -;; There are buffer local variables, and frame local variables. +;; There are buffer local variables (and there were frame local variables). ;; This library gives the illusion of mode specific variables. ;; ;; You should use a mode-local variable or override to allow extension 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 6f41ba3064f..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." 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 a85b9024eb0..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,7 +332,7 @@ 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. (cl-generic-all-functions class))))) 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-global.el b/lisp/cedet/semantic/db-global.el index 03a21b0ee0d..4793c53f80d 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -47,7 +47,7 @@ in a GNU Global supported hierarchy. Two sanity checks are performed to assure (a) that GNU global program exists and (b) that the GNU global program version is compatibility with the database -version. If optional NOERROR is nil, then an error may be signalled on version +version. If optional NOERROR is nil, then an error may be signaled on version mismatch. If NOERROR is not nil, then no error will be signaled. Instead return value will indicate success or failure with non-nil or nil respective values." 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 923b0a38f85..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) 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 516a4f30414..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))) @@ -271,7 +275,7 @@ 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/grep.el b/lisp/cedet/semantic/symref/grep.el index 36e97da818d..b232e0fb619 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -81,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) 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/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/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-dep.el b/lisp/cus-dep.el index b31c60f98eb..90da4a8aa0e 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -33,7 +33,7 @@ ;; See finder-no-scan-regexp in finder.el. (defvar custom-dependencies-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|\ -ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" +ldefs-boot.*\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" "Regexp matching file names not to scan for `custom-make-dependencies'.") (require 'autoload) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 72f00b2f959..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) @@ -1165,7 +1159,7 @@ Show the buffer in another window, but don't select it." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "24.1" +(defvar customize-changed-options-previous-release "24.5" "Version for `customize-changed-options' to refer back to by default.") ;; Packages will update this variable, so make it available. @@ -1545,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. @@ -1623,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" diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a8bcc458649..08dfbdf0b32 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -248,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) @@ -314,6 +315,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Always" t) (repeat (symbol :tag "Parameter"))) "25.1") + (tooltip-reuse-hidden-frame tooltip boolean "26.1") ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; image.c 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/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/descr-text.el b/lisp/descr-text.el index 528820876ec..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))) diff --git a/lisp/desktop.el b/lisp/desktop.el index cc1001e5a15..a88d39a5e62 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 @@ -1236,8 +1237,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) @@ -1405,7 +1406,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))) @@ -1539,6 +1540,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* diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 204ee13006a..f94e0537aa6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -54,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. @@ -77,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)) @@ -87,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 @@ -279,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 @@ -729,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 @@ -890,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. @@ -901,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 @@ -959,11 +1012,13 @@ and `dired-compress-files-alist'." (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))))))) @@ -996,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 @@ -1019,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)) @@ -1742,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 @@ -2735,7 +2795,7 @@ REGEXP should use constructs supported by your local `grep' command." (lambda (s) (concat s "/")) 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) @@ -2785,7 +2845,7 @@ instead." ;; Local Variables: ;; byte-compile-dynamic: t -;; generated-autoload-file: "dired.el" +;; generated-autoload-file: "dired-loaddefs.el" ;; End: ;;; dired-aux.el ends here diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 67721d6e88a..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))) @@ -1054,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))) @@ -1372,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) @@ -1412,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. @@ -1455,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) @@ -1666,7 +1672,7 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." ;; Local Variables: ;; byte-compile-dynamic: t -;; generated-autoload-file: "dired.el" +;; generated-autoload-file: "dired-loaddefs.el" ;; End: ;;; dired-x.el ends here diff --git a/lisp/dired.el b/lisp/dired.el index 9836441b2e5..468060439b8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -34,6 +34,9 @@ ;;; Code: +;; When bootstrapping dired-loaddefs has not been generated. +(require 'dired-loaddefs nil t) + (declare-function dired-buffer-more-recently-used-p "dired-x" (buffer1 buffer2)) @@ -252,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 @@ -300,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 @@ -1535,6 +1550,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "u" 'dired-unmark) (define-key map "v" 'dired-view-file) (define-key map "w" 'dired-copy-filename-as-kill) + (define-key map "W" 'browse-url-of-dired-file) (define-key map "x" 'dired-do-flagged-delete) (define-key map "y" 'dired-show-file-type) (define-key map "+" 'dired-create-directory) @@ -2451,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 @@ -3296,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. @@ -3355,7 +3372,8 @@ object files--just `.o' will mark more than you might think." A prefix argument means to unmark them instead. `.' and `..' are never marked. -Note that if a file is visited in an Emacs buffer, this command will +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." @@ -3375,7 +3393,7 @@ since it was last visited." (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)) @@ -3916,583 +3934,6 @@ Ask means pop up a menu for the user to select one of copy, move or link." (add-to-list 'desktop-buffer-mode-handlers '(dired-mode . dired-restore-desktop-buffer)) - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "dired-aux" "dired-aux.el" "daa0a32a5bdfcf4de80c31cf7833b26d") -;;; Generated autoloads from dired-aux.el - -(autoload 'dired-diff "dired-aux" "\ -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'. - -With prefix arg, prompt for second argument SWITCHES, which is -the string of command switches for the third argument of `diff'. - -\(fn FILE &optional SWITCHES)" t nil) - -(autoload 'dired-backup-diff "dired-aux" "\ -Diff this file with its backup file or vice versa. -Uses the latest backup, if there are several numerical backups. -If this file is a backup, diff it with its original. -The backup file is the first file given to `diff'. -With prefix arg, prompt for argument SWITCHES which is options for `diff'. - -\(fn &optional SWITCHES)" t nil) - -(autoload 'dired-compare-directories "dired-aux" "\ -Mark files with different file attributes in two dired buffers. -Compare file attributes of files in the current directory -with file attributes in directory DIR2 using PREDICATE on pairs of files -with the same name. Mark files for which PREDICATE returns non-nil. -Mark files with different names if PREDICATE is nil (or interactively -with empty input at the predicate prompt). - -PREDICATE is a Lisp expression that can refer to the following variables: - - size1, size2 - file size in bytes - mtime1, mtime2 - last modification time in seconds, as a float - fa1, fa2 - list of file attributes - returned by function `file-attributes' - - where 1 refers to attribute of file in the current dired buffer - and 2 to attribute of file in second dired buffer. - -Examples of PREDICATE: - - (> mtime1 mtime2) - mark newer files - (not (= size1 size2)) - mark files with different sizes - (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes - (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID - (= (nth 3 fa1) (nth 3 fa2)))) and GID. - -\(fn DIR2 PREDICATE)" t nil) - -(autoload 'dired-do-chmod "dired-aux" "\ -Change the mode of the marked (or next ARG) files. -Symbolic modes like `g+w' are allowed. -Type M-n to pull the file attributes of the file at point -into the minibuffer. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-chgrp "dired-aux" "\ -Change the group of the marked (or next ARG) files. -Type M-n to pull the file attributes of the file at point -into the minibuffer. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-chown "dired-aux" "\ -Change the owner of the marked (or next ARG) files. -Type M-n to pull the file attributes of the file at point -into the minibuffer. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-touch "dired-aux" "\ -Change the timestamp of the marked (or next ARG) files. -This calls touch. -Type M-n to pull the file attributes of the file at point -into the minibuffer. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-print "dired-aux" "\ -Print the marked (or next ARG) files. -Uses the shell command coming from variables `lpr-command' and -`lpr-switches' as default. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-clean-directory "dired-aux" "\ -Flag numerical backups for deletion. -Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. -Positive prefix arg KEEP overrides `dired-kept-versions'; -Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive. - -To clear the flags on these files, you can use \\[dired-flag-backup-files] -with a prefix argument. - -\(fn KEEP)" t nil) - -(autoload 'dired-do-async-shell-command "dired-aux" "\ -Run a shell command COMMAND on the marked files asynchronously. - -Like `dired-do-shell-command', but adds `&' at the end of COMMAND -to execute it asynchronously. - -When operating on multiple files, asynchronous commands -are executed in the background on each file in parallel. -In shell syntax this means separating the individual commands -with `&'. However, when COMMAND ends in `;' or `;&' then commands -are executed in the background on each file sequentially waiting -for each command to terminate before running the next command. -In shell syntax this means separating the individual commands with `;'. - -The output appears in the buffer `*Async Shell Command*'. - -\(fn COMMAND &optional ARG FILE-LIST)" t nil) - -(autoload 'dired-do-shell-command "dired-aux" "\ -Run a shell command COMMAND on the marked files. -If no files are marked or a numeric prefix arg is given, -the next ARG files are used. Just \\[universal-argument] means the current file. -The prompt mentions the file(s) or the marker, as appropriate. - -If there is a `*' in COMMAND, surrounded by whitespace, this runs -COMMAND just once with the entire file list substituted there. - -If there is no `*', but there is a `?' in COMMAND, surrounded by -whitespace, this runs COMMAND on each file individually with the -file name substituted for `?'. - -Otherwise, this runs COMMAND on each file individually with the -file name added at the end of COMMAND (separated by a space). - -`*' and `?' when not surrounded by whitespace have no special -significance for `dired-do-shell-command', and are passed through -normally to the shell, but you must confirm first. - -If you want to use `*' as a shell wildcard with whitespace around -it, write `*\"\"' in place of just `*'. This is equivalent to just -`*' in the shell, but avoids Dired's special handling. - -If COMMAND ends in `&', `;', or `;&', it is executed in the -background asynchronously, and the output appears in the buffer -`*Async Shell Command*'. When operating on multiple files and COMMAND -ends in `&', the shell command is executed on each file in parallel. -However, when COMMAND ends in `;' or `;&' then commands are executed -in the background on each file sequentially waiting for each command -to terminate before running the next command. You can also use -`dired-do-async-shell-command' that automatically adds `&'. - -Otherwise, COMMAND is executed synchronously, and the output -appears in the buffer `*Shell Command Output*'. - -This feature does not try to redisplay Dired buffers afterward, as -there's no telling what files COMMAND may have changed. -Type \\[dired-do-redisplay] to redisplay the marked files. - -When COMMAND runs, its working directory is the top-level directory -of the Dired buffer, so output files usually are created there -instead of in a subdir. - -In a noninteractive call (from Lisp code), you must specify -the list of file names explicitly with the FILE-LIST argument, which -can be produced by `dired-get-marked-files', for example. - -\(fn COMMAND &optional ARG FILE-LIST)" t nil) - -(autoload 'dired-run-shell-command "dired-aux" "\ - - -\(fn COMMAND)" nil nil) - -(autoload 'dired-do-kill-lines "dired-aux" "\ -Kill all marked lines (not the files). -With a prefix argument, kill that many lines starting with the current line. -\(A negative argument kills backward.) -If you use this command with a prefix argument to kill the line -for a file that is a directory, which you have inserted in the -Dired buffer as a subdirectory, then it deletes that subdirectory -from the buffer as well. -To kill an entire subdirectory (without killing its line in the -parent directory), go to its directory header line and use this -command with a prefix argument (the value does not matter). - -\(fn &optional ARG FMT)" t nil) - -(autoload 'dired-do-compress-to "dired-aux" "\ -Compress selected files and directories to an archive. -Prompt for the archive file name. -Choose the archiving command based on the archive file-name extension -and `dired-compress-files-alist'. - -\(fn)" t nil) - -(autoload 'dired-compress-file "dired-aux" "\ -Compress or uncompress FILE. -Return the name of the compressed or uncompressed file. -Return nil if no change in files. - -\(fn FILE)" nil nil) - -(autoload 'dired-query "dired-aux" "\ -Format PROMPT with ARGS, query user, and store the result in SYM. -The return value is either nil or t. - -The user may type y or SPC to accept once; n or DEL to skip once; -! to accept this and subsequent queries; or q or ESC to decline -this and subsequent queries. - -If SYM is already bound to a non-nil value, this function may -return automatically without querying the user. If SYM is !, -return t; if SYM is q or ESC, return nil. - -\(fn SYM PROMPT &rest ARGS)" nil nil) - -(autoload 'dired-do-compress "dired-aux" "\ -Compress or uncompress marked (or next ARG) files. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-byte-compile "dired-aux" "\ -Byte compile marked (or next ARG) Emacs Lisp files. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-load "dired-aux" "\ -Load the marked (or next ARG) Emacs Lisp files. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-redisplay "dired-aux" "\ -Redisplay all marked (or next ARG) files. -If on a subdir line, redisplay that subdirectory. In that case, -a prefix arg lets you edit the `ls' switches used for the new listing. - -Dired remembers switches specified with a prefix arg, so that reverting -the buffer will not reset them. However, using `dired-undo' to re-insert -or delete subdirectories can bypass this machinery. Hence, you sometimes -may have to reset some subdirectory switches after a `dired-undo'. -You can reset all subdirectory switches to the default using -\\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs)Subdir switches' for more details. - -\(fn &optional ARG TEST-FOR-SUBDIR)" t nil) - -(autoload 'dired-add-file "dired-aux" "\ - - -\(fn FILENAME &optional MARKER-CHAR)" nil nil) - -(autoload 'dired-remove-file "dired-aux" "\ - - -\(fn FILE)" nil nil) - -(autoload 'dired-relist-file "dired-aux" "\ -Create or update the line for FILE in all Dired buffers it would belong in. - -\(fn FILE)" nil nil) - -(autoload 'dired-copy-file "dired-aux" "\ - - -\(fn FROM TO OK-FLAG)" nil nil) - -(autoload 'dired-rename-file "dired-aux" "\ - - -\(fn FILE NEWNAME OK-IF-ALREADY-EXISTS)" nil nil) - -(autoload 'dired-create-directory "dired-aux" "\ -Create a directory called DIRECTORY. -If DIRECTORY already exists, signal an error. - -\(fn DIRECTORY)" t nil) - -(autoload 'dired-do-copy "dired-aux" "\ -Copy all marked (or next ARG) files, or copy the current file. -When operating on just the current file, prompt for the new name. - -When operating on multiple or marked files, prompt for a target -directory, and make the new copies in that directory, with the -same names as the original files. The initial suggestion for the -target directory is the Dired buffer's current directory (or, if -`dired-dwim-target' is non-nil, the current directory of a -neighboring Dired window). - -If `dired-copy-preserve-time' is non-nil, this command preserves -the modification time of each old file in the copy, similar to -the \"-p\" option for the \"cp\" shell command. - -This command copies symbolic links by creating new ones, similar -to the \"-d\" option for the \"cp\" shell command. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-symlink "dired-aux" "\ -Make symbolic links to current file or all marked (or next ARG) files. -When operating on just the current file, you specify the new name. -When operating on multiple or marked files, you specify a directory -and new symbolic links are made in that directory -with the same names that the files currently have. The default -suggested for the target directory depends on the value of -`dired-dwim-target', which see. - -For relative symlinks, use \\[dired-do-relsymlink]. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-hardlink "dired-aux" "\ -Add names (hard links) current file or all marked (or next ARG) files. -When operating on just the current file, you specify the new name. -When operating on multiple or marked files, you specify a directory -and new hard links are made in that directory -with the same names that the files currently have. The default -suggested for the target directory depends on the value of -`dired-dwim-target', which see. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-rename "dired-aux" "\ -Rename current file or all marked (or next ARG) files. -When renaming just the current file, you specify the new name. -When renaming multiple or marked files, you specify a directory. -This command also renames any buffers that are visiting the files. -The default suggested for the target directory depends on the value -of `dired-dwim-target', which see. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-do-rename-regexp "dired-aux" "\ -Rename selected files whose names match REGEXP to NEWNAME. - -With non-zero prefix argument ARG, the command operates on the next ARG -files. Otherwise, it operates on all the marked files, or the current -file if none are marked. - -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. -NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'. -REGEXP defaults to the last regexp used. - -With a zero prefix arg, renaming by regexp affects the absolute file name. -Normally, only the non-directory part of the file name is used and changed. - -\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) - -(autoload 'dired-do-copy-regexp "dired-aux" "\ -Copy selected files whose names match REGEXP to NEWNAME. -See function `dired-do-rename-regexp' for more info. - -\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) - -(autoload 'dired-do-hardlink-regexp "dired-aux" "\ -Hardlink selected files whose names match REGEXP to NEWNAME. -See function `dired-do-rename-regexp' for more info. - -\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) - -(autoload 'dired-do-symlink-regexp "dired-aux" "\ -Symlink selected files whose names match REGEXP to NEWNAME. -See function `dired-do-rename-regexp' for more info. - -\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil) - -(autoload 'dired-upcase "dired-aux" "\ -Rename all marked (or next ARG) files to upper case. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-downcase "dired-aux" "\ -Rename all marked (or next ARG) files to lower case. - -\(fn &optional ARG)" t nil) - -(autoload 'dired-maybe-insert-subdir "dired-aux" "\ -Insert this subdirectory into the same dired buffer. -If it is already present, just move to it (type \\[dired-do-redisplay] to refresh), - else inserts it at its natural place (as `ls -lR' would have done). -With a prefix arg, you may edit the ls switches used for this listing. - You can add `R' to the switches to expand the whole tree starting at - this subdirectory. -This function takes some pains to conform to `ls -lR' output. - -Dired remembers switches specified with a prefix arg, so that reverting -the buffer will not reset them. However, using `dired-undo' to re-insert -or delete subdirectories can bypass this machinery. Hence, you sometimes -may have to reset some subdirectory switches after a `dired-undo'. -You can reset all subdirectory switches to the default using -\\<dired-mode-map>\\[dired-reset-subdir-switches]. -See Info node `(emacs)Subdir switches' for more details. - -\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) - -(autoload 'dired-insert-subdir "dired-aux" "\ -Insert this subdirectory into the same Dired buffer. -If it is already present, overwrite the previous entry; - otherwise, insert it at its natural place (as `ls -lR' would - have done). -With a prefix arg, you may edit the `ls' switches used for this listing. - You can add `R' to the switches to expand the whole tree starting at - this subdirectory. -This function takes some pains to conform to `ls -lR' output. - -\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) - -(autoload 'dired-prev-subdir "dired-aux" "\ -Go to previous subdirectory, regardless of level. -When called interactively and not on a subdir line, go to this subdir's line. - -\(fn ARG &optional NO-ERROR-IF-NOT-FOUND NO-SKIP)" t nil) - -(autoload 'dired-goto-subdir "dired-aux" "\ -Go to end of header line of DIR in this dired buffer. -Return value of point on success, otherwise return nil. -The next char is either \\n, or \\r if DIR is hidden. - -\(fn DIR)" t nil) - -(autoload 'dired-mark-subdir-files "dired-aux" "\ -Mark all files except `.' and `..' in current subdirectory. -If the Dired buffer shows multiple directories, this command -marks the files listed in the subdirectory that point is in. - -\(fn)" t nil) - -(autoload 'dired-kill-subdir "dired-aux" "\ -Remove all lines of current subdirectory. -Lower levels are unaffected. - -\(fn &optional REMEMBER-MARKS)" t nil) - -(autoload 'dired-tree-up "dired-aux" "\ -Go up ARG levels in the dired tree. - -\(fn ARG)" t nil) - -(autoload 'dired-tree-down "dired-aux" "\ -Go down in the dired tree. - -\(fn)" t nil) - -(autoload 'dired-hide-subdir "dired-aux" "\ -Hide or unhide the current subdirectory and move to next directory. -Optional prefix arg is a repeat factor. -Use \\[dired-hide-all] to (un)hide all directories. - -\(fn ARG)" t nil) - -(autoload 'dired-hide-all "dired-aux" "\ -Hide all subdirectories, leaving only their header lines. -If there is already something hidden, make everything visible again. -Use \\[dired-hide-subdir] to (un)hide a particular subdirectory. - -\(fn &optional IGNORED)" t nil) - -(autoload 'dired-isearch-filenames-setup "dired-aux" "\ -Set up isearch to search in Dired file names. -Intended to be added to `isearch-mode-hook'. - -\(fn)" nil nil) - -(autoload 'dired-isearch-filenames "dired-aux" "\ -Search for a string using Isearch only in file names in the Dired buffer. - -\(fn)" t nil) - -(autoload 'dired-isearch-filenames-regexp "dired-aux" "\ -Search for a regexp using Isearch only in file names in the Dired buffer. - -\(fn)" t nil) - -(autoload 'dired-do-isearch "dired-aux" "\ -Search for a string through all marked files using Isearch. - -\(fn)" t nil) - -(autoload 'dired-do-isearch-regexp "dired-aux" "\ -Search for a regexp through all marked files using Isearch. - -\(fn)" t nil) - -(autoload 'dired-do-search "dired-aux" "\ -Search through all marked files for a match for REGEXP. -Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. - -\(fn REGEXP)" t nil) - -(autoload 'dired-do-query-replace-regexp "dired-aux" "\ -Do `query-replace-regexp' of FROM with TO, on all marked files. -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]. - -\(fn FROM TO &optional DELIMITED)" t nil) - -(autoload 'dired-do-find-regexp "dired-aux" "\ -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. - -\(fn REGEXP)" t nil) - -(autoload 'dired-do-find-regexp-and-replace "dired-aux" "\ -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. - -\(fn FROM TO)" t nil) - -(autoload 'dired-show-file-type "dired-aux" "\ -Print the type of FILE, according to the `file' command. -If you give a prefix to this command, and FILE is a symbolic -link, then the type of the file linked to by FILE is printed -instead. - -\(fn FILE &optional DEREF-SYMLINKS)" t nil) - -;;;*** - -;;;### (autoloads nil "dired-x" "dired-x.el" "d9ad5b70efdb3d840b8248d4043563b5") -;;; Generated autoloads from dired-x.el - -(autoload 'dired-jump "dired-x" "\ -Jump to Dired buffer corresponding to current buffer. -If in a file, Dired the current directory and move to file's line. -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. - -\(fn &optional OTHER-WINDOW FILE-NAME)" t nil) - -(autoload 'dired-jump-other-window "dired-x" "\ -Like \\[dired-jump] (`dired-jump') but in other window. - -\(fn &optional FILE-NAME)" t nil) - -(autoload 'dired-do-relsymlink "dired-x" "\ -Relative symlink all marked (or next ARG) files into a directory. -Otherwise make a relative symbolic link to the current file. -This creates relative symbolic links like - - foo -> ../bar/foo - -not absolute ones like - - foo -> /ugly/file/name/that/may/change/any/day/bar/foo - -For absolute symlinks, use \\[dired-do-symlink]. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;; End of automatically extracted autoloads. - (provide 'dired) (run-hooks 'dired-load-hook) ; for your customizations 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/gnus/ecomplete.el b/lisp/ecomplete.el index 084895c32a5..b9f4b1ab846 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/ecomplete.el @@ -27,17 +27,12 @@ (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. - (require 'edmacro))) - (defgroup ecomplete nil "Electric completion of email addresses and the like." :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) @@ -60,11 +55,7 @@ (defun ecomplete-add-item (type key text) (let ((elems (assq type ecomplete-database)) - (now (string-to-number - (format "%.0f" (if (featurep 'emacs) - (float-time) - (require 'gnus-util) - (gnus-float-time))))) + (now (string-to-number (format "%.0f" (float-time)))) entry) (unless elems (push (setq elems (list type)) ecomplete-database)) 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 ab9770b0bbb..3e48737e3ac 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -425,6 +425,19 @@ 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" @@ -451,26 +464,28 @@ This requotes when a quoting key is typed." (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 ((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 ?“)) - ((search-backward "`" (1- (point)) t) - (replace-match "‘") - (setq last-command-event ?‘))) - (cond ((search-backward "’'" (- (point) 2) t) - (replace-match "”") - (setq last-command-event ?”)) - ((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) @@ -481,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..b621ac507da 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. @@ -2830,7 +2830,7 @@ advised definition from scratch." (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) (advice-remove function advicefunname) - (fset advicefunname old-advice) + (if advicefunname (fset advicefunname old-advice)) (if old-advice (advice-add function :around advicefunname))))) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 883a38a4884..1292ea992d3 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -87,6 +87,29 @@ 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 +if we need to rescan an input file. If you set this to nil, +then we use the timestamp of the output file instead. As a result: + - for fixed inputs, the output will be the same every time + - incremental updates of the output file might not be correct if: + i) the timestamp of the output file cannot be trusted (at least + relative to that of the input files) + ii) any of the input files can be modified during the time it takes + to create the output + iii) only a subset of the input files are scanned + These issues are unlikely to happen in practice, and would arguably + represent bugs in the build system. Item iii) will happen if you + use a command like `update-file-autoloads', though, since it only + checks a single input file.") + (defvar autoload-modified-buffers) ;Dynamically scoped var. (defun make-autoload (form file &optional expansion) @@ -160,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)))) @@ -179,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)))) @@ -234,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 @@ -277,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 @@ -357,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) @@ -434,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))) @@ -450,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 @@ -529,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 @@ -578,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. @@ -624,7 +848,9 @@ FILE's modification time." ;; We'd really want to just use ;; `emacs-internal' instead. nil nil 'emacs-mule-unix) - (nth 5 (file-attributes relfile)))) + (if autoload-timestamps + (nth 5 (file-attributes relfile)) + autoload--non-timestamp))) (insert ";;; Generated autoloads from " relfile "\n"))) (insert generate-autoload-section-trailer)))) (or noninteractive @@ -655,6 +881,8 @@ FILE's modification time." (let ((version-control 'never)) (save-buffer))))) +;; FIXME This command should be deprecated. +;; See http://debbugs.gnu.org/22213#41 ;;;###autoload (defun update-file-autoloads (file &optional save-after outfile) "Update the autoloads for FILE. @@ -672,6 +900,9 @@ Return FILE if there was no autoload cookie in it, else nil." (read-file-name "Write autoload definitions to file: "))) (let* ((generated-autoload-file (or outfile generated-autoload-file)) (autoload-modified-buffers nil) + ;; We need this only if the output file handles more than one input. + ;; See http://debbugs.gnu.org/22213#38 and subsequent. + (autoload-timestamps t) (no-autoloads (autoload-generate-file-autoloads file))) (if autoload-modified-buffers (if save-after (autoload-save-buffers)) @@ -689,6 +920,9 @@ removes any prior now out-of-date autoload entries." (catch 'up-to-date (let* ((buf (current-buffer)) (existing-buffer (if buffer-file-name buf)) + (output-file (autoload-generated-file)) + (output-time (if (file-exists-p output-file) + (nth 5 (file-attributes output-file)))) (found nil)) (with-current-buffer (autoload-find-generated-file) ;; This is to make generated-autoload-file have Unix EOLs, so @@ -713,16 +947,28 @@ removes any prior now out-of-date autoload entries." (file-time (nth 5 (file-attributes file)))) (if (and (or (null existing-buffer) (not (buffer-modified-p existing-buffer))) - (or + (cond + ;; FIXME? Arguably we should throw a + ;; user error, or some kind of warning, + ;; if we were called from update-file-autoloads, + ;; which can update only a single input file. + ;; It's not appropriate to use the output + ;; file modtime in such a case, + ;; if there are multiple input files + ;; contributing to the output. + ((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. - (and (listp last-time) - (not (time-less-p last-time file-time))) + ((listp last-time) + (not (time-less-p last-time file-time))) ;; last-time is an MD5 checksum instead. - (and (stringp last-time) - (equal last-time - (md5 buf nil nil 'emacs-mule))))) + ((stringp last-time) + (equal last-time + (md5 buf nil nil 'emacs-mule))))) (throw 'up-to-date nil) (autoload-remove-section begin) (setq found t)))) @@ -773,12 +1019,13 @@ write its autoloads into the specified file instead." (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. @@ -787,13 +1034,16 @@ write its autoloads into the specified file instead." (generated-autoload-file (if (called-interactively-p 'interactive) (read-file-name "Write autoload definitions to file: ") - generated-autoload-file))) + generated-autoload-file)) + (output-time + (if (file-exists-p generated-autoload-file) + (nth 5 (file-attributes generated-autoload-file))))) (with-current-buffer (autoload-find-generated-file) (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) @@ -805,28 +1055,33 @@ write its autoloads into the specified file instead." ;; Remove the obsolete section. (autoload-remove-section (match-beginning 0)) (setq last-time (nth 4 form)) - (when (listp last-time) - (dolist (file file) - (let ((file-time (nth 5 (file-attributes file)))) - (when (and file-time - (not (time-less-p last-time file-time))) - ;; file unchanged - (push file no-autoloads) - (setq files (delete file files))))))) + (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)))) + (when (and file-time + (not (time-less-p last-time file-time))) + ;; file unchanged + (push file no-autoloads) + (setq files (delete file files)))))) ((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))) - ((and (listp (nth 4 form)) - (not (time-less-p (nth 4 form) - (nth 5 (file-attributes file))))) + ((not (time-less-p (let ((oldtime (nth 4 form))) + (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. @@ -838,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. @@ -846,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. @@ -855,11 +1110,18 @@ write its autoloads into the specified file instead." (goto-char (point-max)) (search-backward "\f" nil t) (autoload-insert-section-header - (current-buffer) nil nil no-autoloads no-autoloads-time) + (current-buffer) nil nil no-autoloads (if autoload-timestamps + no-autoloads-time + 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)))) @@ -891,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 818c2683463..e680ebbdc58 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -240,6 +240,11 @@ The return value is undefined. ;; from ;; (defun foo (arg) (toto)). (declare (doc-string 3) (indent 2)) + (or name (error "Cannot define '%s' as a function" name)) + (if (null + (and (listp arglist) + (null (delq t (mapcar #'symbolp arglist))))) + (error "Malformed arglist: %s" arglist)) (let ((decls (cond ((eq (car-safe docstring) 'declare) (prog1 (cdr docstring) (setq docstring nil))) @@ -469,7 +474,7 @@ load time. In interpreted code, this is entirely equivalent to `progn', except that the value of the expression may be (but is not necessarily) computed at load time if eager macro expansion is enabled." - (declare (debug t) (indent 0)) + (declare (debug (&rest def-form)) (indent 0)) ;; When the byte-compiler expands code, this macro is not used, so we're ;; either about to run `body' (plain interpretation) or we're doing eager ;; macroexpansion. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1526e2fdeb9..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)) @@ -1360,31 +1369,33 @@ extra args." (dolist (elt '(format message error)) (put elt 'byte-compile-format-like t)) -;; Warn if a custom definition fails to specify :group. +;; Warn if a custom definition fails to specify :group, or :type. (defun byte-compile-nogroup-warn (form) - (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) - byte-compile-current-group) - ;; The group will be provided implicitly. - nil - (let ((keyword-args (cdr (cdr (cdr (cdr form))))) - (name (cadr form))) - (or (not (eq (car-safe name) 'quote)) - (and (eq (car form) 'custom-declare-group) - (equal name ''emacs)) - (plist-get keyword-args :group) - (not (and (consp name) (eq (car name) 'quote))) - (byte-compile-warn - "%s for `%s' fails to specify containing group" - (cdr (assq (car form) - '((custom-declare-group . defgroup) - (custom-declare-face . defface) - (custom-declare-variable . defcustom)))) - (cadr name))) - ;; Update the current group, if needed. - (if (and byte-compile-current-file ;Only when compiling a whole file. - (eq (car form) 'custom-declare-group) - (eq (car-safe name) 'quote)) - (setq byte-compile-current-group (cadr name)))))) + (let ((keyword-args (cdr (cdr (cdr (cdr form))))) + (name (cadr form))) + (when (eq (car-safe name) 'quote) + (or (not (eq (car form) 'custom-declare-variable)) + (plist-get keyword-args :type) + (byte-compile-warn + "defcustom for `%s' fails to specify type" (cadr name))) + (if (and (memq (car form) '(custom-declare-face custom-declare-variable)) + byte-compile-current-group) + ;; The group will be provided implicitly. + nil + (or (and (eq (car form) 'custom-declare-group) + (equal name ''emacs)) + (plist-get keyword-args :group) + (byte-compile-warn + "%s for `%s' fails to specify containing group" + (cdr (assq (car form) + '((custom-declare-group . defgroup) + (custom-declare-face . defface) + (custom-declare-variable . defcustom)))) + (cadr name))) + ;; Update the current group, if needed. + (if (and byte-compile-current-file ;Only when compiling a whole file. + (eq (car form) 'custom-declare-group)) + (setq byte-compile-current-group (cadr name))))))) ;; Warn if the function or macro is being redefined with a different ;; number of arguments. @@ -1881,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) @@ -2580,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 @@ -2593,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) @@ -2654,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 @@ -2957,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 @@ -3015,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) @@ -3034,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) @@ -3133,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. @@ -3745,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)) @@ -4018,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 fd8f108a54e..55978ddd384 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -294,12 +294,6 @@ problem discovered. This is useful for adding additional checks.") (defvar checkdoc-diagnostic-buffer "*Style Warnings*" "Name of warning message buffer.") -(defvar checkdoc-defun-regexp - "^(def\\(un\\|var\\|custom\\|macro\\|const\\|subst\\|advice\\)\ -\\s-+\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]+" - "Regular expression used to identify a defun. -A search leaves the cursor in front of the parameter list.") - (defcustom checkdoc-verb-check-experimental-flag t "Non-nil means to attempt to check the voice of the doc string. This check keys off some words which are commonly misused. See the @@ -938,13 +932,31 @@ is the starting location. If this is nil, `point-min' is used instead." (defun checkdoc-next-docstring () "Move to the next doc string after point, and return t. Return nil if there are no more doc strings." - (if (not (re-search-forward checkdoc-defun-regexp nil t)) - nil - ;; search drops us after the identifier. The next sexp is either - ;; the argument list or the value of the variable. skip it. - (forward-sexp 1) - (skip-chars-forward " \n\t") - t)) + (let (found) + (while (and (not (setq found (checkdoc--next-docstring))) + (beginning-of-defun -1))) + found)) + +(defun checkdoc--next-docstring () + "When looking at a definition with a doc string, find it. +Move to the next doc string after point, and return t. When not +looking at a definition containing a doc string, return nil and +don't move point." + (pcase (save-excursion (condition-case nil + (read (current-buffer)) + ;; Conservatively skip syntax errors. + (invalid-read-syntax))) + (`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice) + ,(pred symbolp) + ;; Require an initializer, i.e. ignore single-argument `defvar' + ;; forms, which never have a doc string. + ,_ . ,_) + (down-list) + ;; Skip over function or macro name, symbol to be defined, and + ;; initializer or argument list. + (forward-sexp 3) + (skip-chars-forward " \n\t") + t))) ;;;###autoload (defun checkdoc-comments (&optional take-notes) @@ -1027,21 +1039,12 @@ space at the end of each line." (interactive) (save-excursion (beginning-of-defun) - (if (not (looking-at checkdoc-defun-regexp)) - ;; I found this more annoying than useful. - ;;(if (not no-error) - ;; (message "Cannot check this sexp's doc string.")) - nil - ;; search drops us after the identifier. The next sexp is either - ;; the argument list or the value of the variable. skip it. - (goto-char (match-end 0)) - (forward-sexp 1) - (skip-chars-forward " \n\t") + (when (checkdoc--next-docstring) (let* ((checkdoc-spellcheck-documentation-flag - (car (memq checkdoc-spellcheck-documentation-flag + (car (memq checkdoc-spellcheck-documentation-flag '(defun t)))) - (beg (save-excursion (beginning-of-defun) (point))) - (end (save-excursion (end-of-defun) (point)))) + (beg (save-excursion (beginning-of-defun) (point))) + (end (save-excursion (end-of-defun) (point)))) (dolist (fun (list #'checkdoc-this-string-valid (lambda () (checkdoc-message-text-search beg end)) (lambda () (checkdoc-rogue-space-check-engine beg end)))) @@ -1049,8 +1052,8 @@ space at the end of each line." (if msg (if no-error (message "%s" (checkdoc-error-text msg)) (user-error "%s" (checkdoc-error-text msg)))))) - (if (called-interactively-p 'interactive) - (message "Checkdoc: done.")))))) + (if (called-interactively-p 'interactive) + (message "Checkdoc: done.")))))) ;;; Ispell interface for forcing a spell check ;; @@ -1062,7 +1065,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 +1074,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 +1083,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 +1102,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 +1111,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 +1120,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 +1129,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 +1138,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 ;; @@ -1638,6 +1641,17 @@ function,command,variable,option or symbol." ms1)))))) ;; * If a user option variable records a true-or-false ;; condition, give it a name that ends in `-flag'. + ;; "True ..." should be "Non-nil ..." + (when (looking-at "\"\\*?\\(True\\)\\b") + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (match-end 1) + "Say \"Non-nil\" instead of \"True\"? " + "Non-nil") + nil + (checkdoc-create-error + "\"True\" should usually be \"Non-nil\"" + (match-beginning 1) (match-end 1)))) + ;; If the variable has -flag in the name, make sure (if (and (string-match "-flag$" (car fp)) (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+"))) @@ -1798,6 +1812,16 @@ Replace with \"%s\"? " original replace) "Probably \"%s\" should be imperative \"%s\"" original replace) (match-beginning 1) (match-end 1)))))) + ;; "Return true ..." should be "Return non-nil ..." + (when (looking-at "\"Return \\(true\\)\\b") + (if (checkdoc-autofix-ask-replace + (match-beginning 1) (match-end 1) + "Say \"non-nil\" instead of \"true\"? " + "non-nil") + nil + (checkdoc-create-error + "\"true\" should usually be \"non-nil\"" + (match-beginning 1) (match-end 1)))) ;; Done with functions ))) ;;* When a documentation string refers to a Lisp symbol, write it as diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 8bf0675f54b..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) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 4f263c6bb8d..61186e1a881 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -358,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) @@ -375,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) @@ -415,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))))) @@ -428,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* @@ -468,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)? @@ -750,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))) @@ -854,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)))) @@ -922,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 `")) @@ -1007,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)) @@ -1027,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)) @@ -1082,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 @@ -1126,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 @@ -1164,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 b3a60b1b225..5e6388af057 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -923,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 @@ -1837,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. @@ -2113,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)) @@ -2557,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) @@ -2634,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))) @@ -2698,7 +2719,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) @@ -2708,8 +2729,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 @@ -2719,7 +2744,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))) @@ -3003,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-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/debug.el b/lisp/emacs-lisp/debug.el index 22a3f3935f2..5a4b0970326 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -274,13 +274,14 @@ That buffer should be current already." (let ((standard-output (current-buffer)) (print-escape-newlines t) (print-level 8) - (print-length 50)) - (backtrace)) + (print-length 50)) + ;; FIXME the debugger could pass a custom callback to mapbacktrace + ;; instead of manipulating printed results. + (mapbacktrace #'backtrace--print-frame 'debug)) (goto-char (point-min)) (delete-region (point) (progn - (search-forward "\n debug(") - (forward-line (if (eq (car args) 'debug) + (forward-line (if (eq (car args) 'debug) ;; Remove debug--implement-debug-on-entry ;; and the advice's `apply' frame. 3 @@ -304,6 +305,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 +867,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..31170270f5c 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 @@ -212,16 +217,17 @@ No problems result if this variable is not bound. ,(if declare-syntax `(progn (unless (boundp ',syntax) - (put ',syntax 'definition-name ',child)) - (defvar ,syntax (make-syntax-table)) + (put ',syntax 'definition-name ',child) + (defvar ,syntax (make-syntax-table))) (unless (get ',syntax 'variable-documentation) (put ',syntax 'variable-documentation (purecopy ,(format "Syntax table for `%s'." child)))))) ,(if declare-abbrev `(progn - (put ',abbrev 'definition-name ',child) - (defvar ,abbrev - (progn (define-abbrev-table ',abbrev nil) ,abbrev)) + (unless (boundp ',abbrev) + (put ',abbrev 'definition-name ',child) + (defvar ,abbrev + (progn (define-abbrev-table ',abbrev nil) ,abbrev))) (unless (get ',abbrev 'variable-documentation) (put ',abbrev 'variable-documentation (purecopy ,(format "Abbrev table for `%s'." child)))))) @@ -272,7 +278,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 +354,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/edebug.el b/lisp/emacs-lisp/edebug.el index e8484fa1f94..04a493c826f 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 @@ -2163,8 +2170,7 @@ The purpose of this function is so you can properly undo subsequent changes to the same binding, by passing the status cons cell to `edebug-restore-status'. The status cons cell has the form (LOCUS . VALUE), where LOCUS can be a buffer -\(for a buffer-local binding), a frame (for a frame-local binding), -or nil (if the default binding is current)." +\(for a buffer-local binding), or nil (if the default binding is current)." (cons (variable-binding-locus var) (symbol-value var))) @@ -2356,7 +2362,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 +2495,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 +3797,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 6aba8a3acbd..413b94f01a8 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -266,7 +266,7 @@ Summary: ;; Local Variables: -;; generated-autoload-file: "eieio-core.el" +;; generated-autoload-file: "eieio-loaddefs.el" ;; End: (provide 'eieio-compat) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5454dfcbbc4..624dccef075 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -33,6 +33,7 @@ (require 'cl-lib) (require 'pcase) +(require 'eieio-loaddefs) ;;; ;; A few functions that are better in the official EIEIO src, but @@ -756,9 +757,7 @@ Argument FN is the function calling this verifier." ;; The slot-missing method is a cool way of allowing an object author ;; to intercept missing slot definitions. Since it is also the LAST ;; thing called in this fn, its return value would be retrieved. - (slot-missing obj slot 'oref) - ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) - ) + (slot-missing obj slot 'oref)) (cl-check-type obj eieio-object) (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref)))) @@ -780,9 +779,7 @@ Fills in OBJ's SLOT with its default value." ;; Oref that slot. (aref (eieio--class-class-allocation-values cl) c) - (slot-missing obj slot 'oref-default) - ;;(signal 'invalid-slot-name (list (class-name cl) slot)) - ) + (slot-missing obj slot 'oref-default)) (eieio-barf-if-slot-unbound (let ((val (cl--slot-descriptor-initform (aref (eieio--class-slots cl) @@ -822,9 +819,7 @@ Fills in OBJ's SLOT with VALUE." (aset (eieio--class-class-allocation-values class) c value)) ;; See oref for comment on `slot-missing' - (slot-missing obj slot 'oset value) - ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) - ) + (slot-missing obj slot 'oset value)) (eieio--validate-slot-value class c value slot) (aset obj c value)))) @@ -1070,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. @@ -1098,100 +1094,10 @@ 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)) - -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "dba4205b1a0d7133f1311d975b4d0ebe") -;;; Generated autoloads from eieio-compat.el - -(autoload 'eieio--defalias "eieio-compat" "\ -Like `defalias', but with less side-effects. -More specifically, it has no side-effects at all when the new function -definition is the same (`eq') as the old one. - -\(fn NAME BODY)" nil nil) - -(autoload 'defgeneric "eieio-compat" "\ -Create a generic function METHOD. -DOC-STRING is the base documentation for this class. A generic -function has no body, as its purpose is to decide which method body -is appropriate to use. Uses `defmethod' to create methods, and calls -`defgeneric' for you. With this implementation the ARGS are -currently ignored. You can use `defgeneric' to apply specialized -top level documentation to a method. - -\(fn METHOD ARGS &optional DOC-STRING)" nil t) - -(function-put 'defgeneric 'doc-string-elt '3) - -(make-obsolete 'defgeneric 'cl-defgeneric '"25.1") - -(autoload 'defmethod "eieio-compat" "\ -Create a new METHOD through `defgeneric' with ARGS. - -The optional second argument KEY is a specifier that -modifies how the method is called, including: - :before - Method will be called before the :primary - :primary - The default if not specified - :after - Method will be called after the :primary - :static - First arg could be an object or class -The next argument is the ARGLIST. The ARGLIST specifies the arguments -to the method as with `defun'. The first argument can have a type -specifier, such as: - ((VARNAME CLASS) ARG2 ...) -where VARNAME is the name of the local variable for the method being -created. The CLASS is a class symbol for a class made with `defclass'. -A DOCSTRING comes after the ARGLIST, and is optional. -All the rest of the args are the BODY of the method. A method will -return the value of the last form in the BODY. - -Summary: - - (defmethod mymethod [:before | :primary | :after | :static] - ((typearg class-name) arg2 &optional opt &rest rest) - \"doc-string\" - body) - -\(fn METHOD &rest ARGS)" nil t) - -(function-put 'defmethod 'doc-string-elt '3) - -(make-obsolete 'defmethod 'cl-defmethod '"25.1") - -(autoload 'eieio--defgeneric-init-form "eieio-compat" "\ - - -\(fn METHOD DOC-STRING)" nil nil) - -(autoload 'eieio--defmethod "eieio-compat" "\ - - -\(fn METHOD KIND ARGCLASS CODE)" nil nil) - -(autoload 'eieio-defmethod "eieio-compat" "\ -Obsolete work part of an old version of the `defmethod' macro. - -\(fn METHOD ARGS)" nil nil) - -(make-obsolete 'eieio-defmethod 'cl-defmethod '"24.1") - -(autoload 'eieio-defgeneric "eieio-compat" "\ -Obsolete work part of an old version of the `defgeneric' macro. - -\(fn METHOD DOC-STRING)" nil nil) - -(make-obsolete 'eieio-defgeneric 'cl-defgeneric '"24.1") - -(autoload 'eieio-defclass "eieio-compat" "\ - - -\(fn CNAME SUPERCLASSES SLOTS OPTIONS)" nil nil) - -(make-obsolete 'eieio-defclass 'eieio-defclass-internal '"25.1") - -;;;*** - - (provide 'eieio-core) ;;; eieio-core.el ends here diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 0ba1eba4f48..d2d87ea1537 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -473,7 +473,7 @@ Return the symbol for the group, or nil" (provide 'eieio-custom) ;; Local variables: -;; generated-autoload-file: "eieio.el" +;; generated-autoload-file: "eieio-loaddefs.el" ;; End: ;;; eieio-custom.el ends here diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index c1f8297b4a5..2f1d69f78f8 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -349,7 +349,7 @@ INDENT is the current indentation level." (provide 'eieio-opt) ;; Local variables: -;; generated-autoload-file: "eieio.el" +;; generated-autoload-file: "eieio-loaddefs.el" ;; End: ;;; eieio-opt.el ends here diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index f045e267ff4..fd77654f105 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -678,7 +678,8 @@ This class is not stored in the `parent' slot of a class vector." (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass)) -(defalias 'standard-class 'eieio-default-superclass) +(define-obsolete-function-alias 'standard-class + 'eieio-default-superclass "26.1") (cl-defgeneric make-instance (class &rest initargs) "Make a new instance of CLASS based on INITARGS. @@ -765,11 +766,7 @@ dynamically set from SLOTS." ;; Shared initialize will parse our slots for us. (shared-initialize this slots)) -(cl-defgeneric slot-missing (object slot-name operation &optional new-value) - "Method invoked when an attempt to access a slot in OBJECT fails.") - -(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name - _operation &optional _new-value) +(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. SLOT-NAME is the name of the failed slot, OPERATION is the type of access that was requested, and optional NEW-VALUE is the value that was desired @@ -777,8 +774,9 @@ to be set. This method is called from `oref', `oset', and other functions which directly reference slots in EIEIO objects." - (signal 'invalid-slot-name (list (eieio-object-name object) - slot-name))) + (signal 'invalid-slot-name + (list (if (eieio-object-p object) (eieio-object-name object) object) + slot-name))) (cl-defgeneric slot-unbound (object class slot-name fn) "Slot unbound is invoked during an attempt to reference an unbound slot.") @@ -815,22 +813,19 @@ first and modify the returned object.") (if params (shared-initialize nobj params)) nobj)) -(cl-defgeneric destructor (this &rest params) - "Destructor for cleaning up any dynamic links to our object.") - -(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params) - "Destructor for cleaning up any dynamic links to our object. -Argument THIS is the object being destroyed. PARAMS are additional -ignored parameters." +(cl-defgeneric destructor (_this &rest _params) + "Destructor for cleaning up any dynamic links to our object." + (declare (obsolete nil "26.1")) ;; No cleanup... yet. - ) + nil) -(cl-defgeneric object-print (this &rest strings) - "Pretty printer for object THIS. Call function `object-name' with STRINGS. +(cl-defgeneric object-print (this &rest _strings) + "Pretty printer for object THIS. It is sometimes useful to put a summary of the object into the default #<notation> string when using EIEIO browsing tools. -Implement this method to customize the summary.") +Implement this method to customize the summary." + (format "%S" this)) (cl-defmethod object-print ((this eieio-default-superclass) &rest strings) "Pretty printer for object THIS. Call function `object-name' with STRINGS. @@ -938,11 +933,12 @@ this object." ;;; Unimplemented functions from CLOS ;; -(defun change-class (_obj _class) +(defun eieio-change-class (_obj _class) "Change the class of OBJ to type CLASS. 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 "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 @@ -970,41 +966,6 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to (advice-add 'edebug-prin1-to-string :around #'eieio-edebug-prin1-to-string) - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "e8d466f8eee341f3da967c2931b28043") -;;; Generated autoloads from eieio-custom.el - -(autoload 'customize-object "eieio-custom" "\ -Customize OBJ in a custom buffer. -Optional argument GROUP is the sub-group of slots to display. - -\(fn OBJ &optional GROUP)" nil nil) - -;;;*** - -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "0b9c6be48520da2085812f6e7fed9792") -;;; Generated autoloads from eieio-opt.el - -(autoload 'eieio-browse "eieio-opt" "\ -Create an object browser window to show all objects. -If optional ROOT-CLASS, then start with that, otherwise start with -variable `eieio-default-superclass'. - -\(fn &optional ROOT-CLASS)" t nil) - -(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1") - -(autoload 'eieio-help-constructor "eieio-opt" "\ -Describe CTR if it is a class constructor. - -\(fn CTR)" nil nil) - -;;;*** - -;;; End of automatically extracted autoloads. - (provide 'eieio) ;;; eieio ends here diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 096102ae7e1..6c2f869f260 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -197,7 +197,10 @@ 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 diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 7f0f947ec04..ab0a54c540e 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -105,7 +105,7 @@ are as follows, and suppress messages about the indicated features: :version "23.2" :group 'elint) -(defcustom elint-directory-skip-re "\\(ldefs-boot\\|loaddefs\\)\\.el\\'" +(defcustom elint-directory-skip-re "\\(ldefs-boot.*\\|loaddefs\\)\\.el\\'" "If nil, a regexp matching files to skip when linting a directory." :type '(choice (const :tag "Lint all files" nil) (regexp :tag "Regexp to skip")) 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 6f224ed92d3..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 @@ -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,15 +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 - (prog1 - (switch-to-buffer buf) - (run-hooks 'find-function-after-hook)) - (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) diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index e400b499036..d7069174c1b 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -2,13 +2,16 @@ ;; Copyright (C) 2014-2016 Free Software Foundation, Inc. -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> -;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com> +;; Author: Artur Malabarba <emacs@endlessparentheses.com> +;; Package-Requires: ((emacs "24.1")) ;; Version: 1.0.4 ;; Keywords: extensions lisp ;; Prefix: let-alist ;; Separator: - +;; This is an Elpa :core package. Don't use functionality that is not +;; compatible with Emacs 24.1. + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -73,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)))))) @@ -134,7 +142,7 @@ displayed in the example above." (let ((var (make-symbol "alist"))) `(let ((,var ,alist)) (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var))) - (delete-dups (let-alist--deep-dot-search body))) + (delete-dups (let-alist--deep-dot-search body))) ,@body)))) (provide 'let-alist) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index cfec05cd01d..a277d7a6680 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -168,6 +168,8 @@ (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") +(defconst lisp-prettify-symbols-alist '(("lambda" . ?λ)) + "Alist of symbol/\"pretty\" characters to be displayed.") ;;;; Font-lock support. @@ -594,7 +596,7 @@ font-lock keywords will not be case sensitive." (font-lock-extra-managed-props help-echo) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))) - (setq-local prettify-symbols-alist lisp--prettify-symbols-alist) + (setq-local prettify-symbols-alist lisp-prettify-symbols-alist) (setq-local electric-pair-skip-whitespace 'chomp) (setq-local electric-pair-open-newline-between-pairs nil)) @@ -655,9 +657,6 @@ font-lock keywords will not be case sensitive." :type 'hook :group 'lisp) -(defconst lisp--prettify-symbols-alist - '(("lambda" . ?λ))) - ;;; Generic Lisp mode. (defvar lisp-mode-map @@ -1217,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/macroexp.el b/lisp/emacs-lisp/macroexp.el index 310ca29e9a1..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) 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 ba15a65f5e1..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)) @@ -200,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. @@ -249,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." @@ -282,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. @@ -347,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/package.el b/lisp/emacs-lisp/package.el index e4bb561a87a..ef129e998c2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -150,6 +150,7 @@ (require 'tabulated-list) (require 'macroexp) +(require 'url-handlers) (defgroup package nil "Manager for Emacs Lisp packages." @@ -302,7 +303,7 @@ contrast, `package-user-dir' contains packages for personal use." :version "24.1") (declare-function epg-find-configuration "epg-config" - (protocol &optional force)) + (protocol &optional no-cache program-alist)) (defcustom package-check-signature (if (and (require 'epg-config) @@ -791,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) @@ -907,12 +908,15 @@ untar into a directory named DIR; otherwise, signal an error." file) (defvar generated-autoload-file) +(defvar autoload-timestamps) (defvar version-control) (defun package-generate-autoloads (name pkg-dir) (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) + ;; We don't need 'em, and this makes the output reproducible. + (autoload-timestamps nil) ;; Silence `autoload-generate-file-autoloads'. (noninteractive inhibit-message) (backup-inhibited t) @@ -1077,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)))) @@ -2304,7 +2310,7 @@ Otherwise no newline is inserted." (insert "\n") (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive. (package--print-help-section "Archive" - (or archive "n/a") "\n")) + (or archive "n/a"))) (and version (package--print-help-section "Version" (package-version-join version))) 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 27db4773b1d..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. @@ -262,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/rx.el b/lisp/emacs-lisp/rx.el index 66d295e221f..d305597631a 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -521,7 +521,7 @@ ARG is optional." (setq args (nconc (delq ?- args) (list ?-)))) ((setq m (assq ?- args)) ;; next to the bracket's range, make the second range - (setcdr args (cons m (delq m args)))))) + (setcdr args (cons m (delq m (cdr args))))))) ;; bracket in the end range ;; => "[]...-]" ((setq m (rassq ?\] args)) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 904aad0afef..74510244be7 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 @@ -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)) @@ -144,6 +154,18 @@ if positive or too small if negative)." sequence) (nreverse result))) +(defun seq-map-indexed (function sequence) + "Return the result of applying FUNCTION to each element of SEQUENCE. +Unlike `seq-map', FUNCTION takes two arguments: the element of +the sequence, and its index within the sequence." + (let ((index 0)) + (seq-map (lambda (elt) + (prog1 + (funcall function elt index) + (setq index (1+ index)))) + sequence))) + + ;; faster implementation for sequences (sequencep) (cl-defmethod seq-map (function (sequence sequence)) (mapcar function sequence)) @@ -156,7 +178,8 @@ Return a list of the results. \(fn FUNCTION SEQUENCES...)" (let ((result nil) - (sequences (seq-map (lambda (s) (seq-into s 'list)) + (sequences (seq-map (lambda (s) + (seq-into s 'list)) (cons sequence sequences)))) (while (not (memq nil sequences)) (push (apply function (seq-map #'car sequences)) result) @@ -206,6 +229,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 '())) @@ -240,9 +273,9 @@ of sequence." TYPE can be one of the following symbols: vector, string or list." (pcase type - (`vector (vconcat sequence)) - (`string (concat sequence)) - (`list (append sequence nil)) + (`vector (seq--into-vector sequence)) + (`string (seq--into-string sequence)) + (`list (seq--into-list sequence)) (_ (error "Not a sequence type name: %S" type)))) (cl-defgeneric seq-filter (pred sequence) @@ -284,7 +317,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))) @@ -317,7 +351,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) @@ -443,16 +478,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." @@ -473,6 +512,24 @@ If no element is found, return nil." (null list)) +(defun seq--into-list (sequence) + "Concatenate the elements of SEQUENCE into a list." + (if (listp sequence) + sequence + (append sequence nil))) + +(defun seq--into-vector (sequence) + "Concatenate the elements of SEQUENCE into a vector." + (if (vectorp sequence) + sequence + (vconcat sequence))) + +(defun seq--into-string (sequence) + "Concatenate the elements of SEQUENCE into a string." + (if (stringp sequence) + sequence + (concat sequence))) + (defun seq--activate-font-lock-keywords () "Activate font-lock keywords for some symbols defined in seq." (font-lock-add-keywords 'emacs-lisp-mode 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 654f234fa62..ac509b3465d 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -316,6 +316,9 @@ END) 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) @@ -417,6 +420,9 @@ point (where the PPSS is equivalent to nil).") (error nil))) syntax-ppss-stats)) +(defvar-local syntax-ppss-table nil + "Syntax-table to use during `syntax-ppss', if any.") + (defun syntax-ppss (&optional pos) "Parse-Partial-Sexp State at POS, defaulting to point. The returned value is the same as that of `parse-partial-sexp' @@ -432,6 +438,7 @@ running the hook." (unless pos (setq pos (point))) (syntax-propertize pos) ;; + (with-syntax-table (or syntax-ppss-table (syntax-table)) (let ((old-ppss (cdr syntax-ppss-last)) (old-pos (car syntax-ppss-last)) (ppss nil) @@ -568,7 +575,7 @@ running the hook." ;; we may end up calling parse-partial-sexp with a position before ;; point-min. In that case, just parse from point-min assuming ;; a nil state. - (parse-partial-sexp (point-min) pos))))) + (parse-partial-sexp (point-min) pos)))))) ;; Debugging functions 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-list.el b/lisp/emacs-lisp/timer-list.el new file mode 100644 index 00000000000..9b13e52dd7c --- /dev/null +++ b/lisp/emacs-lisp/timer-list.el @@ -0,0 +1,112 @@ +;;; timer-list.el --- list active timers in a buffer + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Package: emacs + +;; 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: + +;;; Code: + +;;;###autoload +(defun timer-list (&optional _ignore-auto _nonconfirm) + "List all timers in a buffer." + (interactive) + (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) + (let ((inhibit-read-only t)) + (erase-buffer) + (timer-list-mode) + (dolist (timer (append timer-list timer-idle-list)) + (insert (format "%4s %10s %8s %s" + ;; Idle. + (if (aref timer 7) + "*" + " ") + ;; Next time. + (let ((time (float-time (list (aref timer 1) + (aref timer 2) + (aref timer 3))))) + (format "%.2f" + (if (aref timer 7) + time + (- (float-time (list (aref timer 1) + (aref timer 2) + (aref timer 3))) + (float-time))))) + ;; Repeat. + (let ((repeat (aref timer 4))) + (cond + ((numberp repeat) + (format "%.2f" (/ repeat 60))) + ((null repeat) + "-") + (t + (format "%s" repeat)))) + ;; Function. + (let ((function (aref timer 5))) + (replace-regexp-in-string + "\n" " " + (cond + ((byte-code-function-p function) + (replace-regexp-in-string + "[^-A-Za-z0-9 ]" "" + (format "%s" function))) + (t + (format "%s" function))))))) + (put-text-property (line-beginning-position) + (1+ (line-beginning-position)) + 'timer timer) + (insert "\n"))) + (goto-char (point-min))) +;; This command can be destructive if they don't know what they are +;; doing. Kids, don't try this at home! +;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") + +(defvar timer-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "c" 'timer-list-cancel) + (easy-menu-define nil map "" + '("Timers" + ["Cancel" timer-list-cancel t])) + map)) + +(define-derived-mode timer-list-mode special-mode "timer-list" + "Mode for listing and controlling timers." + (setq truncate-lines t) + (buffer-disable-undo) + (setq-local revert-buffer-function 'timer-list) + (setq buffer-read-only t) + (setq header-line-format + (format "%4s %10s %8s %s" + "Idle" "Next" "Repeat" "Function"))) + +(defun timer-list-cancel () + "Cancel the timer on the line under point." + (interactive) + (let ((timer (get-text-property (line-beginning-position) 'timer)) + (inhibit-read-only t)) + (unless timer + (error "No timer on the current line")) + (cancel-timer timer) + (delete-region (line-beginning-position) + (line-beginning-position 2)))) + +(provide 'timer-list) + +;;; timer-list.el ends here diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index c01ea4973c7..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. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 4bd819ab828..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,40 +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) - (when (listp buffer-undo-list) - (let ((had-boundary (null (car 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))) - ;; The top-level loop only adds boundaries if there has been - ;; modifications in the buffer, so make sure we don't accidentally - ;; drop the "final" boundary (bug#22295). - (if had-boundary (undo-boundary))))))) +(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 @@ -1907,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)) "#") @@ -1988,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 @@ -2058,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) @@ -2102,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 @@ -2113,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 "") @@ -2128,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)) @@ -2836,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) @@ -3672,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 @@ -4875,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 @@ -4946,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.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/epa.el b/lisp/epa.el index b0b016b7063..170744026e1 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -34,6 +34,17 @@ :link '(custom-manual "(epa) Top") :group 'epg) +(defcustom epa-replace-original-text 'ask + "Whether the original text shall be replaced by the decrypted. + +If t, replace the original text without any confirmation. +If nil, don't replace the original text and show the result in a new buffer. +If neither t nor nil, ask user for confirmation." + :type '(choice (const :tag "Never" nil) + (const :tag "Ask the user" ask) + (const :tag "Always" t)) + :group 'epa) + (defcustom epa-popup-info-window t "If non-nil, display status information from epa commands in another window." :type 'boolean @@ -872,7 +883,9 @@ For example: (with-current-buffer (funcall make-buffer-function) (let ((inhibit-read-only t)) (insert plain))) - (if (y-or-n-p "Replace the original text? ") + (if (or (eq epa-replace-original-text t) + (and epa-replace-original-text + (y-or-n-p "Replace the original text? "))) (let ((inhibit-read-only t)) (delete-region start end) (goto-char start) @@ -968,7 +981,9 @@ For example: (or coding-system-for-read (get-text-property start 'epa-coding-system-used) 'undecided))) - (if (y-or-n-p "Replace the original text? ") + (if (or (eq epa-replace-original-text t) + (and epa-replace-original-text + (y-or-n-p "Replace the original text? "))) (let ((inhibit-read-only t) buffer-read-only) (delete-region start end) 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/erc-backend.el b/lisp/erc/erc-backend.el index 012b5b5f3f4..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. @@ -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 @@ -549,47 +549,45 @@ The current buffer is given by BUFFER." (defun erc-server-connect (server port buffer) "Perform the connection and login using the specified SERVER and PORT. We will store server variables in the buffer given by BUFFER." - (let ((msg (erc-format-message 'connect ?S server ?p port))) + (let ((msg (erc-format-message 'connect ?S server ?p port)) process) (message "%s" msg) - (let ((process (funcall erc-server-connect-function - (format "erc-%s-%s" server port) - nil server port))) - (unless (processp process) - (error "Connection attempt failed")) + (setq process (funcall erc-server-connect-function + (format "erc-%s-%s" server port) nil server port)) + (unless (processp process) + (error "Connection attempt failed")) + ;; Misc server variables + (with-current-buffer buffer + (setq erc-server-process process) + (setq erc-server-quitting nil) + (setq erc-server-reconnecting nil) + (setq erc-server-timed-out nil) + (setq erc-server-banned nil) + (setq erc-server-error-occurred nil) + (let ((time (erc-current-time))) + (setq erc-server-last-sent-time time) + (setq erc-server-last-ping-time time) + (setq erc-server-last-received-time time)) + (setq erc-server-lines-sent 0) + ;; last peers (sender and receiver) + (setq erc-server-last-peers '(nil . nil))) + ;; we do our own encoding and decoding + (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-buffer process buffer) + (erc-log "\n\n\n********************************************\n") + (message "%s" (erc-format-message + 'login ?n + (with-current-buffer buffer (erc-current-nick)))) + ;; wait with script loading until we receive a confirmation (first + ;; MOTD line) + (if (eq (process-status process) 'connect) + ;; waiting for a non-blocking connect - keep the user informed + (erc-display-message nil nil buffer "Opening connection..\n") (message "%s...done" msg) - ;; Misc server variables - (with-current-buffer buffer - (setq erc-server-process process) - (setq erc-server-quitting nil) - (setq erc-server-reconnecting nil) - (setq erc-server-timed-out nil) - (setq erc-server-banned nil) - (setq erc-server-error-occurred nil) - (let ((time (erc-current-time))) - (setq erc-server-last-sent-time time) - (setq erc-server-last-ping-time time) - (setq erc-server-last-received-time time)) - (setq erc-server-lines-sent 0) - ;; last peers (sender and receiver) - (setq erc-server-last-peers '(nil . nil))) - ;; we do our own encoding and decoding - (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-buffer process buffer))) - (erc-log "\n\n\n********************************************\n") - (message "%s" (erc-format-message - 'login ?n - (with-current-buffer buffer (erc-current-nick)))) - ;; wait with script loading until we receive a confirmation (first - ;; MOTD line) - (if (eq erc-server-connect-function 'open-network-stream-nowait) - ;; it's a bit unclear otherwise that it's attempting to establish a - ;; connection - (erc-display-message nil nil buffer "Opening connection..\n") - (erc-login))) + (erc-login)) )) (defun erc-server-reconnect () "Reestablish the current IRC connection. @@ -605,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)))) @@ -650,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) @@ -679,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. @@ -813,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) @@ -880,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) @@ -1071,7 +1068,7 @@ Finds hooks by looking in the `erc-server-responses' hash table." (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." @@ -1079,7 +1076,7 @@ Finds hooks by looking in the `erc-server-responses' hash table." " " (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))) @@ -1210,10 +1207,11 @@ 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 @@ -1326,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)))) @@ -1368,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) @@ -1493,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 @@ -1524,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 @@ -1576,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))) " "))) @@ -1595,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))) @@ -1623,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) @@ -1659,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) @@ -1738,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)))) @@ -1756,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 @@ -1803,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))) @@ -1838,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 @@ -2007,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-compat.el b/lisp/erc/erc-compat.el index 5e03d30bf94..e5e63092df3 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -54,10 +54,10 @@ See `erc-encoding-coding-alist'." (set (make-local-variable 'write-file-functions) new-val)) (defvar erc-emacs-build-time - (if (stringp emacs-build-time) + (if (or (stringp emacs-build-time) (not emacs-build-time)) emacs-build-time (format-time-string "%Y-%m-%d" emacs-build-time)) - "Time at which Emacs was dumped out.") + "Time at which Emacs was dumped out, or nil if not available.") ;; Emacs 21 and XEmacs do not have user-emacs-directory, but XEmacs ;; has user-init-directory. @@ -164,4 +164,3 @@ If START or END is negative, it counts from the end." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - 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 1a126a80343..8501e2cba7d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1474,6 +1474,10 @@ Defaults to the server buffer." (defconst erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") +(defconst erc-default-port-tls 6697 + "IRC port to use for encrypted connections if it cannot be + detected otherwise.") + (defcustom erc-join-buffer 'buffer "Determines how to display a newly created IRC buffer. @@ -2200,7 +2204,8 @@ be invoked for the values of the other parameters." (defun erc-tls (&rest r) "Interactively select TLS connection parameters and run ERC. Arguments are the same as for `erc'." - (interactive (erc-select-read-args)) + (interactive (let ((erc-default-port erc-default-port-tls)) + (erc-select-read-args))) (let ((erc-server-connect-function 'erc-open-tls-stream)) (apply #'erc r))) @@ -2271,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 @@ -2461,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))) @@ -3576,7 +3581,7 @@ the message given by REASON." (defun erc-cmd-SV () "Say the current ERC and Emacs version into channel." - (erc-send-message (format "I'm using ERC with %s %s (%s%s) of %s." + (erc-send-message (format "I'm using ERC with %s %s (%s%s)%s." (if (featurep 'xemacs) "XEmacs" "GNU Emacs") emacs-version system-configuration @@ -3597,7 +3602,9 @@ the message given by REASON." x-toolkit-scroll-bars))) "") (if (featurep 'multi-tty) ", multi-tty" "")) - erc-emacs-build-time)) + (if erc-emacs-build-time + (concat " of " erc-emacs-build-time) + ""))) t) (defun erc-cmd-SM () @@ -3890,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 @@ -4253,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 @@ -4294,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 () @@ -4305,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 @@ -5231,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))) @@ -5246,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) @@ -5436,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))) @@ -5456,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))) @@ -5880,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)) @@ -5890,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))))) @@ -6000,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-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-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 14964f9aab8..e687fd2dcbd 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -296,7 +296,7 @@ and the hook `eshell-exit-hook'." (run-hooks 'eshell-exit-hook)) ;;;###autoload -(define-derived-mode eshell-mode fundamental-mode "EShell" +(define-derived-mode eshell-mode fundamental-mode "Eshell" "Emacs shell interactive mode." (setq-local eshell-mode 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/eshell/eshell.el b/lisp/eshell/eshell.el index 8b21730ef33..54281a72c7a 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -308,9 +308,9 @@ With prefix ARG, insert output into the current buffer at point." (eshell-parse-command command)))) intr (bufname (if (and proc (listp proc)) - "*EShell Async Command Output*" + "*Eshell Async Command Output*" (setq intr t) - "*EShell Command Output*"))) + "*Eshell Command Output*"))) (if (buffer-live-p (get-buffer bufname)) (kill-buffer bufname)) (rename-buffer bufname) diff --git a/lisp/faces.el b/lisp/faces.el index a84edab3615..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. @@ -1003,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))) @@ -1816,6 +1826,32 @@ If FRAME is nil, that stands for the selected frame." (mapcar 'car (tty-color-alist frame)))) (defalias 'x-defined-colors 'defined-colors) +(defun defined-colors-with-face-attributes (&optional frame) + "Return a list of colors supported for a particular frame. +See `defined-colors' for arguments and return value. In contrast +to `define-colors' the elements of the returned list are color +strings with text properties, that make the color names render +with the color they represent as background color." + (mapcar + (lambda (color-name) + (let ((foreground (readable-foreground-color color-name)) + (color (copy-sequence color-name))) + (propertize color 'face (list :foreground foreground + :background color)))) + (defined-colors frame))) + +(defun readable-foreground-color (color) + "Return a readable foreground color for background COLOR." + (let* ((rgb (color-values color)) + (max (apply #'max rgb)) + (black (car (color-values "black"))) + (white (car (color-values "white")))) + ;; Select black or white depending on which one is less similar to + ;; the brightest component. + (if (> (abs (- max black)) (abs (- max white))) + "black" + "white"))) + (declare-function xw-color-defined-p "xfns.c" (color &optional frame)) (defun color-defined-p (color &optional frame) @@ -1920,22 +1956,24 @@ resulting color name in the echo area." (colors (or facemenu-color-alist (append '("foreground at point" "background at point") (if allow-empty-name '("")) - (defined-colors)))) + (if (display-color-p) + (defined-colors-with-face-attributes) + (defined-colors))))) (color (completing-read (or prompt "Color (name or #RGB triplet): ") ;; Completing function for reading colors, accepting ;; both color names and RGB triplets. (lambda (string pred flag) (cond - ((null flag) ; Try completion. + ((null flag) ; Try completion. (or (try-completion string colors pred) (if (color-defined-p string) string))) - ((eq flag t) ; List all completions. + ((eq flag t) ; List all completions. (or (all-completions string colors pred) (if (color-defined-p string) (list string)))) - ((eq flag 'lambda) ; Test completion. + ((eq flag 'lambda) ; Test completion. (or (member string colors) (color-defined-p string))))) nil t))) @@ -2432,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") @@ -2440,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 @@ -2472,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)) @@ -2483,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))) @@ -2499,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 @@ -2703,6 +2754,13 @@ It is used for characters of no fonts too." :version "24.1" :group 'basic-faces) +(defface read-multiple-choice-face + '((t (:inherit underline + :weight bold))) + "Face for the symbol name in `read-multiple-choice' output." + :group 'basic-faces + :version "26.1") + ;; Faces for TTY menus. (defface tty-menu-enabled-face '((t @@ -2831,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 c97c7624a60..a7983f08395 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -207,6 +207,11 @@ Sensible values are nil, \"news\", or \"mailto\"." ) :group 'ffap) +(defvar ffap-max-region-length 1024 + "Maximum active region length. +When the region is active and larger than this value, +`ffap-string-at-point' returns an empty string.") + ;;; Peanut Gallery (More User Variables): ;; @@ -574,7 +579,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (defvaralias 'ffap-newsgroup-heads 'thing-at-point-newsgroup-heads) (defalias 'ffap-newsgroup-p 'thing-at-point-newsgroup-p) -(defsubst ffap-url-p (string) +(defun ffap-url-p (string) "If STRING looks like an URL, return it (maybe improved), else nil." (when (and (stringp string) ffap-url-regexp) (let* ((case-fold-search t) @@ -1105,8 +1110,10 @@ MODE (defaults to value of `major-mode') is a symbol used to look up string syntax parameters in `ffap-string-at-point-mode-alist'. If MODE is not found, we use `file' instead of MODE. If the region is active, return a string from the region. -Sets the variable `ffap-string-at-point' and the variable -`ffap-string-at-point-region'." +Set the variable `ffap-string-at-point' and the variable +`ffap-string-at-point-region'. +When the region is active and larger than `ffap-max-region-length', +return an empty string, and set `ffap-string-at-point-region' to '(1 1)." (let* ((args (cdr (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) @@ -1123,11 +1130,15 @@ Sets the variable `ffap-string-at-point' and the variable (save-excursion (skip-chars-forward (car args)) (skip-chars-backward (nth 2 args) pt) - (point))))) - (setq ffap-string-at-point - (buffer-substring-no-properties - (setcar ffap-string-at-point-region beg) - (setcar (cdr ffap-string-at-point-region) end))))) + (point)))) + (region-len (- (max beg end) (min beg end)))) + (if (and (natnump ffap-max-region-length) + (< region-len ffap-max-region-length)) ; Bug#25243. + (setf ffap-string-at-point-region (list beg end) + ffap-string-at-point + (buffer-substring-no-properties beg end)) + (setf ffap-string-at-point-region (list 1 1) + ffap-string-at-point "")))) (defun ffap-string-around () ;; Sometimes useful to decide how to treat a string. @@ -1514,9 +1525,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 @@ -1892,7 +1903,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. diff --git a/lisp/files-x.el b/lisp/files-x.el index f0102fd83af..212c936414f 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -429,18 +429,24 @@ from the MODE alist ignoring the input argument VALUE." (catch 'exit (unless enable-local-variables (throw 'exit (message "Directory-local variables are disabled"))) - (let ((variables-file (or (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))) - (dir-locals-find-file (buffer-file-name))) - dir-locals-file)) - variables) - (if (consp variables-file) ; result from cache - ;; If cache element has an mtime, assume it came from a file. - ;; Otherwise, assume it was set directly. - (setq variables-file (if (nth 2 variables-file) - (expand-file-name dir-locals-file - (car variables-file)) - (cadr variables-file)))) + (let* ((dir-or-cache (and (buffer-file-name) + (not (file-remote-p (buffer-file-name))) + (dir-locals-find-file (buffer-file-name)))) + (variables-file + ;; If there are several .dir-locals, the user probably + ;; wants to edit the last one (the highest priority). + (cond ((stringp dir-or-cache) + (car (last (dir-locals--all-files dir-or-cache)))) + ((consp dir-or-cache) ; result from cache + ;; If cache element has an mtime, assume it came + ;; from a file. Otherwise, assume it was set + ;; directly. + (if (nth 2 dir-or-cache) + (car (last (dir-locals--all-files (car dir-or-cache)))) + (cadr dir-or-cache))) + ;; Try to make a proper file-name. + (t (expand-file-name dir-locals-file)))) + variables) ;; I can't be bothered to handle this case right now. ;; Dir locals were set directly from a class. You need to ;; directly modify the class in dir-locals-class-alist. @@ -537,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 962ced4f077..71398227407 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -278,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)))) @@ -611,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 @@ -1132,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 @@ -1216,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. @@ -1316,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 @@ -1352,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. @@ -1557,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)) @@ -1753,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) @@ -1940,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) @@ -2333,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 @@ -2473,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 @@ -2866,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. @@ -2876,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)) @@ -3189,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)) @@ -3208,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" @@ -3236,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)))))) @@ -3314,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. @@ -3336,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. @@ -3344,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)) @@ -3410,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" @@ -3427,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. @@ -3449,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) @@ -3457,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))))) @@ -3685,7 +3755,7 @@ Return the new variables list." (error ;; The file's content might be invalid (e.g. have a merge conflict), but ;; that shouldn't prevent the user from opening the file. - (message ".dir-locals error: %s" (error-message-string err)) + (message "%s error: %s" dir-locals-file (error-message-string err)) nil)))) (defun dir-locals-set-directory-class (directory class &optional mtime) @@ -3737,8 +3807,41 @@ VARIABLES list of the class. The list is processed in order. (defconst dir-locals-file ".dir-locals.el" "File that contains directory-local variables. -It has to be constant to enforce uniform values -across different environments and users.") +It has to be constant to enforce uniform values across different +environments and users. +See also `dir-locals-file-2', whose values override this one's. +See Info node `(elisp)Directory Local Variables' for details.") + +(defconst dir-locals-file-2 ".dir-locals-2.el" + "File that contains directory-local variables. +This essentially a second file that can be used like +`dir-locals-file', so that users can have specify their personal +dir-local variables even if the current directory already has a +`dir-locals-file' that is shared with other users (such as in a +git repository). +See Info node `(elisp)Directory Local Variables' for details.") + +(defun dir-locals--all-files (directory) + "Return a list of all readable dir-locals files in DIRECTORY. +The returned list is sorted by increasing priority. That is, +values specified in the last file should take precedence over +those in the first." + (when (file-readable-p directory) + (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos) + (dosified-file-name dir-locals-file) + dir-locals-file) + directory)) + (file-2 (when (string-match "\\.el\\'" file-1) + (replace-match "-2.el" t nil file-1))) + (out nil)) + ;; The order here is important. + (dolist (f (list file-2 file-1)) + (when (and f + (file-readable-p f) + (file-regular-p f) + (not (file-directory-p f))) + (push f out))) + out))) (defun dir-locals-find-file (file) "Find the directory-local variables for FILE. @@ -3753,78 +3856,95 @@ A cache entry based on a `dir-locals-file' is valid if the modification time stored in the cache matches the current file modification time. If not, the cache entry is cleared so that the file will be re-read. -This function returns either nil (no directory local variables found), -or the matching entry from `dir-locals-directory-cache' (a list), -or the full path to the `dir-locals-file' (a string) in the case -of no valid cache entry." +This function returns either: + - nil (no directory local variables found), + - the matching entry from `dir-locals-directory-cache' (a list), + - or the full path to the directory (a string) containing at + least one `dir-locals-file' in the case of no valid cache + entry." (setq file (expand-file-name file)) - (let* ((dir-locals-file-name - (if (eq system-type 'ms-dos) - (dosified-file-name dir-locals-file) - dir-locals-file)) - (locals-file (locate-dominating-file file dir-locals-file-name)) - (dir-elt nil)) + (let* ((locals-dir (locate-dominating-file (file-name-directory file) + #'dir-locals--all-files)) + dir-elt) ;; `locate-dominating-file' may have abbreviated the name. - (and locals-file - (setq locals-file (expand-file-name dir-locals-file-name locals-file))) - ;; Let dir-locals-read-from-file inform us via demoted-errors - ;; about unreadable files, etc. - ;; Maybe we'd want to keep searching though - that is - ;; a locate-dominating-file issue. -;;; (or (not (file-readable-p locals-file)) -;;; (not (file-regular-p locals-file))) -;;; (setq locals-file nil)) + (when locals-dir + (setq locals-dir (expand-file-name locals-dir))) ;; Find the best cached value in `dir-locals-directory-cache'. (dolist (elt dir-locals-directory-cache) (when (and (string-prefix-p (car elt) file - (memq system-type - '(windows-nt cygwin ms-dos))) - (> (length (car elt)) (length (car dir-elt)))) - (setq dir-elt elt))) + (memq system-type + '(windows-nt cygwin ms-dos))) + (> (length (car elt)) (length (car dir-elt)))) + (setq dir-elt elt))) (if (and dir-elt - (or (null locals-file) - (<= (length (file-name-directory locals-file)) - (length (car dir-elt))))) - ;; Found a potential cache entry. Check validity. - ;; A cache entry with no MTIME is assumed to always be valid - ;; (ie, set directly, not from a dir-locals file). - ;; Note, we don't bother to check that there is a matching class - ;; element in dir-locals-class-alist, since that's done by - ;; dir-locals-set-directory-class. - (if (or (null (nth 2 dir-elt)) - (let ((cached-file (expand-file-name dir-locals-file-name - (car dir-elt)))) - (and (file-readable-p cached-file) - (equal (nth 2 dir-elt) - (nth 5 (file-attributes cached-file)))))) - ;; This cache entry is OK. - dir-elt - ;; This cache entry is invalid; clear it. - (setq dir-locals-directory-cache - (delq dir-elt dir-locals-directory-cache)) - ;; Return the first existing dir-locals file. Might be the same - ;; as dir-elt's, might not (eg latter might have been deleted). - locals-file) + (or (null locals-dir) + (<= (length locals-dir) + (length (car dir-elt))))) + ;; Found a potential cache entry. Check validity. + ;; A cache entry with no MTIME is assumed to always be valid + ;; (ie, set directly, not from a dir-locals file). + ;; Note, we don't bother to check that there is a matching class + ;; element in dir-locals-class-alist, since that's done by + ;; dir-locals-set-directory-class. + (if (or (null (nth 2 dir-elt)) + (let ((cached-files (dir-locals--all-files (car dir-elt)))) + ;; The entry MTIME should match the most recent + ;; MTIME among matching files. + (and cached-files + (= (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 + ;; This cache entry is invalid; clear it. + (setq dir-locals-directory-cache + (delq dir-elt dir-locals-directory-cache)) + ;; Return the first existing dir-locals file. Might be the same + ;; as dir-elt's, might not (eg latter might have been deleted). + locals-dir) ;; No cache entry. - locals-file))) - -(defun dir-locals-read-from-file (file) - "Load a variables FILE and register a new class and instance. -FILE is the name of the file holding the variables to apply. -The new class name is the same as the directory in which FILE -is found. Returns the new class name." - (with-temp-buffer + locals-dir))) + +(defun dir-locals-read-from-dir (dir) + "Load all variables files in DIR and register a new class and instance. +DIR is the absolute name of a directory which must contain at +least one dir-local file (which is a file holding variables to +apply). +Return the new class name, which is a symbol named DIR." + (require 'map) + (let* ((class-name (intern dir)) + (files (dir-locals--all-files dir)) + (read-circle nil) + (success nil) + (variables)) (with-demoted-errors "Error reading dir-locals: %S" - (insert-file-contents file) - (unless (zerop (buffer-size)) - (let* ((dir-name (file-name-directory file)) - (class-name (intern dir-name)) - (variables (let ((read-circle nil)) - (read (current-buffer))))) - (dir-locals-set-class-variables class-name variables) - (dir-locals-set-directory-class dir-name class-name - (nth 5 (file-attributes file))) - class-name))))) + (dolist (file files) + (with-temp-buffer + (insert-file-contents file) + (condition-case-unless-debug nil + (setq variables + (map-merge-with 'list (lambda (a b) (map-merge 'list a b)) + variables + (read (current-buffer)))) + (end-of-file nil)))) + (setq success t)) + (dir-locals-set-class-variables class-name variables) + (dir-locals-set-directory-class + dir class-name + (seconds-to-time + (if success + (apply #'max (mapcar (lambda (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. + 0))) + class-name)) + +(define-obsolete-function-alias 'dir-locals-read-from-file + 'dir-locals-read-from-dir "25.1") (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." @@ -3847,17 +3967,17 @@ This does nothing if either `enable-local-variables' or (not (file-remote-p (or (buffer-file-name) default-directory))))) ;; Find the variables file. - (let ((variables-file (dir-locals-find-file - (or (buffer-file-name) default-directory))) + (let ((dir-or-cache (dir-locals-find-file + (or (buffer-file-name) default-directory))) (class nil) (dir-name nil)) (cond - ((stringp variables-file) - (setq dir-name (file-name-directory variables-file) - class (dir-locals-read-from-file variables-file))) - ((consp variables-file) - (setq dir-name (nth 0 variables-file)) - (setq class (nth 1 variables-file)))) + ((stringp dir-or-cache) + (setq dir-name dir-or-cache + class (dir-locals-read-from-dir dir-or-cache))) + ((consp dir-or-cache) + (setq dir-name (nth 0 dir-or-cache)) + (setq class (nth 1 dir-or-cache)))) (when class (let ((variables (dir-locals-collect-variables @@ -4235,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 @@ -4359,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 @@ -4594,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 @@ -5239,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))) @@ -5284,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. @@ -6102,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))) @@ -6640,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. @@ -6657,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") @@ -6676,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 @@ -6703,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. @@ -6797,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. @@ -7060,6 +7229,98 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (let ((delete-by-moving-to-trash nil)) (rename-file fn new-fn))))))))) +(defsubst 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)) + +(defsubst file-attribute-link-number (attributes) + "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-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-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-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-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-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-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-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-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 +of the form (HIGH MIDDLE . LOW): first the high bits, then the +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-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 +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-dired.el b/lisp/find-dired.el index 7bfdbe73466..b1b33ac23eb 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -97,7 +97,7 @@ them for `find-ls-option'." (defcustom find-grep-options (if (or (eq system-type 'berkeley-unix) - (string-match "solaris2\\|irix" system-configuration)) + (string-match "solaris2" system-configuration)) "-s" "-q") "Option to grep to be as silent as possible. On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it. diff --git a/lisp/find-file.el b/lisp/find-file.el index 8bd810f2c46..3c3d860488f 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -378,6 +378,15 @@ Variables of interest include: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support functions +(defun ff-buffer-file-name (&optional buf) + "Like `buffer-file-name' but works with indirect buffers as well. +If BUF is nil, uses the current buffer." + (unless buf + (setq buf (current-buffer))) + (or (buffer-file-name buf) + (when (buffer-base-buffer buf) + (buffer-file-name (buffer-base-buffer buf))))) + (defun ff-find-the-other-file (&optional in-other-window) "Find the header or source file corresponding to the current file. Being on a `#include' line pulls in that file, but see the help on @@ -420,9 +429,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (setq alist (if (symbolp ff-other-file-alist) (symbol-value ff-other-file-alist) ff-other-file-alist) - pathname (if (buffer-file-name) - (buffer-file-name) - "/none.none")) + pathname (or (ff-buffer-file-name) "/none.none")) (setq fname (file-name-nondirectory pathname) no-match nil @@ -448,7 +455,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." ;; invoke it with the name of the current file (if (and (atom action) (fboundp action)) (progn - (setq suffixes (funcall action (buffer-file-name)) + (setq suffixes (funcall action (ff-buffer-file-name)) match (cons (car match) (list suffixes)) stub nil default-name (car suffixes))) @@ -550,9 +557,7 @@ the `ff-ignore-include' variable." (setq alist (if (symbolp ff-other-file-alist) (symbol-value ff-other-file-alist) ff-other-file-alist) - pathname (if (buffer-file-name) - (buffer-file-name) - "/none.none")) + pathname (or (ff-buffer-file-name) "/none.none")) (setq fname (file-name-nondirectory pathname) match (car alist)) @@ -576,7 +581,7 @@ the `ff-ignore-include' variable." ;; invoke it with the name of the current file (if (and (atom action) (fboundp action)) (progn - (setq suffixes (funcall action (buffer-file-name)) + (setq suffixes (funcall action (ff-buffer-file-name)) match (cons (car match) (list suffixes)) stub nil)) @@ -655,14 +660,14 @@ name of the first file found." (message "Finding buffer %s..." filename)) (if (bufferp (get-file-buffer filename)) - (setq found (buffer-file-name (get-file-buffer filename)))) + (setq found (ff-buffer-file-name (get-file-buffer filename)))) (setq blist (buffer-list)) (setq buf (buffer-name (car blist))) (while (and blist (not found)) (if (string-match-p (concat filename "<[0-9]+>") buf) - (setq found (buffer-file-name (car blist)))) + (setq found (ff-buffer-file-name (car blist)))) (setq blist (cdr blist)) (setq buf (buffer-name (car blist)))) diff --git a/lisp/finder.el b/lisp/finder.el index da537a59cc1..e6d666a5173 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -130,8 +130,8 @@ Keywords and package names both should be symbols.") ;; useful, and because in parallel builds of Emacs they may get ;; modified while we are trying to read them. ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html -;; ldefs-boot is not auto-generated, but has nothing useful. -(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\ +;; ldefs-boot-* are not auto-generated during build, but has nothing useful. +(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot-.*\\|\ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)" "Regexp matching file names not to scan for keywords.") diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 8ee9f69fc1a..b5ff5cfd0af 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -39,7 +39,7 @@ ;; ;; To turn Font Lock mode on automatically, add this to your init file: ;; -;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) +;; (add-hook 'emacs-lisp-mode-hook #'turn-on-font-lock) ;; ;; Or if you want to turn Font Lock mode on in many modes: ;; @@ -582,11 +582,11 @@ When called with no args it should leave point at the beginning of any enclosing textual block and mark at the end. This is normally set via `font-lock-defaults'.") -(defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer +(defvar font-lock-fontify-buffer-function #'font-lock-default-fontify-buffer "Function to use for fontifying the buffer. This is normally set via `font-lock-defaults'.") -(defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer +(defvar font-lock-unfontify-buffer-function #'font-lock-default-unfontify-buffer "Function to use for unfontifying the buffer. This is used when turning off Font Lock mode. This is normally set via `font-lock-defaults'.") @@ -600,7 +600,7 @@ If it fontifies a larger region, it should ideally return a list of the form \(jit-lock-bounds BEG . END) indicating the bounds of the region actually fontified.") -(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region +(defvar font-lock-unfontify-region-function #'font-lock-default-unfontify-region "Function to use for unfontifying a region. It should take two args, the beginning and end of the region. This is normally set via `font-lock-defaults'.") @@ -667,12 +667,12 @@ be enabled." (defun font-lock-mode-internal (arg) ;; Turn on Font Lock mode. (when arg - (add-hook 'after-change-functions 'font-lock-after-change-function t t) + (add-hook 'after-change-functions #'font-lock-after-change-function t t) (font-lock-set-defaults) (font-lock-turn-on-thing-lock)) ;; Turn off Font Lock mode. (unless font-lock-mode - (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (remove-hook 'after-change-functions #'font-lock-after-change-function t) (font-lock-unfontify-buffer) (font-lock-turn-off-thing-lock))) @@ -934,17 +934,17 @@ The value of this variable is used when Font Lock mode is turned on." (`jit-lock-mode ;; Prepare for jit-lock (remove-hook 'after-change-functions - 'font-lock-after-change-function t) + #'font-lock-after-change-function t) (set (make-local-variable 'font-lock-flush-function) - 'jit-lock-refontify) + #'jit-lock-refontify) (set (make-local-variable 'font-lock-ensure-function) - 'jit-lock-fontify-now) + #'jit-lock-fontify-now) ;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole ;; buffer. This is important for things like CWarn mode which ;; adds/removes a few keywords and does a refontify (which takes ages on ;; large files). (set (make-local-variable 'font-lock-fontify-buffer-function) - 'jit-lock-refontify) + #'jit-lock-refontify) ;; Don't fontify eagerly (and don't abort if the buffer is large). (set (make-local-variable 'font-lock-fontified) t) ;; Use jit-lock. @@ -952,7 +952,7 @@ The value of this variable is used when Font Lock mode is turned on." (not font-lock-keywords-only)) ;; Tell jit-lock how we extend the region to refontify. (add-hook 'jit-lock-after-change-extend-region-functions - 'font-lock-extend-jit-lock-region-after-change + #'font-lock-extend-jit-lock-region-after-change nil t)))) (defun font-lock-turn-off-thing-lock () @@ -1593,6 +1593,7 @@ START should be at the beginning of a line." "Put proper face on each string and comment between START and END. START should be at the beginning of a line." (syntax-propertize end) ; Apply any needed syntax-table properties. + (with-syntax-table (or syntax-ppss-table (syntax-table)) (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote @@ -1627,7 +1628,7 @@ START should be at the beginning of a line." font-lock-comment-delimiter-face)))) (< (point) end)) (setq state (parse-partial-sexp (point) end nil nil state - 'syntax-table))))) + 'syntax-table)))))) ;;; End of Syntactic fontification functions. @@ -1787,7 +1788,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for (mapcar #'font-lock-compile-keyword keywords)))) (if (and (not syntactic-keywords) (let ((beg-function syntax-begin-function)) - (or (eq beg-function 'beginning-of-defun) + (or (eq beg-function #'beginning-of-defun) (if (symbolp beg-function) (get beg-function 'font-lock-syntax-paren-check)))) (not beginning-of-defun-function)) @@ -1908,7 +1909,7 @@ Sets various variables using `font-lock-defaults' and (let ((syntax (cdr selem))) (dolist (char (if (numberp (car selem)) (list (car selem)) - (mapcar 'identity (car selem)))) + (mapcar #'identity (car selem)))) (modify-syntax-entry char syntax font-lock-syntax-table))))) ;; (nth 4 defaults) used to hold `font-lock-beginning-of-syntax-function', ;; but that was removed in 25.1, so if it's a cons cell, we assume that @@ -2171,7 +2172,7 @@ Sets various variables using `font-lock-defaults' and ;; ;; The default level is usually, but not necessarily, level 1. ;; (setq level (- (length keywords) ;; (length (member (eval (car keywords)) -;; (mapcar 'eval (cdr keywords)))))))) +;; (mapcar #'eval (cdr keywords)))))))) ;; (setq font-lock-fontify-level (list level (> level 1) ;; (< level (1- (length keywords)))))))) ;; diff --git a/lisp/frame.el b/lisp/frame.el index c3f621241ab..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,6 +2021,15 @@ 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" @@ -2031,12 +2039,18 @@ widths." "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. @@ -2048,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'. @@ -2066,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))) @@ -2115,14 +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 - ;; 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) - blink-cursor-delay - 'blink-cursor-start)))) + (blink-cursor--start-idle-timer))) (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") @@ -2153,14 +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 - ;; 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) - blink-cursor-delay - #'blink-cursor-start)))) + (blink-cursor--start-idle-timer))) + ;; Frame maximization/fullscreen @@ -2241,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/canlock.el b/lisp/gnus/canlock.el index b73d863f1c6..27b00da1e22 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -70,13 +70,6 @@ buffer does not look like a news message." :type 'boolean :group 'canlock) -(eval-when-compile - (defmacro canlock-string-as-unibyte (string) - "Return a unibyte string with the same individual bytes as STRING." - (if (fboundp 'string-as-unibyte) - (list 'string-as-unibyte string) - string))) - (defun canlock-sha1 (message) "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes." (let (sha1-maximum-internal-length) @@ -97,7 +90,7 @@ buffer does not look like a news message." (canlock-sha1 (concat opad (canlock-sha1 - (concat ipad (canlock-string-as-unibyte message-id)))))))) + (concat ipad (string-as-unibyte message-id)))))))) (defun canlock-narrow-to-header () "Narrow the buffer to the head of the message." diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index fca2394cbc7..61ef001beb9 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -97,34 +97,6 @@ ARGS are passed to `message'." (autoload 'widget-convert "wid-edit") (autoload 'widget-default-get "wid-edit") -;; Copy of the `nnmail-lazy' code from `nnmail.el': -(define-widget 'gmm-lazy 'default - "Base widget for recursive data structures. - -This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility." - :format "%{%t%}: %v" - :convert-widget 'widget-value-convert-widget - :value-create (lambda (widget) - (let ((value (widget-get widget :value)) - (type (widget-get widget :type))) - (widget-put widget :children - (list (widget-create-child-value - widget (widget-convert type) value))))) - :value-delete 'widget-children-value-delete - :value-get (lambda (widget) - (widget-value (car (widget-get widget :children)))) - :value-inline (lambda (widget) - (widget-apply (car (widget-get widget :children)) - :value-inline)) - :default-get (lambda (widget) - (widget-default-get - (widget-convert (widget-get widget :type)))) - :match (lambda (widget value) - (widget-apply (widget-convert (widget-get widget :type)) - :match value)) - :validate (lambda (widget) - (widget-apply (car (widget-get widget :children)) :validate))) - ;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs ;; version will provide customizable tool bar buttons using a different ;; interface. @@ -144,7 +116,7 @@ This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility." ;; ;; Then use (plist-get rs-command :none), (plist-get rs-command :shift) -(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) +(define-widget 'gmm-tool-bar-item 'lazy "Tool bar list item." :tag "Tool bar item" :type '(choice @@ -163,7 +135,7 @@ This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility." (const :tag "No map") (plist :inline t :tag "Properties")))) -(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) +(define-widget 'gmm-tool-bar-zap-list 'lazy "Tool bar zap list." :tag "Tool bar zap list" :type '(choice (const :tag "Zap all" t) @@ -193,28 +165,12 @@ This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility." :tag "Other" (symbol :tag "Icon item"))))) -;; (defun gmm-color-cells (&optional display) -;; "Return the number of color cells supported by DISPLAY. -;; Compatibility function." -;; ;; `display-color-cells' doesn't return more than 256 even if color depth is -;; ;; > 8 in Emacs 21. -;; ;; -;; ;; Feel free to add proper XEmacs support. -;; (let* ((cells (and (fboundp 'display-color-cells) -;; (display-color-cells display))) -;; (plane (and (fboundp 'x-display-planes) -;; (ash 1 (x-display-planes)))) -;; (none -1)) -;; (max (if (integerp cells) cells none) -;; (if (integerp plane) plane none)))) - (defcustom gmm-tool-bar-style (if (and (boundp 'tool-bar-mode) tool-bar-mode - (and (fboundp 'display-visual-class) - (not (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color))))) + (memq (display-visual-class) + (list 'static-gray 'gray-scale + 'static-color 'pseudo-color))) 'gnome 'retro) "Preferred tool bar style." @@ -242,15 +198,13 @@ item. When \\[describe-key] <icon> shows \"<tool-bar> <new-file> runs the command find-file\", then use `new-file' in ZAP-LIST. DEFAULT-MAP specifies the default key map for ICON-LIST." - (let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we - ;; could use some other local variable. - (tool-bar-map (if (eq zap-list t) - (make-sparse-keymap) - (copy-keymap tool-bar-map)))) + (let ((map (if (eq zap-list t) + (make-sparse-keymap) + (copy-keymap tool-bar-map)))) (when (listp zap-list) ;; Zap some items which aren't relevant for this mode and take up space. (dolist (key zap-list) - (define-key tool-bar-map (vector key) nil))) + (define-key map (vector key) nil))) (mapc (lambda (el) (let ((command (car el)) (icon (nth 1 el)) @@ -262,7 +216,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." ;; widget. Suppress tooltip by adding `:enable nil'. (if (fboundp 'tool-bar-local-item) (apply 'tool-bar-local-item icon nil nil - tool-bar-map :enable nil props) + map :enable nil props) ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS) ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) (apply 'tool-bar-add-item icon nil nil :enable nil props))) @@ -270,18 +224,18 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." (apply 'tool-bar-local-item icon command (intern icon) ;; reuse icon or fmap here? - tool-bar-map props)) + map props)) (t ;; A menu command (apply 'tool-bar-local-item-from-menu ;; (apply 'tool-bar-local-item icon def key ;; tool-bar-map props) - command icon tool-bar-map (symbol-value fmap) + command icon map (symbol-value fmap) props))) t)) (if (symbolp icon-list) (eval icon-list) icon-list)) - tool-bar-map)) + map)) (defmacro defun-gmm (name function arg-list &rest body) "Create function NAME. @@ -292,109 +246,6 @@ Otherwise, create function NAME with ARG-LIST and BODY." `(defalias ',name ',function) `(defun ,name ,arg-list ,@body)))) -(defun-gmm gmm-image-search-load-path - image-search-load-path (file &optional path) - "Emacs 21 and XEmacs don't have `image-search-load-path'. -This function returns nil on those systems." - nil) - -;; Cf. `mh-image-load-path-for-library' in `mh-compat.el'. - -(defun-gmm gmm-image-load-path-for-library - image-load-path-for-library (library image &optional path no-error) - "Return a suitable search path for images used by LIBRARY. - -It searches for IMAGE in `image-load-path' (excluding -\"`data-directory'/images\") and `load-path', followed by a path -suitable for LIBRARY, which includes \"../../etc/images\" and -\"../etc/images\" relative to the library file itself, and then -in \"`data-directory'/images\". - -Then this function returns a list of directories which contains -first the directory in which IMAGE was found, followed by the -value of `load-path'. If PATH is given, it is used instead of -`load-path'. - -If NO-ERROR is non-nil and a suitable path can't be found, don't -signal an error. Instead, return a list of directories as before, -except that nil appears in place of the image directory. - -Here is an example that uses a common idiom to provide -compatibility with versions of Emacs that lack the variable -`image-load-path': - - ;; Shush compiler. - (defvar image-load-path) - - (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) - (image-load-path (cons (car load-path) - (when (boundp \\='image-load-path) - image-load-path)))) - (mh-tool-bar-folder-buttons-init))" - (unless library (error "No library specified")) - (unless image (error "No image specified")) - (let (image-directory image-directory-load-path) - ;; Check for images in image-load-path or load-path. - (let ((img image) - (dir (or - ;; Images in image-load-path. - (gmm-image-search-load-path image) ;; "gmm-" prefix! - ;; Images in load-path. - (locate-library image))) - parent) - ;; Since the image might be in a nested directory (for - ;; example, mail/attach.pbm), adjust `image-directory' - ;; accordingly. - (when dir - (setq dir (file-name-directory dir)) - (while (setq parent (file-name-directory img)) - (setq img (directory-file-name parent) - dir (expand-file-name "../" dir)))) - (setq image-directory-load-path dir)) - - ;; If `image-directory-load-path' isn't Emacs's image directory, - ;; it's probably a user preference, so use it. Then use a - ;; relative setting if possible; otherwise, use - ;; `image-directory-load-path'. - (cond - ;; User-modified image-load-path? - ((and image-directory-load-path - (not (equal image-directory-load-path - (file-name-as-directory - (expand-file-name "images" data-directory))))) - (setq image-directory image-directory-load-path)) - ;; Try relative setting. - ((let (library-name d1ei d2ei) - ;; First, find library in the load-path. - (setq library-name (locate-library library)) - (if (not library-name) - (error "Cannot find library %s in load-path" library)) - ;; And then set image-directory relative to that. - (setq - ;; Go down 2 levels. - d2ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../../etc/images"))) - ;; Go down 1 level. - d1ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../etc/images")))) - (setq image-directory - ;; Set it to nil if image is not found. - (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) - ((file-exists-p (expand-file-name image d1ei)) d1ei))))) - ;; Use Emacs's image directory. - (image-directory-load-path - (setq image-directory image-directory-load-path)) - (no-error - (message "Could not find image %s for library %s" image library)) - (t - (error "Could not find image %s for library %s" image library))) - - ;; Return an augmented `path' or `load-path'. - (nconc (list image-directory) - (delete image-directory (copy-sequence (or path load-path)))))) - (defun gmm-customize-mode (&optional mode) "Customize customization group for MODE. If mode is nil, use `major-mode' of the current buffer." @@ -405,75 +256,8 @@ If mode is nil, use `major-mode' of the current buffer." (string-match "^\\(.+\\)-mode$" mode) (match-string 1 mode)))))) -(defun gmm-write-region (start end filename &optional append visit - lockname mustbenew) - "Compatibility function for `write-region'. - -In XEmacs, the seventh argument of `write-region' specifies the -coding-system." - (if (and mustbenew (featurep 'xemacs)) - (if (file-exists-p filename) - (signal 'file-already-exists (list "File exists" filename)) - (write-region start end filename append visit lockname)) - (write-region start end filename append visit lockname mustbenew))) - -;; `interactive-p' is obsolete since Emacs 23.2. -(defmacro gmm-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p)))) - -;; `labels' is obsolete since Emacs 24.3. -(defmacro gmm-labels (bindings &rest body) - "Make temporary function bindings. -The bindings can be recursive and the scoping is lexical, but capturing -them in closures will only work if `lexical-binding' is in use. But in -Emacs 24.2 and older, the lexical scoping is handled via `lexical-let' -rather than relying on `lexical-binding'. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" - `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) - ,bindings ,@body)) -(put 'gmm-labels 'lisp-indent-function 1) -(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form)) - -(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 t))) +(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 80753c11813..e6356b1d122 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -30,10 +30,8 @@ (require 'gnus-score) (require 'gnus-srvr) (require 'gnus-util) +(require 'timer) (eval-when-compile - (if (featurep 'xemacs) - (require 'itimer) - (require 'timer)) (require 'cl)) (autoload 'gnus-server-update-server "gnus-srvr") @@ -82,28 +80,16 @@ If nil, only read articles will be expired." :group 'gnus-agent :type 'hook) -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add)) - (defcustom gnus-agent-summary-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add)) - (defcustom gnus-agent-server-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add)) - (defcustom gnus-agent-confirmation-function 'y-or-n-p "Function to confirm when error happens." :version "21.1" @@ -175,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." @@ -252,16 +238,6 @@ NOTES: (defvar gnus-headers) (defvar gnus-score) -;; Added to support XEmacs -(eval-and-compile - (unless (fboundp 'directory-files-and-attributes) - (defun directory-files-and-attributes (directory - &optional full match nosort) - (let (result) - (dolist (file (directory-files directory full match nosort)) - (push (cons file (file-attributes file)) result)) - (nreverse result))))) - ;;; ;;; Setup ;;; @@ -571,19 +547,9 @@ manipulated as follows: ["Remove" gnus-agent-remove-server t])))) (defun gnus-agent-make-mode-line-string (string mouse-button mouse-func) - (if (and (fboundp 'propertize) - (fboundp 'make-mode-line-mouse-map)) - (propertize string 'local-map - (make-mode-line-mouse-map mouse-button mouse-func) - 'mouse-face - (if (and (featurep 'xemacs) - ;; XEmacs's `facep' only checks for a face - ;; object, not for a face name, so it's useless - ;; to check with `facep'. - (find-face 'modeline)) - 'modeline - 'mode-line-highlight)) - string)) + (propertize string 'local-map + (make-mode-line-mouse-map mouse-button mouse-func) + 'mouse-face 'mode-line-highlight)) (defun gnus-agent-toggle-plugged (set-to) "Toggle whether Gnus is unplugged or not." @@ -868,7 +834,7 @@ be a select method." (not (eq gnus-agent-synchronize-flags 'ask))) (and (eq gnus-agent-synchronize-flags 'ask) (gnus-y-or-n-p - (gnus-format-message + (format-message "Synchronize flags on server `%s'? " (cadr method)))))) (gnus-agent-synchronize-flags-server method))) @@ -2667,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) @@ -2713,7 +2681,7 @@ The following commands are available: (let* ((gnus-tmp-name (format "%s" (car category))) (gnus-tmp-groups (length (gnus-agent-cat-groups category)))) (beginning-of-line) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) ;; Insert the text. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 67e604910ab..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." @@ -266,19 +266,12 @@ This can also be a list of the above values." ;; Fixme: This isn't the right thing for mixed graphical and non-graphical ;; frames in a session. (defcustom gnus-article-x-face-command - (if (featurep 'xemacs) - (if (or (gnus-image-type-available-p 'xface) - (gnus-image-type-available-p 'pbm)) - 'gnus-display-x-face-in-from - "{ echo \ + (if (gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from + "{ echo \ '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\ -; uncompface; } | icontopbm | ee -") - (if (gnus-image-type-available-p 'pbm) - 'gnus-display-x-face-in-from - "{ 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. +; uncompface; } | icontopbm | display -") + "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 @@ -396,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) @@ -484,9 +477,7 @@ and the latter avoids underlining any whitespace at all." Example: (_/*word*/_)." :group 'gnus-article-emphasis) -(defface gnus-emphasis-strikethru (if (featurep 'xemacs) - '((t (:strikethru t))) - '((t (:strike-through t)))) +(defface gnus-emphasis-strikethru '((t (:strike-through t))) "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) @@ -507,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." @@ -515,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 @@ -662,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: @@ -688,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: @@ -707,24 +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) -(when (featurep 'xemacs) - ;; Extracted from gnus-xmas-define in order to preserve user settings - (when (fboundp 'turn-off-scroll-in-place) - (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) - ;; Extracted from gnus-xmas-redefine in order to preserve user settings - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) - (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) @@ -862,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). @@ -883,10 +867,8 @@ be displayed by the first non-nil matching CONTENT face." (item :tag "skip" nil) (face :value default))))) -(defcustom gnus-face-properties-alist (if (featurep 'xemacs) - '((xface . (:face gnus-x-face))) - '((pbm . (:face gnus-x-face)) - (png . nil))) +(defcustom gnus-face-properties-alist '((pbm . (:face gnus-x-face)) + (png . nil)) "Alist of image types and properties applied to Face and X-Face images. Here are examples: @@ -902,8 +884,7 @@ Here are examples: See the manual for the valid properties for various image types. Currently, `pbm' is used for X-Face images and `png' is used for Face -images in Emacs. Only the `:face' property is effective on the `xface' -image type in XEmacs if it is built with the libcompface library." +images in Emacs." :version "23.1" ;; No Gnus :group 'gnus-article-headers :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) @@ -911,7 +892,7 @@ image type in XEmacs if it is built with the libcompface library." (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) @@ -1412,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'." @@ -1426,14 +1407,12 @@ predicate. See Info node `(gnus)Customizing Articles'." (defcustom gnus-treat-display-x-face (and (not noninteractive) (gnus-image-type-available-p 'xbm) - (if (featurep 'xemacs) - (featurep 'xface) - (condition-case nil - (and (string-match "^0x" (shell-command-to-string "uncompface")) - (executable-find "icontopbm")) - ;; shell-command-to-string may signal an error, e.g. if - ;; shell-file-name is not found. - (error nil))) + (condition-case nil + (and (string-match "^0x" (shell-command-to-string "uncompface")) + (executable-find "icontopbm")) + ;; shell-command-to-string may signal an error, e.g. if + ;; shell-file-name is not found. + (error nil)) 'head) "Display X-Face headers. Valid values are nil and `head'. @@ -1631,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) @@ -2087,7 +2057,7 @@ always hide." (- gnus-article-normalized-header-length column) ? ))) ((> column gnus-article-normalized-header-length) - (gnus-put-text-property + (put-text-property (progn (forward-char gnus-article-normalized-header-length) (point)) @@ -2117,21 +2087,17 @@ try this wash." "Translate many Unicode characters into their ASCII equivalents." (interactive) (require 'org-entities) - (let ((table (make-char-table (if (featurep 'xemacs) 'generic)))) + (let ((table (make-char-table nil))) (dolist (elem org-entities) (when (and (listp elem) (= (length (nth 6 elem)) 1)) - (if (featurep 'xemacs) - (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table) - (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))) + (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))) (save-excursion (when (article-goto-body) (let ((inhibit-read-only t) replace props) (while (not (eobp)) - (if (not (setq replace (if (featurep 'xemacs) - (get-char-table (following-char) table) - (aref table (following-char))))) + (if (not (setq replace (aref table (following-char)))) (forward-char 1) (if (prog1 (setq props (text-properties-at (point))) @@ -2314,8 +2280,6 @@ long lines if and only if arg is positive." (setq truncate-lines nil)) ((numberp arg) (setq truncate-lines t))) - ;; In versions of Emacs 22 (CVS) before 2006-05-26, - ;; `toggle-truncate-lines' needs an argument. (toggle-truncate-lines))) (defun gnus-article-treat-body-boundary () @@ -2327,15 +2291,13 @@ long lines if and only if arg is positive." (goto-char (point-max)) (let ((start (point))) (insert "X-Boundary: ") - (gnus-add-text-properties start (point) gnus-hidden-properties) + (add-text-properties start (point) gnus-hidden-properties) (insert (let (str (max (window-width))) - (if (featurep 'xemacs) - (setq max (1- max))) (while (>= max (length str)) (setq str (concat str gnus-body-boundary-delimiter))) (substring str 0 max)) "\n") - (gnus-put-text-property start (point) 'gnus-decoration 'header))))) + (put-text-property start (point) 'gnus-decoration 'header))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." @@ -2492,7 +2454,7 @@ long lines if and only if arg is positive." ;; The command is a string, so we interpret the command ;; as a, well, command, and fork it off. (let ((process-connection-type nil)) - (gnus-set-process-query-on-exit-flag + (set-process-query-on-exit-flag (start-process "article-x-face" nil shell-file-name shell-command-switch gnus-article-x-face-command) @@ -2541,7 +2503,7 @@ If PROMPT (the prefix), prompt for a coding system to use." ctl (and ct (mail-header-parse-content-type ct)) charset (cond (prompt - (mm-read-coding-system "Charset to decode: ")) + (read-coding-system "Charset to decode: ")) (ctl (mail-content-type-get ctl 'charset))) format (and ctl (mail-content-type-get ctl 'format))) @@ -2620,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:, @@ -2639,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))))))))) @@ -2662,7 +2622,7 @@ If READ-CHARSET, ask for a coding system." (if (stringp charset) (setq charset (intern (downcase charset))))))) (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) + (setq charset (read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -2690,7 +2650,7 @@ If READ-CHARSET, ask for a coding system." (if (stringp charset) (setq charset (intern (downcase charset))))))) (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) + (setq charset (read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -2700,12 +2660,11 @@ If READ-CHARSET, ask for a coding system." (save-restriction (narrow-to-region (point) (point-max)) (base64-decode-region (point-min) (point-max)) - (mm-decode-coding-region + (decode-coding-region (point-min) (point-max) (mm-charset-to-coding-system charset nil t))))))) -(eval-when-compile - (require 'rfc1843)) +(declare-function rfc1843-decode-region "rfc1843" (from to)) (defun article-decode-HZ () "Translate a HZ-encoded article." @@ -2724,7 +2683,7 @@ If READ-CHARSET, ask for a coding system." (while (re-search-forward "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) - (when (gmm-called-interactively-p 'any) + (when (called-interactively-p 'any) (gnus-treat-article nil)))) (defun article-wash-html () @@ -2777,7 +2736,7 @@ summary buffer." (cond ((file-directory-p file) (when (or (not (eq how 'file)) (gnus-y-or-n-p - (gnus-format-message + (format-message "Delete temporary HTML file(s) in directory `%s'? " (file-name-as-directory file)))) (gnus-delete-directory file))) @@ -2883,7 +2842,7 @@ message header will be added to the bodies of the \"text/html\" parts." <img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\"" nil t) (unless cid-dir - (setq cid-dir (mm-make-temp-file "cid" t)) + (setq cid-dir (make-temp-file "cid" t)) (add-to-list 'gnus-article-browse-html-temp-list cid-dir)) (setq file nil content nil) @@ -2896,7 +2855,7 @@ message header will be added to the bodies of the \"text/html\" parts." (replace-match cid-file nil nil nil 1)))) (unless content (setq content (buffer-string)))) (when (or charset header (not file)) - (setq tmp-file (mm-make-temp-file + (setq tmp-file (make-temp-file ;; Do we need to care for 8.3 filenames? "mm-" nil ".html"))) ;; Add a meta html tag to specify charset and a header. @@ -2930,11 +2889,11 @@ message header will be added to the bodies of the \"text/html\" parts." ;; charset specified in parts might be different. (if (eq charset 'gnus-decoded) (setq charset 'utf-8 - eheader (mm-encode-coding-string (buffer-string) - charset) + eheader (encode-coding-string (buffer-string) + charset) title (when title - (mm-encode-coding-string title charset)) - body (mm-encode-coding-string content charset)) + (encode-coding-string title charset)) + body (encode-coding-string content charset)) (setq hcharset (mm-find-mime-charset-region (point-min) (point-max))) (cond ((= (length hcharset) 1) @@ -2951,30 +2910,30 @@ message header will be added to the bodies of the \"text/html\" parts." (mm-charset-to-coding-system charset nil t)) (if (eq coding body) - (setq eheader (mm-encode-coding-string + (setq eheader (encode-coding-string (buffer-string) coding) title (when title - (mm-encode-coding-string + (encode-coding-string title coding)) body content) (setq charset 'utf-8 - eheader (mm-encode-coding-string + eheader (encode-coding-string (buffer-string) charset) title (when title - (mm-encode-coding-string + (encode-coding-string title charset)) - body (mm-encode-coding-string - (mm-decode-coding-string + body (encode-coding-string + (decode-coding-string content body) charset)))) (setq charset hcharset - eheader (mm-encode-coding-string + eheader (encode-coding-string (buffer-string) coding) title (when title - (mm-encode-coding-string + (encode-coding-string title coding)) body content)) - (setq eheader (mm-string-as-unibyte (buffer-string)) + (setq eheader (string-as-unibyte (buffer-string)) body content))) (erase-buffer) (mm-disable-multibyte) @@ -2997,8 +2956,8 @@ message header will be added to the bodies of the \"text/html\" parts." (charset (mm-with-unibyte-buffer (insert (if (eq charset 'gnus-decoded) - (mm-encode-coding-string content - (setq charset 'utf-8)) + (encode-coding-string content + (setq charset 'utf-8)) content)) (if (or (mm-add-meta-html-tag handle charset) (not file)) @@ -3637,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)))) @@ -4161,8 +4120,7 @@ and the raw article including all headers will be piped." (setq command (if (and (eq command 'default) default) default - (gnus-read-shell-command "Shell command on this article: " - default)))) + (read-shell-command "Shell command on this article: " default)))) (when (string-equal command "") (if default (setq command default) @@ -4326,8 +4284,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put-text-property (match-end 0) (point-max) 'face eface))))))))) -(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs. - (defun article-verify-cancel-lock () "Verify Cancel-Lock header." (interactive) @@ -4440,13 +4396,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) (defvar gnus-article-send-map) - (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) - "W" gnus-article-wide-reply-with-original) -(if (featurep 'xemacs) - (set-keymap-default-binding gnus-article-send-map - 'gnus-article-read-summary-send-keys) - (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys)) + "W" gnus-article-wide-reply-with-original + [t] gnus-article-read-summary-send-keys) (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) @@ -4522,8 +4474,8 @@ commands: (make-local-variable 'gnus-article-ignored-charsets) (set (make-local-variable 'bookmark-make-record-function) 'gnus-summary-bookmark-make-record) - ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space' - ;; face. + ;; Prevent Emacs from displaying non-break space with + ;; `nobreak-space' face. (set (make-local-variable 'nobreak-char-display) nil) ;; Enable `gnus-article-remove-images' to delete images shr.el renders. (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image) @@ -4602,7 +4554,7 @@ commands: (defun gnus-article-stop-animations () (dolist (timer (and (boundp 'timer-list) timer-list)) - (when (eq (gnus-timer--function timer) 'image-animate-timeout) + (when (eq (timer--function timer) 'image-animate-timeout) (cancel-timer timer)))) (defun gnus-stop-downloads () @@ -4645,8 +4597,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) + (when transient-mark-mode (setq mark-active nil)) (if (not (setq result (let ((inhibit-read-only t)) (gnus-request-article-this-buffer @@ -4906,8 +4857,8 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) + (define-key map [mouse-2] 'gnus-article-push-button) + (define-key map [down-mouse-3] 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -5050,7 +5001,6 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) `(lambda (no-highlight) (let ((mail-parse-charset (or gnus-article-charset @@ -5294,7 +5244,7 @@ are decompressed." ((numberp arg) (setq charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))))) + (read-coding-system "Charset: "))))) (switch-to-buffer (generate-new-buffer filename)) (if (or coding-system (and charset @@ -5303,11 +5253,8 @@ are decompressed." (not (eq coding-system 'ascii)))) (progn (mm-enable-multibyte) - (insert (mm-decode-coding-string contents coding-system)) - (setq buffer-file-coding-system - (if (boundp 'last-coding-system-used) - (symbol-value 'last-coding-system-used) - coding-system))) + (insert (decode-coding-string contents coding-system)) + (setq buffer-file-coding-system last-coding-system-used)) (mm-disable-multibyte) (insert contents) (setq buffer-file-coding-system mm-binary-coding-system)) @@ -5325,7 +5272,7 @@ are decompressed." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) + (file (make-temp-file (expand-file-name "mm." mm-tmp-directory))) (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) (when contents (if printer @@ -5394,18 +5341,9 @@ Compressed files like .gz and .bz2 are decompressed." (let ((displayed-p (mm-handle-displayed-p handle))) (gnus-insert-mime-button handle (get-text-property btn 'gnus-part) (list displayed-p)) - (if (featurep 'emacs) - (delete-region - (point) - (next-single-property-change (point) 'gnus-data nil (point-max))) - (let* ((end (next-single-property-change (point) 'gnus-data)) - (annots (annotations-at (or end (point-max))))) - (delete-region (point) - (if end - (if annots (1+ end) end) - (point-max))) - (dolist (annot annots) - (set-extent-endpoints annot (point) (point))))) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) (setq start (point)) (if (search-backward "\n\n" nil t) (progn @@ -5466,7 +5404,7 @@ specified charset." (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: ")))) + (read-coding-system "Charset: ")))) (if (mm-handle-undisplayer handle) (mm-remove-part handle))) (gnus-mime-set-charset-parameters handle charset) @@ -5581,7 +5519,7 @@ If INTERACTIVE, call FUNCTION interactively." window (setq window (selected-window)) ;; Article may be displayed in the other frame. - (gnus-select-frame-set-input-focus + (select-frame-set-input-focus (prog1 frame (setq frame (selected-frame)))))) @@ -5609,7 +5547,7 @@ If INTERACTIVE, call FUNCTION interactively." (get-text-property (point) 'gnus-data)))) (set-marker overlay-arrow-position nil) (unless gnus-auto-select-part - (gnus-select-frame-set-input-focus frame) + (select-frame-set-input-focus frame) (select-window window)))) t)) (if gnus-inhibit-mime-unbuttonizing @@ -5788,18 +5726,9 @@ all parts." ;; Toggle the button appearance between `[button]...' and `[button]'. (let ((displayed-p (mm-handle-displayed-p handle))) (gnus-insert-mime-button handle id (list displayed-p)) - (if (featurep 'emacs) - (delete-region - (point) - (next-single-property-change (point) 'gnus-data nil (point-max))) - (let* ((end (next-single-property-change (point) 'gnus-data)) - (annots (annotations-at (or end (point-max))))) - (delete-region (point) - (if end - (if annots (1+ end) end) - (point-max))) - (dolist (annot annots) - (set-extent-endpoints annot (point) (point))))) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) (setq start (point)) (if (search-backward "\n\n" nil t) (progn @@ -5910,16 +5839,12 @@ all parts." :button-keymap gnus-mime-button-map :help-echo (lambda (widget) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (if (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) (format "%S: %s the MIME part; %S: more options" - (aref gnus-mouse-2 0) + 'mouse-2 (if (mm-handle-displayed-p (widget-get widget :mime-handle)) "hide" "show") - (aref gnus-down-mouse-3 0)))))) + 'down-mouse-3))))) (defun gnus-widget-press-button (elems _el) (goto-char (widget-get elems :from)) @@ -6164,8 +6089,7 @@ If nil, don't show those extra buttons." (defun gnus-article-insert-newline () "Insert a newline, but mark it as undeletable." - (gnus-put-text-property - (point) (progn (insert "\n") (point)) 'gnus-undeletable t)) + (put-text-property (point) (progn (insert "\n") (point)) 'gnus-undeletable t)) (defun gnus-mime-display-alternative (handles &optional preferred ibegend id) (let* ((preferred (or preferred (mm-preferred-alternative handles))) @@ -6191,7 +6115,7 @@ If nil, don't show those extra buttons." (not preferred) (not (gnus-unbuttonized-mime-type-p "multipart/alternative"))) - (gnus-add-text-properties + (add-text-properties (setq from (point)) (progn (insert (format "%d. " id)) @@ -6204,17 +6128,16 @@ If nil, don't show those extra buttons." (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) keymap ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face + mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id article-type multipart rear-nonsticky t)) (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) + :action 'gnus-widget-press-button) ;; Do the handles (while (setq handle (pop handles)) - (gnus-add-text-properties + (add-text-properties (setq from (point)) (progn (insert (format "(%c) %-18s" @@ -6229,14 +6152,13 @@ If nil, don't show those extra buttons." (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) keymap ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face + mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id gnus-data ,handle rear-nonsticky t)) (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) + :action 'gnus-widget-press-button) (insert " ")) (insert "\n\n")) (when preferred @@ -6350,7 +6272,7 @@ Provided for backwards compatibility." (not (with-current-buffer gnus-summary-buffer gnus-have-all-headers))) (not gnus-inhibit-hiding)) - (gnus-article-hide-headers))) + (article-hide-headers))) (declare-function shr-put-image "shr" (data alt &optional flags)) @@ -6506,14 +6428,13 @@ the coding cookie." (when coding ;; If the coding system is not suitable to encode the text, ;; ask a user for a proper one. - (when (fboundp 'select-safe-coding-system) - (setq coding (coding-system-base - (save-window-excursion - (select-safe-coding-system (point-min) (point-max) - coding)))) - (setq coding-system-for-write - (or (cdr (assq coding '((mule-utf-8 . utf-8)))) - coding))) + (setq coding (coding-system-base + (save-window-excursion + (select-safe-coding-system (point-min) (point-max) + coding)))) + (setq coding-system-for-write + (or (cdr (assq coding '((mule-utf-8 . utf-8)))) + coding)) (goto-char (point-min)) ;; Add the coding cookie. (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n" @@ -6584,14 +6505,14 @@ If given a numerical ARG, move forward ARG pages." (interactive) (when (gnus-article-next-page) (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (gnus-article-read-summary-keys nil ?n))) (defun gnus-article-goto-prev-page () "Show the previous page of the article." (interactive) (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer? - (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) + (gnus-article-read-summary-keys nil ?p) (gnus-article-prev-page nil))) ;; This is cleaner but currently breaks `gnus-pick-mode': @@ -6613,12 +6534,10 @@ If given a numerical ARG, move forward ARG pages." If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." (interactive "p") - (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin))) + (move-to-window-line (- -1 scroll-margin)) (if (and (not (and gnus-article-over-scroll (> (count-lines (window-start) (point-max)) - (if (featurep 'xemacs) - (or lines (1- (window-height))) - (+ (or lines (1- (window-height))) scroll-margin))))) + (+ (or lines (1- (window-height))) scroll-margin)))) (save-excursion (end-of-line) (and (pos-visible-in-window-p) ;Not continuation line. @@ -6642,20 +6561,18 @@ Argument LINES specifies lines to be scrolled up." (defun gnus-article-beginning-of-window () "Move point to the beginning of the window. -In Emacs, the point is placed at the line number which `scroll-margin' +The point is placed at the line number which `scroll-margin' specifies." - (if (featurep 'xemacs) - (move-to-window-line 0) - ;; There is an obscure bug in Emacs that makes it impossible to - ;; scroll past big pictures in the article buffer. Try to fix - ;; this by adding a sanity check by counting the lines visible. - (when (> (count-lines (window-start) (window-end)) 30) - (move-to-window-line - (min (max 0 scroll-margin) - (max 1 (- (window-height) - (if mode-line-format 1 0) - (if header-line-format 1 0) - 2))))))) + ;; There is an obscure bug in Emacs that makes it impossible to + ;; scroll past big pictures in the article buffer. Try to fix + ;; this by adding a sanity check by counting the lines visible. + (when (> (count-lines (window-start) (window-end)) 30) + (move-to-window-line + (min (max 0 scroll-margin) + (max 1 (- (window-height) + (if mode-line-format 1 0) + (if header-line-format 1 0) + 2)))))) (defvar scroll-in-place) @@ -6682,10 +6599,7 @@ Argument LINES specifies lines to be scrolled down." (goto-char (point-max)) (recenter (if gnus-article-over-scroll (if lines - (max (if (featurep 'xemacs) - lines - (+ lines scroll-margin)) - 3) + (max (+ lines scroll-margin) 3) (- (window-height) 2)) -1))) (prog1 @@ -6766,9 +6680,7 @@ not have a face in `gnus-article-boring-faces'." (let (gnus-pick-mode) (setq unread-command-events (nconc unread-command-events (list (or key last-command-event))) - keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil t)) - (read-key-sequence nil t))))) + keys (read-key-sequence nil t)))) (message "") @@ -6816,7 +6728,7 @@ not have a face in `gnus-article-boring-faces'." (article 1.0))))))) (gnus-configure-windows 'article)) (setq win (get-buffer-window summary-buffer 'visible))) - (gnus-select-frame-set-input-focus (window-frame win)) + (select-frame-set-input-focus (window-frame win)) (select-window win)))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. @@ -6869,27 +6781,25 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-read-summary-send-keys () (interactive) - (let ((unread-command-events (list (gnus-character-to-event ?S)))) + (let ((unread-command-events (list ?S))) (gnus-article-read-summary-keys))) (defun gnus-article-describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string or a vector." - (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. + (interactive (list (let ((cursor-in-echo-area t)) (read-key-sequence "Describe key: ")))) (gnus-article-check-buffer) (if (memq (key-binding key t) '(gnus-article-read-summary-keys gnus-article-read-summary-send-keys)) (with-current-buffer gnus-article-current-summary (setq unread-command-events - (if (featurep 'xemacs) - (append key unread-command-events) - (nconc - (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) - (list 'meta (- x 128)) - x)) - key) - unread-command-events))) + (nconc + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key) + unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) (describe-key (read-key-sequence nil t)))) @@ -6898,7 +6808,7 @@ KEY is a string or a vector." (defun gnus-article-describe-key-briefly (key &optional insert) "Display documentation of the function invoked by KEY. KEY is a string or a vector." - (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. + (interactive (list (let ((cursor-in-echo-area t)) (read-key-sequence "Describe key: ")) current-prefix-arg)) (gnus-article-check-buffer) @@ -6906,14 +6816,12 @@ KEY is a string or a vector." gnus-article-read-summary-send-keys)) (with-current-buffer gnus-article-current-summary (setq unread-command-events - (if (featurep 'xemacs) - (append key unread-command-events) - (nconc - (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) - (list 'meta (- x 128)) - x)) - key) - unread-command-events))) + (nconc + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key) + unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) (describe-key-briefly (read-key-sequence nil t) insert))) @@ -6987,13 +6895,12 @@ the entire article will be yanked." (interactive) (let ((article (cdr gnus-article-current)) contents) - (if (not (gnus-region-active-p)) + (if (not (and transient-mark-mode mark-active)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply (list (list article)) wide)) (setq contents (buffer-substring (point) (mark t))) ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) + (when transient-mark-mode (setq mark-active nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply @@ -7013,13 +6920,12 @@ the entire article will be yanked." (interactive) (let ((article (cdr gnus-article-current)) contents) - (if (not (gnus-region-active-p)) + (if (not (and transient-mark-mode mark-active)) (with-current-buffer gnus-summary-buffer (gnus-summary-followup (list (list article)))) (setq contents (buffer-substring (point) (mark t))) ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) + (when transient-mark-mode (setq mark-active nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-followup @@ -7031,10 +6937,11 @@ This means that signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." (interactive (append (gnus-article-hidden-arg) (list 'force))) - (gnus-article-hide-headers arg) - (gnus-article-hide-list-identifiers arg) - (gnus-article-hide-citation-maybe arg force) - (gnus-article-hide-signature arg)) + (gnus-with-article-buffer + (article-hide-headers arg) + (article-hide-list-identifiers) + (gnus-article-hide-citation-maybe arg force) + (article-hide-signature arg))) (defun gnus-check-group-server () ;; Make sure the connection to the server is alive. @@ -7120,7 +7027,7 @@ If given a prefix, show the hidden text instead." ;; equivalent of string-make-multibyte which amount to decoding ;; with locale-coding-system, causing failure of ;; subsequent decoding. - (insert (mm-string-to-multibyte + (insert (string-to-multibyte (with-current-buffer gnus-original-article-buffer (buffer-substring (point-min) (point-max))))) 'article) @@ -7338,7 +7245,8 @@ groups." (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) - (gnus-article-date-original) + (gnus-with-article-buffer + (article-date-original)) (gnus-article-edit-article 'ignore `(lambda (no-highlight) @@ -7441,31 +7349,26 @@ groups." "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|" "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)" "\\(//[-a-z0-9_.]+:[0-9]*\\)?" - (if (string-match "[[:digit:]]" "1") ;; Support POSIX? - (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") - (punct "!?:;.,")) - (concat - "\\(?:" - ;; Match paired parentheses, e.g. in Wikipedia URLs: - ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com - "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" - "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" - "\\|" - "[" chars punct "]+" "[" chars "]" - "\\)")) - (concat ;; XEmacs 21.4 doesn't support POSIX. - "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" - "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) + (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") + (punct "!?:;.,")) + (concat + "\\(?:" + ;; Match paired parentheses, e.g. in Wikipedia URLs: + ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com + "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" + "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" + "\\|" + "[" chars punct "]+" "[" chars "]" + "\\)")) "\\)") "Regular expression that matches URLs." :version "24.4" :group 'gnus-article-buttons :type 'regexp) -(defcustom gnus-button-valid-fqdn-regexp - message-valid-fqdn-regexp +(defcustom gnus-button-valid-fqdn-regexp "\\([-A-Za-z0-9]+\\.\\)+[A-Za-z]+" "Regular expression that matches a valid FQDN." - :version "22.1" + :version "26.1" :group 'gnus-article-buttons :type 'regexp) @@ -7582,7 +7485,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (list gnus-button-mid-or-mail-heuristic-alist) (result 0) rate regexp lpartlen elem) (setq lpartlen - (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) + (length (replace-regexp-in-string "^\\(.*\\)@.*$" "\\1" mid-or-mail))) (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) ;; Certain special cases... (when (string-match @@ -7653,7 +7556,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (setq guessed ;; get rid of surrounding angles... (funcall pref - (gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) + (replace-regexp-in-string "^<\\|>$" "" mid-or-mail))) (if (or (eq 'mid guessed) (eq 'mail guessed)) (setq pref guessed) (setq pref 'ask))) @@ -7685,13 +7588,13 @@ as a symbol to FUN." "Call `describe-function' when pushing the corresponding URL button." (describe-function (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))) (defun gnus-button-handle-describe-variable (url) "Call `describe-variable' when pushing the corresponding URL button." (describe-variable (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))) (defun gnus-button-handle-symbol (url) "Display help on variable or function. @@ -7705,7 +7608,7 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-describe-key (url) "Call `describe-key' when pushing the corresponding URL button." (let* ((key-string - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)) (keys (ignore-errors (eval `(kbd ,key-string))))) (if keys (describe-key keys) @@ -7713,36 +7616,34 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-apropos (url) "Call `apropos' when pushing the corresponding URL button." - (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (apropos (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-command (url) "Call `apropos' when pushing the corresponding URL button." (apropos-command - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-variable (url) "Call `apropos' when pushing the corresponding URL button." - (funcall - (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (apropos-variable + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-apropos-documentation (url) "Call `apropos' when pushing the corresponding URL button." - (funcall - (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (apropos-documentation + (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))) (defun gnus-button-handle-library (url) "Call `locate-library' when pushing the corresponding URL button." (gnus-message 9 "url=`%s'" url) (let* ((lib (locate-library url)) - (file (gnus-replace-in-string (or lib "") "\\.elc" ".el"))) + (file (replace-regexp-in-string "\\.elc" ".el" (or lib "")))) (if (not lib) (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. @@ -7754,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 @@ -7766,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, ... @@ -7775,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' @@ -7896,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 @@ -7938,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: @@ -8030,14 +7931,14 @@ do the highlighting. See the documentation for those functions." (when (and header-face (not (memq (point) hpoints))) (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) + (put-text-property from (point) 'face header-face)) (when (and field-face (not (memq (setq from (point)) fpoints))) (push from fpoints) (if (re-search-forward "^[^ \t]" nil t) (forward-char -2) (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face))))))) + (put-text-property from (point) 'face field-face))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. @@ -8092,7 +7993,7 @@ specified by `gnus-button-alist'." (gnus-article-extend-url-button from start end)) (gnus-article-add-button start end 'gnus-button-push (list from entry)) - (gnus-put-text-property + (put-text-property start end 'gnus-string (buffer-substring-no-properties start end)))))))))) @@ -8194,16 +8095,15 @@ url is put as the `gnus-button-url' overlay property on the button." (when gnus-article-button-face (overlay-put (make-overlay from to nil t) 'face gnus-article-button-face)) - (gnus-add-text-properties + (add-text-properties from to (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) + (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data)))) (widget-convert-button 'link from to :action 'gnus-widget-press-button :help-echo (or text "Follow the link") - :keymap gnus-url-button-map - :button-keymap gnus-widget-button-keymap)) + :keymap gnus-url-button-map)) (defun gnus-article-copy-string () "Copy the string in the button to the kill ring." @@ -8335,13 +8235,13 @@ url is put as the `gnus-button-url' overlay property on the button." "Fetch a man page." (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (when (eq gnus-button-man-handler 'woman) - (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" ""))) + (setq url (replace-regexp-in-string "([1-9][X1a-z]*).*\\'" "" url))) (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (funcall gnus-button-man-handler url)) (defun gnus-button-handle-info-url (url) "Fetch an info URL." - (setq url (mm-subst-char-in-string ?+ ?\ url)) + (setq url (subst-char-in-string ?+ ?\ url)) (cond ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) (gnus-info-find-node @@ -8350,14 +8250,14 @@ url is put as the `gnus-button-url' overlay property on the button." ")" (gnus-url-unhex-string (match-string 2 url))))) ((string-match "([^)\"]+)[^\"]+" url) (setq url - (gnus-replace-in-string - (gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) + (replace-regexp-in-string + "\"" "" (replace-regexp-in-string "[\n\t ]+" " " url))) (gnus-info-find-node url)) (t (error "Can't parse %s" url)))) (defun gnus-button-handle-info-url-gnome (url) "Fetch GNOME style info URL." - (setq url (mm-subst-char-in-string ?_ ?\ url)) + (setq url (subst-char-in-string ?_ ?\ url)) (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) (gnus-info-find-node (concat "(" @@ -8489,9 +8389,9 @@ url is put as the `gnus-button-url' overlay property on the button." (if (fboundp func) (funcall func) (message-position-on-field (caar args))) - (insert (gnus-replace-in-string - (mapconcat 'identity (reverse (cdar args)) ", ") - "\r\n" "\n" t)) + (insert (replace-regexp-in-string + "\r\n" "\n" + (mapconcat 'identity (reverse (cdar args)) ", ") nil t)) (setq args (cdr args))) (if subject (message-goto-body) @@ -8508,13 +8408,13 @@ url is put as the `gnus-button-url' overlay property on the button." (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map [mouse-2] 'gnus-button-prev-page) (define-key map "\r" 'gnus-button-prev-page) map)) (defvar gnus-next-page-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map [mouse-2] 'gnus-button-next-page) (define-key map "\r" 'gnus-button-next-page) map)) @@ -8828,8 +8728,8 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu) + (define-key map [mouse-2] 'gnus-article-push-button) + (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) (dolist (c gnus-mime-security-button-commands) (define-key map (cadr c) (car c))) map)) @@ -8973,14 +8873,10 @@ For example: :button-keymap gnus-mime-security-button-map :help-echo (lambda (_widget) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (when (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) (format "%S: show detail; %S: more options" - (aref gnus-mouse-2 0) - (aref gnus-down-mouse-3 0)))))) + 'mouse-2 + 'down-mouse-3))))) (defun gnus-mime-display-security (handle) (save-restriction @@ -9026,8 +8922,6 @@ For example: (interactive) (gnus-mime-security-run-function 'mm-pipe-part)) -(gnus-ems-redefine) - (provide 'gnus-art) (run-hooks 'gnus-art-load-hook) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index a1408259ec5..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) @@ -148,18 +148,13 @@ that was fetched." (with-current-buffer gnus-summary-buffer (let ((next (caadr (gnus-data-find-list article)))) (when next - (if (not (fboundp 'run-with-idle-timer)) - ;; This is either an older Emacs or XEmacs, so we - ;; do this, which leads to slightly slower article - ;; buffer display. - (gnus-async-prefetch-article group next summary) - (when gnus-async-timer - (ignore-errors - (nnheader-cancel-timer 'gnus-async-timer))) - (setq gnus-async-timer - (run-with-idle-timer - 0.1 nil 'gnus-async-prefetch-article - group next summary)))))))) + (when gnus-async-timer + (ignore-errors + (nnheader-cancel-timer 'gnus-async-timer))) + (setq gnus-async-timer + (run-with-idle-timer + 0.1 nil 'gnus-async-prefetch-article + group next summary))))))) (defun gnus-async-prefetch-article (group article summary &optional next) "Possibly prefetch several articles starting with ARTICLE." diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index b7a63659d82..d5c7e0ee081 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -83,7 +83,7 @@ (insert-buffer-substring buffer) ;; Tag the beginning of the article with the ident. (if (> (point-max) b) - (gnus-put-text-property b (1+ b) 'gnus-backlog ident) + (put-text-property b (1+ b) 'gnus-backlog ident) (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 1a082c255b6..7e18d5e3d99 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -174,17 +174,6 @@ where each BMK is of the form So the cdr of each bookmark is an alist too.") -(defmacro gnus-bookmark-mouse-available-p () - "Return non-nil if a mouse is available." - (if (featurep 'xemacs) - '(device-on-window-system-p) - '(display-mouse-p))) - -(defun gnus-bookmark-remove-properties (string) - "Remove all text properties from STRING." - (set-text-properties 0 (length string) nil string) - string) - ;;;###autoload (defun gnus-bookmark-set () "Set a bookmark for this article." @@ -209,7 +198,7 @@ So the cdr of each bookmark is an alist too.") ;; Set the bookmark list (setq gnus-bookmark-alist (cons - (list (gnus-bookmark-remove-properties bmk-name) + (list (substring-no-properties bmk-name) (gnus-bookmark-make-record group message-id author date subject annotation)) gnus-bookmark-alist)))) @@ -220,12 +209,12 @@ So the cdr of each bookmark is an alist too.") (group message-id author date subject annotation) "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION." (let ((the-record - `((group . ,(gnus-bookmark-remove-properties group)) - (message-id . ,(gnus-bookmark-remove-properties message-id)) - (author . ,(gnus-bookmark-remove-properties author)) - (date . ,(gnus-bookmark-remove-properties date)) - (subject . ,(gnus-bookmark-remove-properties subject)) - (annotation . ,(gnus-bookmark-remove-properties annotation))))) + `((group . ,(substring-no-properties group)) + (message-id . ,(substring-no-properties message-id)) + (author . ,(substring-no-properties author)) + (date . ,(substring-no-properties date)) + (subject . ,(substring-no-properties subject)) + (annotation . ,(substring-no-properties annotation))))) the-record)) (defun gnus-bookmark-set-bookmark-name (group author subject) @@ -237,7 +226,7 @@ So the cdr of each bookmark is an alist too.") "-" (car subject) "-" (cadr subject))) (default-name-1 ;; Strip "[]" chars from the bookmark name: - (gnus-replace-in-string default-name-0 "[]_[]" "")) + (replace-regexp-in-string "[]_[]" "" default-name-0)) (name (read-from-minibuffer (format "Set bookmark (%s): " default-name-1) nil nil nil nil @@ -367,7 +356,7 @@ The leftmost column displays a D if the bookmark is flagged for deletion, or > if it is flagged for displaying." (interactive) (gnus-bookmark-maybe-load-default-file) - (if (gmm-called-interactively-p 'any) + (if (called-interactively-p 'any) (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*")) (set-buffer (get-buffer-create "*Gnus Bookmark List*"))) (let ((inhibit-read-only t) @@ -387,7 +376,7 @@ deletion, or > if it is flagged for displaying." (insert (if (member (gnus-bookmark-get-annotation name) (list nil "")) " " " *")) - (if (gnus-bookmark-mouse-available-p) + (if (display-mouse-p) (add-text-properties (prog1 (point) @@ -400,7 +389,7 @@ deletion, or > if it is flagged for displaying." (insert "\n"))) `(mouse-face highlight follow-link t help-echo ,(format "%s: go to this article" - (aref gnus-mouse-2 0)))) + 'mouse-2))) (insert name "\n"))) (goto-char (point-min)) (forward-line 2) @@ -443,9 +432,7 @@ That is, all information but the name." nil (setq gnus-bookmark-bmenu-mode-map (make-keymap)) (suppress-keymap gnus-bookmark-bmenu-mode-map t) - (define-key gnus-bookmark-bmenu-mode-map "q" (if (fboundp 'quit-window) - 'quit-window - 'bury-buffer)) + (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window) (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select) (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select) (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete) @@ -463,7 +450,7 @@ That is, all information but the name." (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save) (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos) (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details) - (define-key gnus-bookmark-bmenu-mode-map gnus-mouse-2 + (define-key gnus-bookmark-bmenu-mode-map [mouse-2] 'gnus-bookmark-bmenu-select-by-mouse)) ;; Bookmark Buffer Menu mode is suitable only for specially formatted @@ -536,7 +523,7 @@ Optional argument SHOW means show them unconditionally." (let ((start (point-at-eol))) (move-to-column gnus-bookmark-bmenu-file-column t) ;; Strip off `mouse-face' from the white spaces region. - (if (gnus-bookmark-mouse-available-p) + (if (display-mouse-p) (remove-text-properties start (point) '(mouse-face nil help-echo nil)))) (delete-region (point) (progn (end-of-line) (point))) @@ -552,7 +539,7 @@ Optional argument SHOW means show them unconditionally." (insert (gnus-bookmark-get-details bmk-name gnus-bookmark-bookmark-inline-details)) - (if (gnus-bookmark-mouse-available-p) + (if (display-mouse-p) (add-text-properties start (save-excursion (re-search-backward @@ -561,7 +548,7 @@ Optional argument SHOW means show them unconditionally." `(mouse-face highlight follow-link t help-echo ,(format "%s: go to this article" - (aref gnus-mouse-2 0)))))))) + 'mouse-2))))))) (defun gnus-bookmark-kill-line (&optional newline-too) "Kill from point to end of line. @@ -601,7 +588,7 @@ Does not affect the kill ring." (gnus-bookmark-kill-line) (let ((start (point))) (insert (car gnus-bookmark-bmenu-hidden-bookmarks)) - (if (gnus-bookmark-mouse-available-p) + (if (display-mouse-p) (add-text-properties start (save-excursion (re-search-backward @@ -611,7 +598,7 @@ Does not affect the kill ring." follow-link t help-echo ,(format "%s: go to this bookmark in other window" - (aref gnus-mouse-2 0)))))) + 'mouse-2))))) (setq gnus-bookmark-bmenu-hidden-bookmarks (cdr gnus-bookmark-bmenu-hidden-bookmarks)) (forward-line 1)))))))) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 83ccc4fc4a1..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\". @@ -453,13 +453,11 @@ system for example was used.") (or (cdr (assoc group gnus-cache-decoded-group-names)) (let ((decoded (gnus-group-decoded-name group)) (coding (or nnmail-pathname-coding-system - (and (boundp 'file-name-coding-system) - file-name-coding-system) - (and (boundp 'default-file-name-coding-system) - default-file-name-coding-system)))) + file-name-coding-system + default-file-name-coding-system))) (push (cons group decoded) gnus-cache-decoded-group-names) - (push (cons (mm-decode-coding-string - (mm-encode-coding-string decoded coding) + (push (cons (decode-coding-string + (encode-coding-string decoded coding) coding) group) gnus-cache-unified-group-names) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 502a3be3555..03ed71d50c6 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -24,9 +24,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (require 'gnus) (require 'gnus-range) @@ -75,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) @@ -110,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) @@ -307,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. @@ -530,7 +527,6 @@ longer than the frame width." (inhibit-point-motion-hooks t) (marks (gnus-dissect-cited-text)) (adaptive-fill-mode nil) - (filladapt-mode nil) (fill-column (if width (prefix-numeric-value width) fill-column))) (save-restriction (while (cdr marks) @@ -1121,7 +1117,7 @@ See also the documentation for `gnus-article-highlight-citation'." ((assq number gnus-cite-attribution-alist)) (t (gnus-add-wash-type 'cite) - (gnus-add-text-properties + (add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))) @@ -1194,9 +1190,7 @@ Returns nil if there is no such line before LIMIT, t otherwise." (defvar font-lock-keywords) (defvar font-lock-set-defaults) -(eval-and-compile - (unless (featurep 'xemacs) - (autoload 'font-lock-set-defaults "font-lock"))) +(autoload 'font-lock-set-defaults "font-lock") (define-minor-mode gnus-message-citation-mode "Minor mode providing more font-lock support for nested citations. @@ -1206,9 +1200,7 @@ When enabled, it automatically turns on `font-lock-mode'." nil ;; keymap (when (eq major-mode 'message-mode) ;FIXME: Use derived-mode-p. ;; FIXME: Use font-lock-add-keywords! - (let ((defaults (car (if (featurep 'xemacs) - (get 'message-mode 'font-lock-defaults) - font-lock-defaults))) + (let ((defaults (car font-lock-defaults)) default keywords) (while defaults (setq default (if (consp defaults) @@ -1227,19 +1219,11 @@ When enabled, it automatically turns on `font-lock-mode'." gnus-message-citation-keywords)) (kill-local-variable default)))) ;; Force `font-lock-set-defaults' to update `font-lock-keywords'. - (if (featurep 'xemacs) - (progn - (require 'font-lock) - (setq font-lock-defaults-computed nil - font-lock-keywords nil)) - (setq font-lock-set-defaults nil)) + (setq font-lock-set-defaults nil) (font-lock-set-defaults) - (cond (font-lock-mode - (if (fboundp 'font-lock-flush) - (font-lock-flush) - (font-lock-fontify-buffer))) - (gnus-message-citation-mode - (font-lock-mode 1))))) + (if font-lock-mode + (font-lock-flush) + (gnus-message-citation-mode (font-lock-mode 1))))) (defun turn-on-gnus-message-citation-mode () "Turn on `gnus-message-citation-mode'." @@ -1248,8 +1232,6 @@ When enabled, it automatically turns on `font-lock-mode'." "Turn off `gnus-message-citation-mode'." (gnus-message-citation-mode -1)) -(gnus-ems-redefine) - (provide 'gnus-cite) ;; Local Variables: 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-cus.el b/lisp/gnus/gnus-cus.el index de66e34fb94..669de2bb79a 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -416,7 +416,7 @@ category.")) ;; Decode values posting-style holds. (dolist (style (cdr (assq 'posting-style values))) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) 'utf-8))))) (setq gnus-custom-params (apply 'widget-create 'group @@ -492,7 +492,7 @@ form, but who cares?" ;; Encode values posting-style holds. (dolist (style (cdr (assq 'posting-style params))) (when (stringp (cadr style)) - (setcdr style (list (mm-encode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (encode-coding-string (cadr style) 'utf-8))))) (if gnus-custom-topic (gnus-topic-set-parameters gnus-custom-topic params) (gnus-group-edit-group-done 'params gnus-custom-group params) diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 93069e5e4e8..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) @@ -103,10 +103,10 @@ DELAY is a string, giving the length of the time. Possible values are: (aset deadline 1 minute) (aset deadline 2 hour) ;; Convert to seconds. - (setq deadline (gnus-float-time (apply 'encode-time - (append deadline nil)))) + (setq deadline (float-time (apply 'encode-time + (append deadline nil)))) ;; If this time has passed already, add a day. - (when (< deadline (gnus-float-time)) + (when (< deadline (float-time)) (setq deadline (+ 86400 deadline))) ; 86400 secs/day ;; Convert seconds to date header. (setq deadline (message-make-date @@ -129,7 +129,7 @@ DELAY is a string, giving the length of the time. Possible values are: (t (setq delay (* num 60)))) (setq deadline (message-make-date - (seconds-to-time (+ (gnus-float-time) delay))))) + (seconds-to-time (+ (float-time) delay))))) (t (error "Malformed delay `%s'" delay))) (message-add-header (format "%s: %s" gnus-delay-header deadline))) (set-buffer-modified-p t) diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index eb7d0f87155..1d4b021d7fa 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -93,10 +93,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (defun gnus-demon-idle-since () "Return the number of seconds since when Emacs is idle." - (if (featurep 'xemacs) - (itimer-time-difference (current-time) last-command-event-time) - (float-time (or (current-idle-time) - '(0 0 0))))) + (float-time (or (current-idle-time) '(0 0 0)))) (defun gnus-demon-run-callback (func &optional idle time special) "Run FUNC if Emacs has been idle for longer than IDLE seconds. diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 6f0bfe6766f..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. @@ -83,13 +83,10 @@ There are currently two built-in format functions: ;; Compatibility functions ================================================== -(eval-and-compile - (if (fboundp 'kill-entire-line) - (defalias 'gnus-diary-kill-entire-line 'kill-entire-line) - (defun gnus-diary-kill-entire-line () - (beginning-of-line) - (let ((kill-whole-line t)) - (kill-line))))) +(defun gnus-diary-kill-entire-line () + (beginning-of-line) + (let ((kill-whole-line t)) + (kill-line))) ;; Summary line format ====================================================== @@ -164,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-dired.el b/lisp/gnus/gnus-dired.el index 3bbd4de1fe0..f7eae94a7d8 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -38,9 +38,6 @@ ;;; Code: -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (require 'dired) (autoload 'mml-attach-file "mml") (autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'? @@ -86,12 +83,6 @@ See `mail-user-agent' for more information." gnus-user-agent) (function :tag "Other"))) -(eval-when-compile - (when (featurep 'xemacs) - (defvar gnus-dired-mode-hook) - (defvar gnus-dired-mode-on-hook) - (defvar gnus-dired-mode-off-hook))) - (define-minor-mode gnus-dired-mode "Minor mode for intersections of gnus and dired. @@ -134,9 +125,7 @@ filenames." (mapcar ;; don't attach directories (lambda (f) (if (file-directory-p f) nil f)) - (nreverse - (let ((arg nil)) ;; Silence XEmacs 21.5 when compiling. - (dired-map-over-marks (dired-get-filename) arg))))))) + (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) (let ((destination nil) (files-str nil) (bufs nil)) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index b5b17ba42b0..f5299bea806 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -31,9 +31,6 @@ (require 'nndraft) (require 'gnus-agent) (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' ;;; Draft minor mode @@ -320,7 +317,7 @@ If DONT-POP is nil, display the buffer after setting it up." (let* ((window (get-buffer-window buff t)) (frame (and window (window-frame window)))) (if frame - (gnus-select-frame-set-input-focus frame) + (select-frame-set-input-focus frame) (pop-to-buffer buff t))) (error "The draft %s is under edit" file))))) 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-ems.el b/lisp/gnus/gnus-ems.el deleted file mode 100644 index 400ac4f02bd..00000000000 --- a/lisp/gnus/gnus-ems.el +++ /dev/null @@ -1,266 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen - -;; Copyright (C) 1995-2016 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: 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: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'ring)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-3 [down-mouse-3]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-widget-button-keymap nil) -(defvar gnus-mode-line-modified - (if (featurep 'xemacs) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas")) - -(autoload 'gnus-get-buffer-create "gnus") -(autoload 'nnheader-find-etc-directory "nnheader") -(autoload 'smiley-region "smiley") - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - -;;; Mule functions. - -(defun gnus-mule-max-width-function (el max-width) - `(let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) ,max-width) - (truncate-string-to-width valstr ,max-width) - valstr))) - -(eval-and-compile - (if (featurep 'xemacs) - (gnus-xmas-define) - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions."))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-check-before-posting) -(defvar gnus-mouse-face) -(defvar gnus-group-buffer) - -(defun gnus-ems-redefine () - (cond - ((featurep 'xemacs) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and Emacs 20+ including - ;; MULE features. Unfortunately these APIs are different. In - ;; particular, Emacs (including original Mule) and XEmacs are - ;; quite different. However, this version of Gnus doesn't support - ;; anything other than XEmacs 20+ and Emacs 20.3+. - - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if Mule (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when other mule variants are running. - - ;; It is possible to detect XEmacs/mule by (featurep 'mule) and - ;; (featurep 'xemacs). In this case, the implementation for - ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string-to-width gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n"))))) - -;; Clone of `appt-select-lowest-window' in appt.el. -(defun gnus-select-lowest-window () -"Select the lowest window on the frame." - (let ((lowest-window (selected-window)) - (bottom-edge (nth 3 (window-edges)))) - (walk-windows (lambda (w) - (let ((next-bottom-edge (nth 3 (window-edges w)))) - (when (< bottom-edge next-bottom-edge) - (setq bottom-edge next-bottom-edge - lowest-window w))))) - (select-window lowest-window))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-mark-active-p () - "Non-nil means the mark and region are currently active in this buffer." - mark-active) ; aliased to region-exists-p in XEmacs. - -(autoload 'gnus-alive-p "gnus-util") -(autoload 'mm-disable-multibyte "mm-util") - -;;; Image functions. - -(defun gnus-image-type-available-p (type) - (and (fboundp 'image-type-available-p) - (if (fboundp 'display-images-p) - (display-images-p) - t) - (image-type-available-p type))) - -(defun gnus-create-image (file &optional type data-p &rest props) - (let ((face (plist-get props :face))) - (when face - (setq props (plist-put props :foreground (face-foreground face))) - (setq props (plist-put props :background (face-background face)))) - (ignore-errors - (apply 'create-image file type data-p props)))) - -(defun gnus-put-image (glyph &optional string category) - (let ((point (point))) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) - glyph)) - -(defun gnus-remove-image (image &optional category) - "Remove the image matching IMAGE and CATEGORY found first." - (let ((start (point-min)) - val end) - (while (and (not end) - (or (setq val (get-text-property start 'display)) - (and (setq start - (next-single-property-change start 'display)) - (setq val (get-text-property start 'display))))) - (setq end (or (next-single-property-change start 'display) - (point-max))) - (if (and (equal val image) - (equal (get-text-property start 'gnus-image-category) - category)) - (progn - (put-text-property start end 'display nil) - (when (get-text-property start 'gnus-image-text-deletable) - (delete-region start end))) - (unless (= end (point-max)) - (setq start end - end nil)))))) - -(defmacro gnus-string-mark-left-to-right (string) - (if (fboundp 'bidi-string-mark-left-to-right) - `(bidi-string-mark-left-to-right ,string) - string)) - -(eval-and-compile - ;; XEmacs does not have window-inside-pixel-edges - (defalias 'gnus-window-inside-pixel-edges - (if (fboundp 'window-inside-pixel-edges) - 'window-inside-pixel-edges - 'window-pixel-edges)) - - (if (or (featurep 'emacs) (fboundp 'set-process-plist)) - (progn ; these exist since Emacs 22.1 - (defalias 'gnus-set-process-plist 'set-process-plist) - (defalias 'gnus-process-plist 'process-plist) - (defalias 'gnus-process-get 'process-get) - (defalias 'gnus-process-put 'process-put)) - (defun gnus-set-process-plist (process plist) - "Replace the plist of PROCESS with PLIST. Returns PLIST." - (put 'gnus-process-plist-internal process plist)) - - (defun gnus-process-plist (process) - "Return the plist of PROCESS." - ;; This form works but can't prevent the plist data from - ;; growing infinitely. - ;;(get 'gnus-process-plist-internal process) - (let* ((plist (symbol-plist 'gnus-process-plist-internal)) - (tem (memq process plist))) - (prog1 - (cadr tem) - ;; Remove it from the plist data. - (when tem - (if (eq plist tem) - (progn - (setcar plist (caddr plist)) - (setcdr plist (or (cdddr plist) '(nil)))) - (setcdr (nthcdr (- (length plist) (length tem) 1) plist) - (cddr tem))))))) - - (defun gnus-process-get (process propname) - "Return the value of PROCESS' PROPNAME property. -This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." - (plist-get (gnus-process-plist process) propname)) - - (defun gnus-process-put (process propname value) - "Change PROCESS' PROPNAME property to VALUE. -It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." - (gnus-set-process-plist process - (plist-put (gnus-process-plist process) - propname value))))) - -(provide 'gnus-ems) - -;;; gnus-ems.el ends here diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index a6b27300233..0ffd243de0e 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -28,14 +28,13 @@ (require 'cl)) (require 'mm-util) -(require 'gnus-ems) (require 'gnus-util) (require 'gnus) (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) @@ -47,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-gravatar.el b/lisp/gnus/gnus-gravatar.el index de7203d9d10..89be8640c53 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -94,8 +94,9 @@ Set image category to CATEGORY." (mail-address (cadr address))) (when (if real-name (re-search-forward - (concat (gnus-replace-in-string - (regexp-quote real-name) "[\t ]+" "[\t\n ]+") + (concat (replace-regexp-in-string + "[\t ]+" "[\t\n ]+" + (regexp-quote real-name)) "\\|" (regexp-quote mail-address)) nil t) @@ -110,8 +111,7 @@ Set image category to CATEGORY." ;; another mail with the same someaddress. (unless (memq 'gnus-gravatar (text-properties-at (point))) (let ((point (point))) - (unless (featurep 'xemacs) - (setq gravatar (append gravatar gnus-gravatar-properties))) + (setq gravatar (append gravatar gnus-gravatar-properties)) (gnus-put-image gravatar (buffer-substring (point) (1+ point)) category) (put-text-property point (point) 'gnus-gravatar address) (gnus-add-wash-type category) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 1cd16a4e043..828805384ca 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -38,7 +38,6 @@ (require 'gnus-undo) (require 'gmm-utils) (require 'time-date) -(require 'gnus-ems) (eval-when-compile (require 'mm-url) @@ -52,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 @@ -75,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. @@ -108,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) @@ -121,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', @@ -156,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. @@ -214,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: @@ -224,11 +226,6 @@ with some simple extensions: :group 'gnus-group-visual :type 'string) -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) - (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)) - (defcustom gnus-group-menu-hook nil "Hook run after the creation of the group mode menu." :group 'gnus-group-various @@ -246,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 @@ -303,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") @@ -356,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 @@ -391,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. @@ -427,8 +424,7 @@ For example: :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) (defcustom gnus-group-name-charset-group-alist - (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8)) - (mm-coding-system-p 'utf-8)) + (if (mm-coding-system-p 'utf-8) '((".*" . utf-8)) nil) "Alist of group regexp and the charset for group names. @@ -455,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 @@ -535,10 +533,7 @@ simple manner.") (?O gnus-tmp-moderated-string ?s) (?p gnus-tmp-process-marked ?c) (?s gnus-tmp-news-server ?s) - (?n ,(if (featurep 'xemacs) - '(symbol-name gnus-tmp-news-method) - 'gnus-tmp-news-method) - ?s) + (?n gnus-tmp-news-method ?s) (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) (?B gnus-tmp-summary-live ?c) @@ -632,8 +627,8 @@ simple manner.") "\C-c\C-i" gnus-info-find-node "\M-e" gnus-group-edit-group-method "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - [follow-link] mouse-face + [mouse-2] gnus-mouse-pick-group + [follow-link] 'mouse-face "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-b" gnus-bug @@ -644,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 @@ -798,32 +799,26 @@ simple manner.") ["Catch up" gnus-group-catchup-current :included (not (gnus-topic-mode-p)) :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Mark unread articles in the current group as read"))] + :help "Mark unread articles in the current group as read"] ["Catch up " gnus-topic-catchup-articles :included (gnus-topic-mode-p) - ,@(if (featurep 'xemacs) nil - '(:help "Mark unread articles in the current group or topic as read"))] + :help "Mark unread articles in the current group or topic as read"] ["Catch up all articles" gnus-group-catchup-current-all (gnus-group-group-name)] ["Check for new articles" gnus-group-get-new-news-this-group :included (not (gnus-topic-mode-p)) :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Check for new messages in current group"))] + :help "Check for new messages in current group"] ["Check for new articles " gnus-topic-get-new-news-this-topic :included (gnus-topic-mode-p) - ,@(if (featurep 'xemacs) nil - '(:help "Check for new messages in current group or topic"))] + :help "Check for new messages in current group or topic"] ["Toggle subscription" gnus-group-unsubscribe-current-group (gnus-group-group-name)] ["Kill" gnus-group-kill-group :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Kill (remove) current group"))] + :help "Kill (remove) current group"] ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] ["Describe" gnus-group-describe-group :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display description of the current group"))] + :help "Display description of the current group"] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) ["Expire articles" gnus-group-expire-articles @@ -905,14 +900,14 @@ simple manner.") (memq (gnus-group-group-name) gnus-group-marked))] ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)] + ["Mark region" gnus-group-mark-region :active mark-active] ["Mark buffer" gnus-group-mark-buffer t] ["Execute command" gnus-group-universal-argument (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" ["Subscribe to a group..." gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region - :active (gnus-mark-active-p)] + :active mark-active] ["Kill all zombie groups" gnus-group-kill-all-zombies gnus-zombie-list] ["Kill all groups on level..." gnus-group-kill-level t]) @@ -960,13 +955,9 @@ simple manner.") ["Send a message (mail or news)" gnus-group-post-news t] ["Create a local message" gnus-group-news t] ["Check for new news" gnus-group-get-new-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Get newly arrived articles")) - ] + :help "Get newly arrived articles"] ["Send queued messages" gnus-delay-send-queue - ,@(if (featurep 'xemacs) '(t) - '(:help "Send all messages that are scheduled to be sent now")) - ] + :help "Send all messages that are scheduled to be sent now"] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] @@ -981,9 +972,7 @@ simple manner.") ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] ["Send a bug report" gnus-bug t] - ["Exit from Gnus" gnus-group-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Quit reading news"))] + ["Exit from Gnus" gnus-group-exit :help "Quit reading news"] ["Exit without saving" gnus-group-quit t])) (gnus-run-hooks 'gnus-group-menu-hook))) @@ -1101,18 +1090,14 @@ See `gmm-tool-bar-from-list' for the format of the list." (defun gnus-group-make-tool-bar (&optional force) "Make a group mode tool bar from `gnus-group-tool-bar'. When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) + (when (and (boundp 'tool-bar-mode) tool-bar-mode (display-graphic-p) (or (not gnus-group-tool-bar-map) force)) (let* ((load-path - (gmm-image-load-path-for-library "gnus" - "gnus/toggle-subscription.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path))) + (image-load-path-for-library + "gnus" "gnus/toggle-subscription.xpm" nil t)) + (image-load-path (cons (car load-path) image-load-path)) (map (gmm-tool-bar-from-list gnus-group-tool-bar gnus-group-tool-bar-zap-list 'gnus-group-mode-map))) @@ -1167,7 +1152,7 @@ The following commands are available: (goto-char (point-min)) (setq gnus-group-mark-positions (list (cons 'process (and (search-forward - (mm-string-to-multibyte "\200") nil t) + (string-to-multibyte "\200") nil t) (- (point) (point-min) 1)))))))) (defun gnus-mouse-pick-group (e) @@ -1229,8 +1214,8 @@ The following commands are available: (defun gnus-group-name-decode (string charset) ;; Fixme: Don't decode in unibyte mode. - (if (and string charset (featurep 'mule)) - (mm-decode-coding-string string charset) + (if (and string charset) + (decode-coding-string string charset) string)) (defun gnus-group-decoded-name (string) @@ -1394,7 +1379,7 @@ if it is a string, only list groups matching REGEXP." (when (or gnus-group-listed-groups (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead - (gnus-union + (cl-union not-in-list (setq gnus-killed-list (sort gnus-killed-list 'string<)) :test 'equal) @@ -1418,7 +1403,7 @@ if it is a string, only list groups matching REGEXP." (or (not regexp) (and (stringp regexp) (string-match regexp group)) (and (functionp regexp) (funcall regexp group)))) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " (gnus-group-decoded-name group) @@ -1510,13 +1495,10 @@ if it is a string, only list groups matching REGEXP." ;; Date: Mon, 23 Jan 2006 19:59:13 +0100 ;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de> -(defcustom gnus-group-update-tool-bar - (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) - tool-bar-mode - ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might - ;; be confusing, so maybe we shouldn't call it by default. - (fboundp 'force-window-update)) +;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might +;; be confusing, so maybe we shouldn't call it by default. +(defcustom gnus-group-update-tool-bar (and (boundp 'tool-bar-mode) + tool-bar-mode) "Force updating the group buffer tool bar." :group 'gnus-group :version "22.1" @@ -1597,7 +1579,7 @@ if it is a string, only list groups matching REGEXP." gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) (setq beg (point)) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) ;; Insert the text. @@ -1625,58 +1607,42 @@ if it is a string, only list groups matching REGEXP." (progn (unless (bound-and-true-p cursor-sensor-mode) (cursor-sensor-mode 1)) - (gnus-put-text-property beg end 'cursor-sensor-functions + (put-text-property beg end 'cursor-sensor-functions '(gnus-tool-bar-update))) - (gnus-put-text-property beg end 'point-entered + (put-text-property beg end 'point-entered #'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left + (put-text-property beg end 'point-left #'gnus-tool-bar-update)))) (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. Some value are bound so the form can use them." - (defvar group-age) (defvar ticked) (defvar score) (defvar level) - (defvar mailp) (defvar total) (defvar unread) (when list (let* ((entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) (active (gnus-active group)) - (total (if active (1+ (- (cdr active) (car active))) 0)) (info (nth 2 entry)) - (method (inline (gnus-server-get-method group (gnus-info-method info)))) + (method (inline (gnus-server-get-method + group (gnus-info-method info)))) (marked (gnus-info-marks info)) - (mailp (apply 'append - (mapcar - (lambda (x) - (memq x (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - '(mail post-mail)))) - (level (or (gnus-info-level info) gnus-level-killed)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (group-age (gnus-group-timestamp-delta group))) - ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 - ;; ====================================================================== - ;; From: Richard Stallman - ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) - ;; Cc: ding@gnus.org - ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 - ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org> - ;; - ;; [...] - ;; The kludge is that the alist elements contain expressions that refer - ;; to local variables with short names. Perhaps write your own tiny - ;; evaluator that handles just `and', `or', and numeric comparisons - ;; and just a few specific variables. - ;; ====================================================================== - ;; - ;; Similar for other evaluated variables. Grep for risky-local-variable - ;; to find them! -- rsteib - ;; - ;; Eval the cars of the lists until we find a match. + (env + (list + (cons 'unread (if (numberp (car entry)) (car entry) 0)) + (cons 'total (if active (1+ (- (cdr active) (car active))) 0)) + (cons 'mailp (apply + 'append + (mapcar + (lambda (x) + (memq x (assoc + (symbol-name + (car (or method gnus-select-method))) + gnus-valid-select-methods))) + '(mail post-mail)))) + (cons 'level (or (gnus-info-level info) gnus-level-killed)) + (cons 'score (or (gnus-info-score info) 0)) + (cons 'ticked (gnus-range-length (cdr (assq 'tick marked)))) + (cons 'group-age (gnus-group-timestamp-delta group))))) (while (and list - (not (eval (caar list)))) + (not (eval (caar list) env))) (setq list (cdr list))) list))) @@ -1687,12 +1653,12 @@ and ends at END." (let ((face (cdar (gnus-group-update-eval-form group gnus-group-highlight)))) - (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces + beg 'face)) (let ((inhibit-read-only t)) (gnus-put-text-property-excluding-characters-with-faces beg end 'face - (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg)))) + (if (boundp face) (symbol-value face) face)))))) (defun gnus-group-get-icon (group) "Return an icon for GROUP according to `gnus-group-icon-list'." @@ -1800,8 +1766,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. (setq mode-line-modified - (if modified (car gnus-mode-line-modified) - (cdr gnus-mode-line-modified))) + (if modified "**" "--")) ;; If the line is too long, we chop it off. (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) @@ -2028,7 +1993,7 @@ Take into consideration N (the prefix) and the list of marked groups." (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) - ((and (gnus-region-active-p) (mark)) + ((and transient-mark-mode mark-active (mark)) ;; Work on the region between point and mark. (let ((max (max (point) (mark))) groups) @@ -2240,9 +2205,9 @@ if it is not a list." (member group (mapcar 'symbol-name collection)) (symbol-value (intern-soft group collection))) (setq group - (mm-encode-coding-string + (encode-coding-string group (gnus-group-name-charset nil group)))) - (gnus-replace-in-string group "\n" ""))) + (replace-regexp-in-string "\n" "" group))) ;;;###autoload (defun gnus-fetch-group (group &optional articles) @@ -2402,7 +2367,7 @@ specified by `gnus-gmane-group-download-format'." (unless range (setq range 500)) (when (< range 1) (error "Invalid range: %s" range)) - (let ((tmpfile (mm-make-temp-file + (let ((tmpfile (make-temp-file (format "%s.start-%s.range-%s." group start range))) (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) (with-temp-file tmpfile @@ -2488,21 +2453,25 @@ the bug number, and browsing the URL must return mbox output." (setq ids (string-to-number ids))) (unless (listp ids) (setq ids (list ids))) - (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) + (let ((tmpfile (make-temp-file "gnus-temp-group-"))) (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary)) (with-temp-file tmpfile (mm-disable-multibyte) (dolist (id ids) - (url-insert-file-contents (format mbox-url id))) + (let ((file (format "~/.emacs.d/debbugs-cache/%s" id))) + (if (and (not gnus-plugged) + (file-exists-p file)) + (insert-file-contents file) + (url-insert-file-contents (format mbox-url id))))) (goto-char (point-min)) ;; Add the debbugs address so that we can respond to reports easily. (while (re-search-forward "^To: " nil t) (end-of-line) (insert (format ", %s@%s" (car ids) - (gnus-replace-in-string - (gnus-replace-in-string mbox-url "^http://" "") - "/.*$" "")))))) + (replace-regexp-in-string + "/.*$" "" + (replace-regexp-in-string "^http://" "" mbox-url))))))) (gnus-group-read-ephemeral-group (format "nndoc+ephemeral:bug#%s" (mapconcat 'number-to-string ids ",")) @@ -2762,7 +2731,7 @@ server." (when (stringp method) (setq method (or (gnus-server-to-method method) method))) (unless encoded - (setq name (mm-encode-coding-string + (setq name (encode-coding-string name (gnus-group-name-charset method name)))) (let* ((meth (gnus-method-simplify @@ -2880,7 +2849,7 @@ and NEW-NAME will be prompted for." "Rename group to: " (gnus-group-real-name (gnus-group-decoded-name group))) method (gnus-info-method (gnus-get-info group))) - (list group (mm-encode-coding-string + (list group (encode-coding-string new-name (gnus-group-name-charset method @@ -2951,7 +2920,7 @@ and NEW-NAME will be prompted for." (gnus-info-params info)) (t info)) ;; The proper documentation. - (gnus-format-message + (format-message "Editing the %s for `%s'." (cond ((eq part 'method) "select method") @@ -3094,9 +3063,9 @@ If called with a prefix argument, ask for the file type." (list 'nndoc-address file) (list 'nndoc-article-type (or type 'guess)))) (coding (gnus-group-name-charset method name))) - (setcar (cdr method) (mm-encode-coding-string file coding)) + (setcar (cdr method) (encode-coding-string file coding)) (gnus-group-make-group - (mm-encode-coding-string (gnus-group-real-name name) coding) + (encode-coding-string (gnus-group-real-name name) coding) method nil nil t))) (defvar nnweb-type-definition) @@ -3173,8 +3142,8 @@ If there is, use Gnus to create an nnrss group" (coding (gnus-group-name-charset '(nnrss "") title))) (when coding ;; Unify non-ASCII text. - (setq title (mm-decode-coding-string - (mm-encode-coding-string title coding) + (setq title (decode-coding-string + (encode-coding-string title coding) coding))) (gnus-group-make-group title '(nnrss "")) (push (list title href desc) nnrss-group-alist) @@ -3279,7 +3248,7 @@ mail messages or news articles in files that have numeric names." (error "%s is not an nnimap group" group)) (unless (setq acl (nnimap-acl-get mailbox (cadr method))) (error "Server does not support ACL's")) - (gnus-edit-form acl (gnus-format-message "\ + (gnus-edit-form acl (format-message "\ Editing the access control list for `%s'. An access control list is a list of (identifier . rights) elements. @@ -4040,7 +4009,7 @@ entail asking the server for the groups." (erase-buffer) (while groups (setq group (pop groups)) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) (insert " *: " (gnus-group-decoded-name group) @@ -4162,22 +4131,23 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) - b) - (erase-buffer) + b groups) (mapatoms (lambda (group) - (setq b (point)) - (let ((charset (gnus-group-name-charset nil (symbol-name group)))) - (insert (format " *: %-20s %s\n" - (gnus-group-name-decode - (symbol-name group) charset) - (gnus-group-name-decode - (symbol-value group) charset)))) - (gnus-add-text-properties - b (1+ b) (list 'gnus-group group - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) + (push (symbol-name group) groups)) gnus-description-hashtb) + (setq groups (sort groups 'string<)) + (erase-buffer) + (dolist (group groups) + (setq b (point)) + (let ((charset (gnus-group-name-charset nil group))) + (insert (format " *: %-20s %s\n" + (gnus-group-name-decode group charset) + (gnus-group-name-decode group charset)))) + (add-text-properties + b (1+ b) (list 'gnus-group (intern group gnus-description-hashtb) + 'gnus-unread t 'gnus-marked nil + 'gnus-level (1+ gnus-level-subscribed)))) (goto-char (point-min)) (gnus-group-position-point))) @@ -4533,7 +4503,7 @@ and the second element is the address." (if force (if (null articles) (setcar (nthcdr 3 info) - (gnus-delete-alist type (car marked))) + (assq-delete-all type (car marked))) (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) @@ -4571,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)))) @@ -4675,14 +4645,10 @@ This command may read the active file." (gnus-group-list-mode gnus-group-list-mode) ;; Save it. func) (push last-command-event unread-command-events) - (if (featurep 'xemacs) - (push (make-event 'key-press '(key ?A)) unread-command-events) - (push ?A unread-command-events)) + (push ?A unread-command-events) (let (gnus-pick-mode keys) - (setq keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil)) - (read-key-sequence nil))) - (setq func (lookup-key (current-local-map) keys))) + (setq keys (read-key-sequence nil) + func (lookup-key (current-local-map) keys))) (if (or (not func) (numberp func)) (ding) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 884b40e9342..afbb845a0d8 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -39,7 +39,8 @@ (require 'xml) (require 'browse-url) (require 'mm-util) -(eval-and-compile (unless (featurep 'xemacs) (require 'help-fns))) +(require 'help-fns) +(require 'url-queue) (defcustom gnus-html-image-cache-ttl (days-to-time 7) "Time used to determine if we should use images from the cache." @@ -88,27 +89,9 @@ fit these criteria." (define-key map [tab] 'widget-forward) map)) -(eval-and-compile - (defalias 'gnus-html-encode-url-chars - (if (fboundp 'browse-url-url-encode-chars) - 'browse-url-url-encode-chars - (lambda (text chars) - "URL-encode the chars in TEXT that match CHARS. -CHARS is a regexp-like character alternative (e.g., \"[)$]\")." - (let ((encoded-text (copy-sequence text)) - (s 0)) - (while (setq s (string-match chars encoded-text s)) - (setq encoded-text - (replace-match (format "%%%x" - (string-to-char - (match-string 0 encoded-text))) - t t encoded-text) - s (1+ s))) - encoded-text))))) - (defun gnus-html-encode-url (url) "Encode URL." - (gnus-html-encode-url-chars url "[)$ ]")) + (browse-url-url-encode-chars url "[)$ ]")) (defun gnus-html-cache-expired (url ttl) "Check if URL is cached for more than TTL." @@ -143,7 +126,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." charset nil t)) (not (eq charset 'ascii))) (insert (prog1 - (mm-decode-coding-string (buffer-string) charset) + (decode-coding-string (buffer-string) charset) (erase-buffer) (mm-enable-multibyte)))) (call-process-region (point-min) (point-max) @@ -197,7 +180,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" parameters) (xml-substitute-special (match-string 2 parameters)))) - (gnus-add-text-properties + (add-text-properties start end (list 'image-url url 'image-displayer `(lambda (url start end) @@ -310,7 +293,7 @@ Use ALT-TEXT for the image string." (let ((overlay (make-overlay start end))) (overlay-put overlay 'evaporate t) (overlay-put overlay 'gnus-button-url url) - (gnus-put-text-property start end 'gnus-string url) + (put-text-property start end 'gnus-string url) (when gnus-article-mouse-face (overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; The upper-case IMG_ALT is apparently just an artifact that @@ -391,14 +374,9 @@ Use ALT-TEXT for the image string." "Retrieve IMAGE, and place it into BUFFER on arrival." (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s" buffer image) - (if (fboundp 'url-queue-retrieve) - (url-queue-retrieve (car image) - 'gnus-html-image-fetched - (list buffer image) t t) - (ignore-errors - (url-retrieve (car image) - 'gnus-html-image-fetched - (list buffer image))))) + (url-queue-retrieve (car image) + 'gnus-html-image-fetched + (list buffer image) t t)) (defun gnus-html-image-fetched (status buffer image) "Callback function called when image has been fetched." @@ -427,7 +405,7 @@ Return a string with image data." (defun gnus-html-maximum-image-size () "Return the maximum size of an image according to `gnus-max-image-proportion'." - (let ((edges (gnus-window-inside-pixel-edges + (let ((edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))) ;; (width . height) (cons @@ -444,7 +422,7 @@ Return a string with image data." (defun gnus-html-put-image (data url &optional alt-text) "Put an image with DATA from URL and optional ALT-TEXT." - (when (gnus-graphic-display-p) + (when (display-graphic-p) (let* ((start (text-property-any (point-min) (point-max) 'image-url url)) (end (when start @@ -454,10 +432,7 @@ Return a string with image data." (let* ((image (ignore-errors (gnus-create-image data nil t))) - (size (and image - (if (featurep 'xemacs) - (cons (glyph-width image) (glyph-height image)) - (image-size image t))))) + (size (and image (image-size image t)))) (save-excursion (goto-char start) (let ((alt-text (or alt-text @@ -466,16 +441,8 @@ Return a string with image data." (if (and image ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. - (not (and (if (featurep 'xemacs) - (glyphp image) - (listp image)) - (eq (if (featurep 'xemacs) - (let ((d (cdadar - (specifier-spec-list - (glyph-image image))))) - (and (vectorp d) - (aref d 0))) - (plist-get (cdr image) :type)) + (not (and (listp image) + (eq (plist-get (cdr image) :type) 'gif) (= (car size) 30) (= (cdr size) 30)))) @@ -488,10 +455,9 @@ Return a string with image data." :help-echo alt-text :keymap gnus-html-displayed-image-map url) - (gnus-put-text-property start (point) - 'gnus-alt-text alt-text) + (put-text-property start (point) 'gnus-alt-text alt-text) (when url - (gnus-add-text-properties + (add-text-properties start (point) `(image-url ,url diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index d7a431ae8c6..dea6523a541 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -119,17 +119,17 @@ nil "iCalendar class for REPLY events") -(defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) "Return t if EVENT is recurring." (not (null (gnus-icalendar-event:recur event)))) -(defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) "Return recurring frequency of EVENT." (let ((rrule (gnus-icalendar-event:recur event))) (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) (match-string 1 rrule))) -(defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) "Return recurring interval of EVENT." (let ((rrule (gnus-icalendar-event:recur event)) (default-interval 1)) @@ -138,7 +138,7 @@ (or (match-string 1 rrule) default-interval))) -(defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) (defun gnus-icalendar-event--decode-datefield (event field zone-map) @@ -152,17 +152,19 @@ (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) (event-props (caddr event))) - (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) - (attendee-email (att) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) - (attendee-prop-matches-p (prop) - (and (eq (car prop) 'ATTENDEE) - (or (member (attendee-name prop) name-or-email) - (let ((att-email (attendee-email prop))) - (gnus-icalendar-find-if (lambda (email) - (string-match email att-email)) - name-or-email)))))) - + (cl-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) + (attendee-email + (att) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) + (attendee-prop-matches-p + (prop) + (and (eq (car prop) 'ATTENDEE) + (or (member (attendee-name prop) name-or-email) + (let ((att-email (attendee-email prop))) + (gnus-icalendar-find-if + (lambda (email) + (string-match email att-email)) + name-or-email)))))) (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) (defun gnus-icalendar-event--get-attendee-names (ical) @@ -171,17 +173,19 @@ (lambda (p) (eq (car p) 'ATTENDEE)) (caddr event)))) - (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) - (attendee-name (prop) - (or (plist-get (cadr prop) 'CN) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) - (attendees-by-type (type) - (gnus-remove-if-not - (lambda (p) (string= (attendee-role p) type)) - attendee-props)) - (attendee-names-by-type (type) - (mapcar #'attendee-name (attendees-by-type type)))) - + (cl-labels + ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) + (attendee-name + (prop) + (or (plist-get (cadr prop) 'CN) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) + (attendees-by-type (type) + (gnus-remove-if-not + (lambda (p) (string= (attendee-role p) type)) + attendee-props)) + (attendee-names-by-type + (type) + (mapcar #'attendee-name (attendees-by-type type)))) (list (attendee-names-by-type "REQ-PARTICIPANT") (attendee-names-by-type "OPT-PARTICIPANT"))))) @@ -220,23 +224,25 @@ ((string= method "REPLY") 'gnus-icalendar-event-reply) (t 'gnus-icalendar-event)))) - (gmm-labels ((map-property (prop) - (let ((value (icalendar--get-event-property event prop))) - (when value - ;; ugly, but cannot get - ;;replace-regexp-in-string work with "\\" as - ;;REP, plus we should also handle "\\;" - (replace-regexp-in-string - "\\\\," "," - (replace-regexp-in-string - "\\\\n" "\n" (substring-no-properties value)))))) - (accumulate-args (mapping) - (destructuring-bind (slot . ical-property) mapping - (setq args (append (list - (intern (concat ":" (symbol-name slot))) - (map-property ical-property)) - args))))) - + (cl-labels + ((map-property + (prop) + (let ((value (icalendar--get-event-property event prop))) + (when value + ;; ugly, but cannot get + ;;replace-regexp-in-string work with "\\" as + ;;REP, plus we should also handle "\\;" + (replace-regexp-in-string + "\\\\," "," + (replace-regexp-in-string + "\\\\n" "\n" (substring-no-properties value)))))) + (accumulate-args + (mapping) + (destructuring-bind (slot . ical-property) mapping + (setq args (append (list + (intern (concat ":" (symbol-name slot))) + (map-property ical-property)) + args))))) (mapc #'accumulate-args prop-map) (apply 'make-instance event-class args)))) @@ -264,41 +270,46 @@ status will be retrieved from the first matching attendee record." (let ((summary-status (capitalize (symbol-name status))) (attendee-status (upcase (symbol-name status))) reply-event-lines) - (gmm-labels ((update-summary (line) - (if (string-match "^[^:]+:" line) - (replace-match (format "\\&%s: " summary-status) t nil line) - line)) - (update-dtstamp () - (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) - (attendee-matches-identity (line) - (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) - identities)) - (update-attendee-status (line) - (when (and (attendee-matches-identity line) - (string-match "\\(PARTSTAT=\\)[^;]+" line)) - (replace-match (format "\\1%s" attendee-status) t nil line))) - (process-event-line (line) - (when (string-match "^\\([^;:]+\\)" line) - (let* ((key (match-string 0 line)) - ;; NOTE: not all of the below fields are mandatory, - ;; but they are often present in other clients' - ;; replies. Can be helpful for debugging, too. - (new-line - (cond - ((string= key "ATTENDEE") (update-attendee-status line)) - ((string= key "SUMMARY") (update-summary line)) - ((string= key "DTSTAMP") (update-dtstamp)) - ((member key '("ORGANIZER" "DTSTART" "DTEND" - "LOCATION" "DURATION" "SEQUENCE" - "RECURRENCE-ID" "UID")) line) - (t nil)))) - (when new-line - (push new-line reply-event-lines)))))) + (cl-labels + ((update-summary + (line) + (if (string-match "^[^:]+:" line) + (replace-match (format "\\&%s: " summary-status) t nil line) + line)) + (update-dtstamp () + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + (attendee-matches-identity + (line) + (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) + identities)) + (update-attendee-status + (line) + (when (and (attendee-matches-identity line) + (string-match "\\(PARTSTAT=\\)[^;]+" line)) + (replace-match (format "\\1%s" attendee-status) t nil line))) + (process-event-line + (line) + (when (string-match "^\\([^;:]+\\)" line) + (let* ((key (match-string 0 line)) + ;; NOTE: not all of the below fields are mandatory, + ;; but they are often present in other clients' + ;; replies. Can be helpful for debugging, too. + (new-line + (cond + ((string= key "ATTENDEE") (update-attendee-status line)) + ((string= key "SUMMARY") (update-summary line)) + ((string= key "DTSTAMP") (update-dtstamp)) + ((member key '("ORGANIZER" "DTSTART" "DTEND" + "LOCATION" "DURATION" "SEQUENCE" + "RECURRENCE-ID" "UID")) line) + (t nil)))) + (when new-line + (push new-line reply-event-lines)))))) (mapc #'process-event-line (split-string ical-request "\n")) (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) - reply-event-lines) + reply-event-lines) (error "Could not find an event attendee matching given identity")) (mapconcat #'identity `("BEGIN:VEVENT" @@ -311,16 +322,17 @@ status will be retrieved from the first matching attendee record." The reply will have STATUS (`accepted', `tentative' or `declined'). The reply will be composed for attendees matching any entry on the IDENTITIES list." - (gmm-labels ((extract-block (blockname) - (save-excursion - (let ((block-start-re (format "^BEGIN:%s" blockname)) - (block-end-re (format "^END:%s" blockname)) - start) - (when (re-search-forward block-start-re nil t) - (setq start (line-beginning-position)) - (re-search-forward block-end-re) - (buffer-substring-no-properties start (line-end-position))))))) - + (cl-labels + ((extract-block + (blockname) + (save-excursion + (let ((block-start-re (format "^BEGIN:%s" blockname)) + (block-end-re (format "^END:%s" blockname)) + start) + (when (re-search-forward block-start-re nil t) + (setq start (line-beginning-position)) + (re-search-forward block-end-re) + (buffer-substring-no-properties start (line-end-position))))))) (let (zone event) (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) (goto-char (point-min)) @@ -376,7 +388,7 @@ on the IDENTITIES list." (defvar gnus-icalendar-org-enabled-p nil) -(defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:org-repeat ((event gnus-icalendar-event)) "Return `org-mode' timestamp repeater string for recurring EVENT. Return nil for non-recurring EVENT." (when (gnus-icalendar-event:recurring-p event) @@ -390,14 +402,14 @@ Return nil for non-recurring EVENT." (when org-freq (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) -(defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." (let* ((start (gnus-icalendar-event:start-time event)) (end (gnus-icalendar-event:end-time event)) - (start-date (format-time-string "%Y-%m-%d %a" start)) + (start-date (format-time-string "%Y-%m-%d" start)) (start-time (format-time-string "%H:%M" start)) (start-at-midnight (string= start-time "00:00")) - (end-date (format-time-string "%Y-%m-%d %a" end)) + (end-date (format-time-string "%Y-%m-%d" end)) (end-time (format-time-string "%H:%M" end)) (end-at-midnight (string= end-time "00:00")) (start-end-date-diff @@ -417,7 +429,7 @@ Return nil for non-recurring EVENT." ;; A 0:0 - A+1 0:0 -> A ;; A 0:0 - A+n 0:0 -> A - A+n-1 ((and start-at-midnight end-at-midnight) (if (> start-end-date-diff 1) - (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day)))) + (let ((end-ts (format-time-string "%Y-%m-%d" (time-subtract end time-1-day)))) (format "<%s>--<%s>" start-date end-ts)) (format "<%s%s>" start-date repeat))) ;; end midnight @@ -425,7 +437,7 @@ Return nil for non-recurring EVENT." ;; A .:. - A+n 0:0 -> A .:. - A_n-1 (end-at-midnight (if (= start-end-date-diff 1) (format "<%s %s-23:59%s>" start-date start-time repeat) - (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day)))) + (let ((end-ts (format-time-string "%Y-%m-%d" (time-subtract end time-1-day)))) (format "<%s %s>--<%s>" start-date start-time end-ts)))) ;; start midnight ;; A 0:0 - A .:. -> A 0:0-.:. (default 1) @@ -448,7 +460,7 @@ Return nil for non-recurring EVENT." (mapconcat #'identity participants ", ")) ;; TODO: make the template customizable -(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) +(cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) "Return string with new `org-mode' entry describing EVENT." (with-temp-buffer (org-mode) @@ -498,16 +510,17 @@ the optional ORG-FILE argument is specified, only that one file is searched." (let ((uid (gnus-icalendar-event:uid event)) (files (or org-file (org-agenda-files t 'ifmode)))) - (gmm-labels - ((find-event-in (file) - (org-check-agenda-file file) - (with-current-buffer (find-file-noselect file) - (let ((event-pos (org-find-entry-with-id uid))) - (when (and event-pos - (string= (cdr (assoc "ICAL_EVENT" (org-entry-properties event-pos))) - "t")) - (throw 'found file)))))) - + (cl-labels + ((find-event-in + (file) + (org-check-agenda-file file) + (with-current-buffer (find-file-noselect file) + (let ((event-pos (org-find-entry-with-id uid))) + (when (and event-pos + (string= (cdr (assoc "ICAL_EVENT" + (org-entry-properties event-pos))) + "t")) + (throw 'found file)))))) (gnus-icalendar-find-if #'find-event-in files)))) @@ -567,22 +580,29 @@ is searched." (fill-region (point-min) (point-max)))) ;; update entry properties - (gmm-labels - ((update-org-entry (position property value) - (if (or (null value) - (string= value "")) - (org-entry-delete position property) - (org-entry-put position property value)))) + (cl-labels + ((update-org-entry + (position property value) + (if (or (null value) + (string= value "")) + (org-entry-delete position property) + (org-entry-put position property value)))) (update-org-entry event-pos "ORGANIZER" organizer) (update-org-entry event-pos "LOCATION" location) - (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) - (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) - (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) + (update-org-entry event-pos "PARTICIPATION_TYPE" + (symbol-name participation-type)) + (update-org-entry event-pos "REQ_PARTICIPANTS" + (gnus-icalendar--format-participant-list + req-participants)) + (update-org-entry event-pos "OPT_PARTICIPANTS" + (gnus-icalendar--format-participant-list + opt-participants)) (update-org-entry event-pos "RRULE" recur) - (update-org-entry event-pos "REPLY" - (if reply-status (capitalize (symbol-name reply-status)) - "Not replied yet"))) + (update-org-entry + event-pos "REPLY" + (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet"))) (save-buffer))))))))) @@ -641,12 +661,12 @@ is searched." (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) -(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) +(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) (if (gnus-icalendar-find-org-event-file event) (gnus-icalendar--update-org-event event reply-status) (gnus-icalendar:org-event-save event reply-status))) -(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) +(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) (when (gnus-icalendar-find-org-event-file event) (gnus-icalendar--cancel-org-event event))) @@ -703,40 +723,43 @@ only makes sense to define names or email addresses." These will be used to retrieve the RSVP information from ical events." (apply #'append - (mapcar (lambda (x) (if (listp x) x (list x))) - (list user-full-name (regexp-quote user-mail-address) - ; NOTE: these can be lists - gnus-ignored-from-addresses ; already regexp-quoted - message-alternative-emails ; - (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) + (mapcar + (lambda (x) (if (listp x) x (list x))) + (list user-full-name (regexp-quote user-mail-address) + ;; NOTE: these can be lists + gnus-ignored-from-addresses ; already regexp-quoted + (unless (functionp message-alternative-emails) ; String or function. + message-alternative-emails) + (mapcar #'regexp-quote gnus-icalendar-additional-identities))))) ;; TODO: make the template customizable -(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) +(cl-defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status) "Format an overview of EVENT details." - (gmm-labels ((format-header (x) - (format "%-12s%s" - (propertize (concat (car x) ":") 'face 'bold) - (cadr x)))) + (cl-labels + ((format-header (x) + (format "%-12s%s" + (propertize (concat (car x) ":") 'face 'bold) + (cadr x)))) (with-slots (organizer summary description location recur uid method rsvp participation-type) event (let ((headers `(("Summary" ,summary) - ("Location" ,(or location "")) - ("Time" ,(gnus-icalendar-event:org-timestamp event)) - ("Organizer" ,organizer) - ("Attendance" ,(if (eq participation-type 'non-participant) - "You are not listed as an attendee" - (capitalize (symbol-name participation-type)))) - ("Method" ,method)))) - - (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) - (setq headers (append headers - `(("Status" ,(or reply-status "Not replied yet")))))) - - (concat - (mapconcat #'format-header headers "\n") - "\n\n" - description))))) + ("Location" ,(or location "")) + ("Time" ,(gnus-icalendar-event:org-timestamp event)) + ("Organizer" ,organizer) + ("Attendance" ,(if (eq participation-type 'non-participant) + "You are not listed as an attendee" + (capitalize (symbol-name participation-type)))) + ("Method" ,method)))) + + (when (and (not (gnus-icalendar-event-reply-p event)) rsvp) + (setq headers (append headers + `(("Status" ,(or reply-status "Not replied yet")))))) + + (concat + (mapconcat #'format-header headers "\n") + "\n\n" + description))))) (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) "Execute BODY in buffer containing the decoded contents of HANDLE." @@ -745,8 +768,7 @@ These will be used to retrieve the RSVP information from ical events." (with-temp-buffer (mm-insert-part ,handle) (when (string= ,charset "utf-8") - (mm-decode-coding-region (point-min) (point-max) 'utf-8)) - + (decode-coding-region (point-min) (point-max) 'utf-8)) ,@body)))) @@ -758,7 +780,7 @@ These will be used to retrieve the RSVP information from ical events." ;; FIXME: the gnus-mime-button-map keymap does not make sense for this kind ;; of button. (let ((start (point))) - (gnus-add-text-properties + (add-text-properties start (progn (insert "[ " text " ]") @@ -769,8 +791,7 @@ These will be used to retrieve the RSVP information from ical events." face ,gnus-article-button-face gnus-data ,data)) (widget-convert-button 'link start (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap))) + :action 'gnus-widget-press-button))) (defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) (let ((message-signature nil)) @@ -794,11 +815,13 @@ These will be used to retrieve the RSVP information from ical events." (current-buffer) status (gnus-icalendar-identities))))) (when reply - (gmm-labels ((fold-icalendar-buffer () - (goto-char (point-min)) - (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) - (replace-match "\\1\n \\2") - (goto-char (line-beginning-position))))) + (cl-labels + ((fold-icalendar-buffer + () + (goto-char (point-min)) + (while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t) + (replace-match "\\1\n \\2") + (goto-char (line-beginning-position))))) (let ((subject (concat (capitalize (symbol-name status)) ": " (gnus-icalendar-event:summary event)))) @@ -819,27 +842,27 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-sync-event-to-org (event) (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) -(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) +(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) (when (gnus-icalendar-event:rsvp event) `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) ("Decline" gnus-icalendar-reply (,handle declined ,event))))) -(defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) +(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) "No buttons for REPLY events." nil) -(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event)) (or (when gnus-icalendar-org-enabled-p (gnus-icalendar--get-org-event-reply-status event)) "Not replied yet")) -(defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) +(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) "No reply status for REPLY events." nil) -(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) +(cl-defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event)) (let* ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)) (export-button-text (if org-entry-exists-p "Update Org Entry" "Export to Org"))) @@ -851,7 +874,7 @@ These will be used to retrieve the RSVP information from ical events." `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) -(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel)) +(cl-defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel)) (let ((org-entry-exists-p (gnus-icalendar-find-org-event-file event))) (delq nil (list @@ -868,13 +891,15 @@ These will be used to retrieve the RSVP information from ical events." (setq gnus-icalendar-reply-status nil) (when event - (gmm-labels ((insert-button-group (buttons) - (when buttons - (mapc (lambda (x) - (apply 'gnus-icalendar-insert-button x) - (insert " ")) - buttons) - (insert "\n\n")))) + (cl-labels + ((insert-button-group + (buttons) + (when buttons + (mapc (lambda (x) + (apply 'gnus-icalendar-insert-button x) + (insert " ")) + buttons) + (insert "\n\n")))) (insert-button-group (gnus-icalendar-event:inline-reply-buttons event handle)) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index d0798d3426a..93545ff39bc 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -164,7 +164,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." (gnus-open-server gnus-select-method) gnus-batch-mode (gnus-y-or-n-p - (gnus-format-message + (format-message "%s (%s) open error: `%s'. Continue? " (car gnus-select-method) (cadr gnus-select-method) (gnus-status-message gnus-select-method))) @@ -777,8 +777,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (message-options-set-recipient) (save-restriction (message-narrow-to-head) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) + (mail-encode-encoded-word-buffer)) (message-encode-message-body))) (let ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) @@ -800,8 +799,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (message-options-set-recipient) (save-restriction (message-narrow-to-head) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) + (mail-encode-encoded-word-buffer)) (message-encode-message-body))) (let* ((func (car (gnus-group-name-to-method group))) (result (funcall (intern (format "%s-request-replace-article" func)) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 8eacc468019..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." 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-ml.el b/lisp/gnus/gnus-ml.el index 8ff36160f09..97bbab41fd1 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -29,9 +29,6 @@ (require 'gnus) (require 'gnus-msg) (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' ;;; Mailing list minor mode @@ -84,12 +81,6 @@ If FORCE is non-nil, replace the old ones." (gnus-mailing-list-mode 1)) (gnus-message 1 "no list-post in this message.")))) -(eval-when-compile - (when (featurep 'xemacs) - (defvar gnus-mailing-list-mode-hook) - (defvar gnus-mailing-list-mode-on-hook) - (defvar gnus-mailing-list-mode-off-hook))) - ;;;###autoload (define-minor-mode gnus-mailing-list-mode "Minor mode for providing mailing-list commands. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index b95bec2ace6..10927cd5260 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -28,13 +28,12 @@ (eval-when-compile (require 'cl)) (require 'gnus) -(require 'gnus-ems) (require 'message) (require 'gnus-art) (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 @@ -72,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." @@ -81,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) @@ -112,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") @@ -496,8 +495,6 @@ Thank you for your help in stamping out bugs. (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) ;; Global value (set (make-local-variable 'mml-buffer-list) mbl1);; Local value - (gnus-make-local-hook 'kill-buffer-hook) - (gnus-make-local-hook 'change-major-mode-hook) (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t) (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) (mml-destroy-buffers) @@ -594,11 +591,9 @@ instead." (defun gnus-inews-add-send-actions (winconf buffer article &optional config yanked winconf-name) - (gnus-make-local-hook 'message-sent-hook) (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc 'gnus-inews-do-gcc) nil t) (when gnus-agent - (gnus-make-local-hook 'message-header-hook) (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method `(lambda (&optional arg) @@ -1139,9 +1134,9 @@ See the variable `gnus-user-agent'." (gnus-v (when (memq 'gnus gnus-user-agent) (concat "Gnus/" - (gnus-replace-in-string - (format "%1.8f" (gnus-continuum-version gnus-version)) - "0+\\'" "") + (replace-regexp-in-string + "0+\\'" "" + (format "%1.8f" (gnus-continuum-version gnus-version))) " (" gnus-version ")"))) (emacs-v (gnus-emacs-version))) (concat gnus-v (when (and gnus-v emacs-v) " ") @@ -1347,7 +1342,7 @@ For the \"inline\" alternatives, also see the variable (gnus-inews-insert-gcc) (let ((gcc (mapcar (lambda (group) - (mm-encode-coding-string + (encode-coding-string group (gnus-group-name-charset (gnus-inews-group-method group) group))) @@ -1364,7 +1359,7 @@ For the \"inline\" alternatives, also see the variable (insert "Gcc: \"" gnus-newsgroup-name "\"\n")) ((stringp self) (insert "Gcc: " - (mm-encode-coding-string + (encode-coding-string (if (string-match " " self) (concat "\"" self "\"") self) @@ -1403,7 +1398,7 @@ For the \"inline\" alternatives, also see the variable tem) (dolist (style styles) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) 'utf-8))))) (dolist (style (if styles (append gnus-posting-styles (list (cons ".*" styles))) gnus-posting-styles)) @@ -1496,7 +1491,7 @@ See `gnus-summary-mail-forward' for ARG." (message-goto-subject) (re-search-forward " *$") (replace-match " (crosspost notification)" t t) - (gnus-deactivate-mark) + (deactivate-mark) (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit)))))) @@ -1642,7 +1637,7 @@ this is a reply." ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group) - group (mm-encode-coding-string + group (encode-coding-string group (gnus-group-name-charset method group))) (unless (gnus-check-server method) @@ -1663,8 +1658,7 @@ this is a reply." (run-hooks 'gnus-gcc-post-body-encode-hook) (save-restriction (message-narrow-to-headers) - (let* ((mail-parse-charset message-default-charset) - (newsgroups-field (save-restriction + (let* ((newsgroups-field (save-restriction (message-narrow-to-headers-or-head) (message-fetch-field "Newsgroups"))) (followup-field (save-restriction @@ -1845,8 +1839,8 @@ this is a reply." (when tmp-style (dolist (style tmp-style) (when (stringp (cadr style)) - (setcdr style (list (mm-decode-coding-string (cadr style) - 'utf-8))))) + (setcdr style (list (decode-coding-string (cadr style) + 'utf-8))))) (setq styles (append styles (list (cons ".*" tmp-style))))))) ;; Go through all styles and look for matches. (dolist (style styles) @@ -1909,10 +1903,10 @@ this is a reply." (cond ((stringp value) (if (and matched-string - (gnus-string-match-p "\\\\[&[:digit:]]" value) + (string-match-p "\\\\[&[:digit:]]" value) (match-beginning 1)) - (gnus-match-substitute-replacement value nil nil - matched-string) + (match-substitute-replacement value nil nil + matched-string) value)) ((or (symbolp value) (functionp value)) @@ -1954,7 +1948,6 @@ this is a reply." (setq name (assq 'name results) address (assq 'address results)) (setq results (delq name (delq address results))) - (gnus-make-local-hook 'message-setup-hook) (setq results (sort results (lambda (x y) (string-lessp (car x) (car y))))) (dolist (result results) @@ -2006,10 +1999,6 @@ this is a reply." (insert "From: " (message-make-from) "\n")))) nil 'local))))) -;;; Allow redefinition of functions. - -(gnus-ems-redefine) - (provide 'gnus-msg) ;;; gnus-msg.el ends here diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 54a75b69c85..2f6d6a8b619 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -81,7 +81,7 @@ not get notifications." (article (nth 2 group-article))) (cond ((string= key "read") (gnus-fetch-group group (list article)) - (gnus-select-frame-set-input-focus (selected-frame))) + (select-frame-set-input-focus (selected-frame))) ((string= key "mark-read") (gnus-update-read-articles group @@ -180,8 +180,11 @@ This is typically a function to add in ;; Ignore mails from ourselves (unless (and gnus-ignored-from-addresses address - (gnus-string-match-p gnus-ignored-from-addresses - address)) + (cond ((functionp gnus-ignored-from-addresses) + (funcall gnus-ignored-from-addresses address)) + (t (string-match-p + (gnus-ignored-from-addresses) + address)))) (let* ((photo-file (gnus-notifications-get-photo-file address)) (notification-id (gnus-notifications-notify (or (car address-components) address) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index bbbe0eded4e..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) @@ -81,7 +81,6 @@ Some people may want to add \"unknown\" to this list." "How should picons be displayed. If `inline', the textual representation is replaced. If `right', picons are added right to the textual representation." - ;; FIXME: `right' needs improvement for XEmacs. :type '(choice (const inline) (const right)) :group 'gnus-picon) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 74e2b827c60..37d5b5b91ad 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -87,12 +87,6 @@ (require 'easymenu) (require 'registry) -;; Silence XEmacs byte compiler, which will otherwise complain about -;; call to `eieio-persistent-read'. -(when (featurep 'xemacs) - (byte-compiler-options - (warnings (- callargs)))) - (defvar gnus-adaptive-word-syntax-table) (defvar gnus-registry-dirty t @@ -832,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) @@ -1036,7 +1029,7 @@ only the last one's marks are returned." (let* ((article (last articles)) (id (gnus-registry-fetch-message-id-fast article)) (marks (when id (gnus-registry-get-id-key id 'mark)))) - (when (gmm-called-interactively-p 'any) + (when (called-interactively-p 'any) (gnus-message 1 "Marks are %S" marks)) marks)) diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el new file mode 100644 index 00000000000..4e6fdc6d877 --- /dev/null +++ b/lisp/gnus/gnus-rfc1843.el @@ -0,0 +1,77 @@ +;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus + +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> +;; Keywords: news HZ HZ+ mail i18n + +;; 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: + +;; Usage: +;; (require 'gnus-rfc1843) +;; (rfc1843-gnus-setup) + +;;; Code: + +(require 'rfc1843) +(require 'gnus-sum) +(require 'gnus-art) +(require 'message) + +(defun rfc1843-decode-article-body () + "Decode HZ encoded text in the article body." + (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + (or gnus-newsgroup-name "")) + (save-excursion + (save-restriction + (message-narrow-to-head) + (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) + (ct (message-fetch-field "Content-Type" t)) + (ctl (and ct (mail-header-parse-content-type ct)))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max)) + (widen) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (when (or (not ctl) + (equal (car ctl) "text/plain")) + (rfc1843-decode-region (point) (point-max)))))))) + +(defun rfc1843-gnus-setup () + "Setup HZ decoding for Gnus." + (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t) + (setq gnus-decode-encoded-word-function + 'gnus-multi-decode-encoded-word-string + gnus-decode-header-function + 'gnus-multi-decode-header + gnus-decode-encoded-word-methods + (nconc gnus-decode-encoded-word-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-string))) + gnus-decode-header-methods + (nconc gnus-decode-header-methods + (list + (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") + 'rfc1843-decode-region))))) + +(provide 'gnus-rfc1843) + +;;; gnus-rfc1843.el ends here diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index d3e82fd7074..2c3aff54898 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -25,9 +25,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (require 'gnus) (require 'gnus-sum) @@ -38,7 +35,7 @@ ;;; (defcustom gnus-pick-display-summary nil - "*Display summary while reading." + "Display summary while reading." :type 'boolean :group 'gnus-summary-pick) @@ -47,11 +44,8 @@ :type 'hook :group 'gnus-summary-pick) -(when (featurep 'xemacs) - (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)) - (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) @@ -63,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) @@ -76,7 +70,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." " " gnus-pick-next-page "u" gnus-pick-unmark-article-or-thread "." gnus-pick-article-or-thread - gnus-down-mouse-2 gnus-pick-mouse-pick-region + [down-mouse-2] gnus-pick-mouse-pick-region "\r" gnus-pick-start-reading) map)) @@ -100,11 +94,6 @@ It accepts the same format specs that `gnus-summary-line-format' does." ["Start reading" gnus-pick-start-reading t] ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) -(eval-when-compile - (when (featurep 'xemacs) - (defvar gnus-pick-mode-on-hook) - (defvar gnus-pick-mode-off-hook))) - (define-minor-mode gnus-pick-mode "Minor mode for providing a pick-and-read interface in Gnus summary buffers. @@ -229,7 +218,7 @@ This must be bound to a button-down mouse event." (start-point (posn-point start-posn)) (start-line (1+ (count-lines (point-min) start-point))) (start-window (posn-window start-posn)) - (bounds (gnus-window-edges start-window)) + (bounds (window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) @@ -339,11 +328,6 @@ This must be bound to a button-down mouse event." '("Pick" ["Switch binary mode off" gnus-binary-mode t])))) -(eval-when-compile - (when (featurep 'xemacs) - (defvar gnus-binary-mode-on-hook) - (defvar gnus-binary-mode-off-hook))) - (define-minor-mode gnus-binary-mode "Minor mode for providing a binary group interface in Gnus summary buffers." :lighter " Binary" :keymap gnus-binary-mode-map @@ -389,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) @@ -401,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) @@ -415,15 +399,10 @@ 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) -(when (featurep 'xemacs) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) - - ;;; Internal variables. (defvar gnus-tmp-name) @@ -458,7 +437,7 @@ Two predefined functions are available: (gnus-define-keys map "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article + [mouse-2] gnus-tree-pick-article "\C-?" gnus-tree-read-summary-keys "h" gnus-tree-show-summary @@ -639,7 +618,7 @@ Two predefined functions are available: (t (cdar gnus-tree-brackets)))) (buffer-read-only nil) beg end) - (gnus-add-text-properties + (add-text-properties (setq beg (point)) (setq end (progn (eval gnus-tree-line-format-spec) (point))) (list 'gnus-number gnus-tmp-number)) @@ -855,8 +834,7 @@ it in the environment specified by BINDINGS." region) (set-buffer gnus-tree-buffer) (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) + (when (not gnus-selected-tree-overlay) ;; Create a new overlay. (overlay-put (setq gnus-selected-tree-overlay @@ -885,13 +863,10 @@ it in the environment specified by BINDINGS." (with-current-buffer (gnus-get-tree-buffer) (let (region) (when (setq region (gnus-tree-article-region article)) - (gnus-put-text-property (car region) (cdr region) 'face face) + (put-text-property (car region) (cdr region) 'face face) (set-window-point (gnus-get-buffer-window (current-buffer) t) (cdr region))))))) -;;; Allow redefinition of functions. -(gnus-ems-redefine) - (provide 'gnus-salt) ;;; gnus-salt.el ends here diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index ef096fe7684..b7360a0f22c 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -29,6 +29,7 @@ (require 'gnus) (require 'gnus-sum) +(require 'gnus-art) (require 'gnus-range) (require 'gnus-win) (require 'message) @@ -126,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 @@ -156,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) @@ -248,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) @@ -274,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)) @@ -283,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")))) @@ -299,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 @@ -739,6 +740,8 @@ current score file." (with-current-buffer gnus-summary-buffer (gnus-score-load-file current-score-file))))) +(autoload 'appt-select-lowest-window "appt") + (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (with-current-buffer (gnus-get-buffer-create "*Score Help*") @@ -773,7 +776,7 @@ current score file." (setq i (1+ i)))) (goto-char (point-min)) ;; display ourselves in a small window at the bottom - (gnus-select-lowest-window) + (appt-select-lowest-window) (if (< (/ (window-height) 2) window-min-height) (switch-to-buffer "*Score Help*") (split-window) @@ -1428,7 +1431,7 @@ If FORMAT, also format the current score file." (and (file-exists-p file) (not (file-writable-p file)))) () - (setq score (setcdr entry (gnus-delete-alist 'touched score))) + (setq score (setcdr entry (assq-delete-all 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook) (if (and (not gnus-adaptive-pretty-print) @@ -1724,7 +1727,7 @@ score in `gnus-newsgroup-scored' by SCORE." nil) (defun gnus-score-decode-text-parts () - (gmm-labels + (cl-labels ((mm-text-parts (handle) (cond ((stringp (car handle)) @@ -1748,7 +1751,7 @@ score in `gnus-newsgroup-scored' by SCORE." (mm-display-inline handle) (goto-char (point-max)))))) - (let (;(mm-text-html-renderer 'w3m-standalone) + (let ( ;(mm-text-html-renderer 'w3m-standalone) (handles (mm-dissect-buffer t))) (save-excursion (article-goto-body) @@ -3048,19 +3051,12 @@ If ADAPT, return the home adaptive file instead." (defun gnus-decay-score (score) "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (let ((n (- score - (* (if (< score 0) -1 1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) - (if (and (featurep 'xemacs) - ;; XEmacs's floor can handle only the floating point - ;; number below the half of the maximum integer. - (> (abs n) (lsh -1 -2))) - (string-to-number - (car (split-string (number-to-string n) "\\."))) - (floor n)))) + (floor (- score + (* (if (< score 0) -1 1) + (min (abs score) + (max gnus-score-decay-constant + (* (abs score) + gnus-score-decay-scale))))))) (defun gnus-decay-scores (alist day) "Decay non-permanent scores in ALIST." diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 2176e3fe34d..a3525d8f28f 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -29,19 +29,6 @@ (require 'gnus) -(defcustom gnus-use-correct-string-widths (featurep 'xemacs) - "*If non-nil, use correct functions for dealing with wide characters." - :version "22.1" - :group 'gnus-format - :type 'boolean) - -(defcustom gnus-make-format-preserve-properties (featurep 'xemacs) - "*If non-nil, use a replacement `format' function which preserves -text properties. This is only needed on XEmacs, as Emacs does this anyway." - :version "22.1" - :group 'gnus-format - :type 'boolean) - ;;; Internal variables. (defvar gnus-summary-mark-positions nil) @@ -79,7 +66,6 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (defvar gnus-tmp-news-method) (defvar gnus-tmp-news-server) (defvar gnus-mouse-face) -(defvar gnus-mouse-face-prop) (defvar gnus-tmp-header) (defvar gnus-tmp-from) @@ -87,11 +73,9 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (header gnus-tmp-from)) (defmacro gnus-lrm-string-p (string) - (if (fboundp 'bidi-string-mark-left-to-right) - ;; LRM, RLM, PDF characters as integers to avoid breaking Emacs - ;; 23. - `(memq (aref ,string (1- (length ,string))) '(8206 8207 8236)) - nil)) + ;; LRM, RLM, PDF characters as integers to avoid breaking Emacs + ;; 23. + `(memq (aref ,string (1- (length ,string))) '(8206 8207 8236))) (defvar gnus-lrm-string (if (ignore-errors (string 8206)) (propertize (string 8206) 'invisible t) @@ -226,9 +210,9 @@ Return a list of updated types." :type 'face) (defun gnus-mouse-face-function (form type) - `(gnus-put-text-property + `(put-text-property (point) (progn ,@form (point)) - gnus-mouse-face-prop + 'mouse-face ,(if (equal type 0) 'gnus-mouse-face `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) @@ -259,23 +243,20 @@ Return a list of updated types." :type 'face) (defun gnus-face-face-function (form type) - `(gnus-add-text-properties + `(add-text-properties (point) (progn ,@form (point)) (cons 'face (cons ;; Delay consing the value of the `face' property until - ;; `gnus-add-text-properties' runs, since it will be modified - ;; by `gnus-put-text-property-excluding-characters-with-faces'. + ;; `add-text-properties' runs, since it will be modified + ;; by `put-text-property-excluding-characters-with-faces'. (list ',(symbol-value (intern (format "gnus-face-%d" type))) 'default) ;; Redundant now, but still convenient. '(gnus-face t))))) (defun gnus-balloon-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - ,(if (fboundp 'balloon-help-mode) - ''balloon-help - ''help-echo) + `(put-text-property + (point) (progn ,@form (point)) 'help-echo ,(intern (format "gnus-balloon-face-%d" type)))) (defun gnus-spec-tab (column) @@ -316,62 +297,42 @@ Return a list of updated types." (setq wend seek) (substring string wstart (1- wend)))) -(defun gnus-string-width-function () - (cond - (gnus-use-correct-string-widths - 'gnus-correct-length) - ((fboundp 'string-width) - 'string-width) - (t - 'length))) - -(defun gnus-substring-function () - (cond - (gnus-use-correct-string-widths - 'gnus-correct-substring) - ((fboundp 'string-width) - 'gnus-correct-substring) - (t - 'substring))) - (defun gnus-tilde-max-form (el max-width) "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width)) - (length-fun (gnus-string-width-function)) - (substring-fun (gnus-substring-function))) + (let ((max (abs max-width))) (if (symbolp el) - `(if (> (,length-fun ,el) ,max) + `(if (> (string-width ,el) ,max) ,(if (< max-width 0) - `(,substring-fun ,el (- (,length-fun ,el) ,max)) + `(gnus-correct-substring ,el (- (string-width ,el) ,max)) `(if (gnus-lrm-string-p ,el) - (concat (,substring-fun ,el 0 ,max) ,gnus-lrm-string) - (,substring-fun ,el 0 ,max))) + (concat (gnus-correct-substring ,el 0 ,max) + ,gnus-lrm-string) + (gnus-correct-substring ,el 0 ,max))) ,el) `(let ((val (eval ,el))) - (if (> (,length-fun val) ,max) + (if (> (string-width val) ,max) ,(if (< max-width 0) - `(,substring-fun val (- (,length-fun val) ,max)) + `(gnus-correct-substring val (- (string-width val) ,max)) `(if (gnus-lrm-string-p val) - (concat (,substring-fun val 0 ,max) ,gnus-lrm-string) - (,substring-fun val 0 ,max))) + (concat (gnus-correct-substring val 0 ,max) + ,gnus-lrm-string) + (gnus-correct-substring val 0 ,max))) val))))) (defun gnus-tilde-cut-form (el cut-width) "Return a form that cuts CUT-WIDTH off of EL." - (let ((cut (abs cut-width)) - (length-fun (gnus-string-width-function)) - (substring-fun (gnus-substring-function))) + (let ((cut (abs cut-width))) (if (symbolp el) - `(if (> (,length-fun ,el) ,cut) + `(if (> (string-width ,el) ,cut) ,(if (< cut-width 0) - `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut)) - `(,substring-fun ,el ,cut)) + `(gnus-correct-substring ,el 0 (- (string-width ,el) ,cut)) + `(gnus-correct-substring ,el ,cut)) ,el) `(let ((val (eval ,el))) - (if (> (,length-fun val) ,cut) + (if (> (string-width val) ,cut) ,(if (< cut-width 0) - `(,substring-fun val 0 (- (,length-fun val) ,cut)) - `(,substring-fun val ,cut)) + `(gnus-correct-substring val 0 (- (string-width val) ,cut)) + `(gnus-correct-substring val ,cut)) val))))) (defun gnus-tilde-ignore-form (el ignore-value) @@ -388,17 +349,16 @@ Return a list of updated types." characters correctly. This is because `format' may pad to columns or to characters when given a pad value." (let ((pad (abs pad-width)) - (side (< 0 pad-width)) - (length-fun (gnus-string-width-function))) + (side (< 0 pad-width))) (if (symbolp el) - `(let ((need (- ,pad (,length-fun ,el)))) + `(let ((need (- ,pad (string-width ,el)))) (if (> need 0) (concat ,(when side '(make-string need ?\ )) ,el ,(when (not side) '(make-string need ?\ ))) ,el)) `(let* ((val (eval ,el)) - (need (- ,pad (,length-fun val)))) + (need (- ,pad (string-width val)))) (if (> need 0) (concat ,(when side '(make-string need ?\ )) val @@ -464,7 +424,7 @@ characters when given a pad value." `(let (gnus-position) ,@(gnus-complex-form-to-spec form spec-alist) (if gnus-position - (gnus-put-text-property gnus-position (1+ gnus-position) + (put-text-property gnus-position (1+ gnus-position) 'gnus-position t))) `(progn ,@(gnus-complex-form-to-spec form spec-alist))))))) @@ -486,42 +446,6 @@ characters when given a pad value." (nth 1 sform))))) form))) - -(defun gnus-xmas-format (fstring &rest args) - "A version of `format' which preserves text properties. - -Required for XEmacs, where the built in `format' function strips all text -properties from both the format string and any inserted strings. - -Only supports the format sequence %s, and %% for inserting -literal % characters. A pad width and an optional - (to right pad) -are supported for %s." - (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") - (n (length args))) - (with-temp-buffer - (insert fstring) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (goto-char (match-end 0)) - (cond - ((string= (match-string 0) "%%") - (delete-char -1)) - (t - (if (null args) - (signal 'wrong-number-of-arguments - (list #'gnus-xmas-format n fstring))) - (let* ((minlen (string-to-number (or (match-string 2) ""))) - (arg (car args)) - (str (if (stringp arg) arg (format "%s" arg))) - (lpad (null (match-string 1))) - (padlen (max 0 (- minlen (length str))))) - (replace-match "") - (if lpad (insert-char ?\ padlen)) - (insert str) - (unless lpad (insert-char ?\ padlen)) - (setq args (cdr args)))))) - (buffer-string)))) - (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return a @@ -628,14 +552,10 @@ are supported for %s." (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) ;; Insert the new format elements. - (when (and pad-width - (not (and (featurep 'xemacs) - gnus-use-correct-string-widths))) + (when pad-width (insert (number-to-string pad-width))) ;; Create the form to be evalled. - (if (or max-width cut-width ignore-value - (and (featurep 'xemacs) - gnus-use-correct-string-widths)) + (if (or max-width cut-width ignore-value) (progn (insert ?s) (let ((el (car elem))) @@ -690,13 +610,6 @@ are supported for %s." ;; A single string spec in the end of the spec. ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) (list (match-string 1 fstring) (car flist))) - ;; Only string (and %) specs (XEmacs only!) - ((and (featurep 'xemacs) - gnus-make-format-preserve-properties - (string-match - "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'" - fstring)) - (list (cons 'gnus-xmas-format (cons fstring (nreverse flist))))) ;; A more complex spec. (t (list (cons 'format (cons fstring (nreverse flist))))))) @@ -717,7 +630,7 @@ are supported for %s." If PROPS, insert the result." (let ((form (gnus-parse-format format alist props))) (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) + (add-text-properties (point) (progn (eval form) (point)) props) (eval form)))) (defun gnus-set-format (type &optional insertable) @@ -727,6 +640,25 @@ If PROPS, insert the result." (symbol-value (intern (format "gnus-%s-line-format-alist" type))) insertable))) + + (defun gnus-summary-line-format-spec () + (insert gnus-tmp-unread gnus-tmp-replied + gnus-tmp-score-char gnus-tmp-indentation) + (put-text-property + (point) + (progn + (insert + gnus-tmp-opening-bracket + (format "%4d: %-20s" + gnus-tmp-lines + (if (> (length gnus-tmp-name) 20) + (truncate-string-to-width gnus-tmp-name 20) + gnus-tmp-name)) + gnus-tmp-closing-bracket) + (point)) + 'mouse-face gnus-mouse-face) + (insert " " gnus-tmp-subject-or-nil "\n")) + (provide 'gnus-spec) ;; Local Variables: diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 5874bd76085..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] @@ -156,7 +160,7 @@ If nil, a faster, but more primitive, buffer is used instead." (gnus-define-keys gnus-server-mode-map " " gnus-server-read-server-in-server-buffer "\r" gnus-server-read-server - gnus-mouse-2 gnus-server-pick-server + [mouse-2] gnus-server-pick-server "q" gnus-server-exit "l" gnus-server-list-servers "k" gnus-server-kill-server @@ -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) @@ -280,10 +293,8 @@ The following commands are available: (buffer-disable-undo) (setq truncate-lines t) (setq buffer-read-only t) - (if (featurep 'xemacs) - (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t)) - (set (make-local-variable 'font-lock-defaults) - '(gnus-server-font-lock-keywords t))) + (set (make-local-variable 'font-lock-defaults) + '(gnus-server-font-lock-keywords t)) (gnus-run-mode-hooks 'gnus-server-mode-hook)) (defun gnus-server-insert-server-line (name method) @@ -306,11 +317,15 @@ 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) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) ;; Insert the text. @@ -686,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 @@ -804,7 +821,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (mm-string-as-unibyte + (string-as-unibyte (buffer-substring (point) (progn @@ -817,7 +834,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (mm-string-as-unibyte + (string-as-unibyte (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -865,7 +882,7 @@ claim them." (prefix (let ((gnus-select-method orig-select-method)) (gnus-group-prefixed-name "" method)))) (while (setq group (pop groups)) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) (insert @@ -882,10 +899,9 @@ claim them." (t ?K))) (max 0 (- (1+ (cddr group)) (cadr group))) ;; Don't decode if name is ASCII - (if (and (fboundp 'detect-coding-string) - (eq (detect-coding-string name t) 'undecided)) + (if (eq (detect-coding-string name t) 'undecided) name - (mm-decode-coding-string + (decode-coding-string name (inline (gnus-group-name-charset method name))))))) (list 'gnus-group name) @@ -1131,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 34a5ff6cbac..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) @@ -865,11 +865,6 @@ If REGEXP is given, lines that match it will be deleted." ;; Make sure that each dribble entry is a single line, so that ;; the "remove" code above works. (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n") - ;; This has been commented by Josh Huber <huber@alum.wpi.edu> - ;; It causes problems with both XEmacs and Emacs 21, and doesn't - ;; seem to be of much value. (FIXME: remove this after we make sure - ;; it's not needed). - ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) (with-current-buffer gnus-group-buffer (gnus-group-set-mode-line)) @@ -893,9 +888,7 @@ If REGEXP is given, lines that match it will be deleted." (setq buffer-file-name dribble-file) ;; The buffer may be shrunk a lot when deleting old entries. ;; It caused the auto-saving to stop. - (if (featurep 'emacs) - (set (make-local-variable 'auto-save-include-big-deletions) t) - (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil)) + (set (make-local-variable 'auto-save-include-big-deletions) t) (auto-save-mode t) (buffer-disable-undo) (bury-buffer (current-buffer)) @@ -1675,10 +1668,10 @@ backend check whether the group actually exists." type-cache)) ;; Only add groups that need updating. (if (or (and foreign-level (null (numberp foreign-level))) - (funcall (if one-level #'= #'<=) (gnus-info-level info) - (if (eq (cadr method-group-list) 'foreign) - foreign-level - alevel))) + (funcall (if one-level #'= #'<=) (gnus-info-level info) + (if (eq (cadr method-group-list) 'foreign) + foreign-level + alevel))) (setcar (nthcdr 2 method-group-list) (cons info (nth 2 method-group-list))) ;; The group is inactive, so we nix out the number of unread articles. @@ -1997,7 +1990,7 @@ backend check whether the group actually exists." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb) + (gnus-sethash (string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2393,8 +2386,8 @@ If FORCE is non-nil, the .newsrc file is read." (funcall func convert-to))) (gnus-dribble-enter - (gnus-format-message ";Converted gnus from version `%s' to `%s'." - gnus-newsrc-file-version gnus-version))))))) + (format-message ";Converted gnus from version `%s' to `%s'." + gnus-newsrc-file-version gnus-version))))))) (defun gnus-convert-mark-converter-prompt (converter no-prompt) "Indicate whether CONVERTER requires gnus-convert-old-newsrc to @@ -2460,7 +2453,7 @@ If FORCE is non-nil, the .newsrc file is read." (dolist (elem gnus-newsrc-alist) ;; Protect against broken .newsrc.el files. (when (car elem) - (setcar elem (mm-string-as-unibyte (car elem))))) + (setcar elem (string-as-unibyte (car elem))))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -3032,7 +3025,7 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-slave-save-newsrc () (with-current-buffer gnus-dribble-buffer (let ((slave-name - (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) + (make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) (let ((coding-system-for-write gnus-ding-file-coding-system)) @@ -3164,8 +3157,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-parameter-charset name) gnus-default-charset))) ;; Fixme: Don't decode in unibyte mode. - (when (and str charset (featurep 'mule)) - (setq str (mm-decode-coding-string str charset))) + (when (and str charset) + (setq str (decode-coding-string str charset))) (set group str))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") @@ -3203,26 +3196,7 @@ If this variable is nil, don't do anything." (defun gnus-check-reasonable-setup () ;; Check whether nnml and nnfolder share a directory. - (let ((display-warn - (if (fboundp 'display-warning) - 'display-warning - (lambda (type message) - (if noninteractive - (message "Warning (%s): %s" type message) - (let (window) - (with-current-buffer (get-buffer-create "*Warnings*") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert (format "Warning (%s): %s\n" type message)) - (setq window (display-buffer (current-buffer))) - (set-window-start - window - (prog2 - (forward-line (- 1 (window-height window))) - (point) - (goto-char (point-max)))))))))) - method active actives match) + (let (method active actives match) (dolist (server gnus-server-alist) (setq method (gnus-server-to-method server) active (intern (format "%s-active-file" (car method)))) @@ -3230,11 +3204,11 @@ If this variable is nil, don't do anything." (gnus-server-opened method) (boundp active)) (when (setq match (assoc (symbol-value active) actives)) - (funcall display-warn 'gnus-server - (format "%s and %s share the same active file %s" - (car method) - (cadr match) - (car match)))) + (display-warning 'gnus-server + (format "%s and %s share the same active file %s" + (car method) + (cadr match) + (car match)))) (push (list (symbol-value active) method) actives))))) (provide 'gnus-start) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 378d342d669..b6023c2c931 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -24,11 +24,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' +(eval-when-compile (require 'cl)) (defvar tool-bar-mode) (defvar gnus-tmp-header) @@ -60,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 @@ -82,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 @@ -109,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" @@ -124,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 @@ -159,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." @@ -167,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 @@ -192,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." @@ -210,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 @@ -221,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. @@ -245,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 @@ -253,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" @@ -261,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" @@ -269,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." @@ -284,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." @@ -302,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'. @@ -328,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) @@ -357,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 @@ -377,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 @@ -395,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 @@ -424,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 @@ -442,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 @@ -450,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 @@ -465,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 @@ -489,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." @@ -516,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) @@ -680,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) @@ -703,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 @@ -712,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. @@ -738,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: @@ -771,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 @@ -812,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 @@ -845,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 @@ -891,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" @@ -914,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. @@ -942,50 +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) -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) - (add-hook 'gnus-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off)) - (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 @@ -1003,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 @@ -1038,44 +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 - (and (fboundp 'display-graphic-p) - (display-graphic-p)) - "*If non-nil, display an arrow highlighting the current article." +(defcustom gnus-summary-display-arrow (display-graphic-p) + "If non-nil, display an arrow highlighting the current article." :version "22.1" :group 'gnus-summary :type 'boolean) @@ -1125,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 @@ -1161,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)) @@ -1170,25 +1157,30 @@ 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. -This can be a regexp or a list of regexps." + "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." :version "21.1" :group 'gnus-summary :type '(choice regexp - (repeat :tag "Regexp List" regexp))) + (repeat :tag "Regexp List" regexp) + function)) (defsubst gnus-ignored-from-addresses () - (gmm-regexp-concat gnus-ignored-from-addresses)) + (cond ((functionp gnus-ignored-from-addresses) + gnus-ignored-from-addresses) + (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 @@ -1272,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." @@ -1896,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 @@ -1931,7 +1923,7 @@ increase the score of each group you read." "q" gnus-summary-exit "Q" gnus-summary-exit-no-update "\C-c\C-i" gnus-info-find-node - gnus-mouse-2 gnus-mouse-pick-article + [mouse-2] gnus-mouse-pick-article [follow-link] mouse-face "m" gnus-summary-mail-other-window "a" gnus-summary-post-news @@ -2399,8 +2391,7 @@ increase the score of each group you read." ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body :active (not (gnus-group-read-only-p)) - ,@(if (featurep 'xemacs) nil - '(:help "Encrypt the message body on disk"))] + :help "Encrypt the message body on disk"] ["Extract all parts..." gnus-summary-save-parts t] ("Multipart" ["Repair multipart" gnus-summary-repair-multipart t] @@ -2409,8 +2400,7 @@ increase the score of each group you read." ["View part as type..." gnus-article-view-part-as-type t] ["Encrypt body" gnus-article-encrypt-body :active (not (gnus-group-read-only-p)) - ,@(if (featurep 'xemacs) nil - '(:help "Encrypt the message body on disk"))] + :help "Encrypt the message body on disk"] ["View part externally" gnus-article-view-part-externally t] ["View HTML parts in browser" gnus-article-browse-html-article t] ["View part with charset..." gnus-article-view-part-as-charset t] @@ -2450,10 +2440,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) '((1 . ,cs)))) (gnus-summary-show-article 1)))) `[,(symbol-name cs) ,command t])) - (sort (if (fboundp 'coding-system-list) - (coding-system-list) - (mapcar 'car mm-mime-mule-charset-alist)) - 'string<))))) + (sort (coding-system-list) 'string<))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -2477,8 +2464,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["Rot 13" gnus-summary-caesar-message - ,@(if (featurep 'xemacs) '(t) - '(:help "\"Caesar rotate\" article by 13"))] + :help "\"Caesar rotate\" article by 13"] ["De-IDNA" gnus-summary-idna-message t] ["Morse decode" gnus-summary-morse-message t] ["Unix pipe..." gnus-summary-pipe-message t] @@ -2503,11 +2489,9 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ) ("Output" ["Save in default format..." gnus-summary-save-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Save article using default method"))] + :help "Save article using default method"] ["Save in file..." gnus-summary-save-article-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Save article in file"))] + :help "Save article in file"] ["Save in Unix mail format..." gnus-summary-save-article-mail t] ["Save in MH folder..." gnus-summary-save-article-folder t] ["Save in VM folder..." gnus-summary-save-article-vm t] @@ -2516,11 +2500,9 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Pipe through a filter..." gnus-summary-pipe-output t] ["Print with Muttprint..." gnus-summary-muttprint t] ["Print" gnus-summary-print-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Generate and print a PostScript image"))]) + :help "Generate and print a PostScript image"]) ("Copy, move,... (Backend)" - ,@(if (featurep 'xemacs) nil - '(:help "Copying, moving, expiring articles...")) + :help "Copying, moving, expiring articles..." ["Respool article..." gnus-summary-respool-article t] ["Move article..." gnus-summary-move-article (gnus-check-backend-function @@ -2547,9 +2529,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) ("Extract" - ["Uudecode" gnus-uu-decode-uu - ,@(if (featurep 'xemacs) '(t) - '(:help "Decode uuencoded article(s)"))] + ["Uudecode" gnus-uu-decode-uu :help "Decode uuencoded article(s)"] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] @@ -2582,7 +2562,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (easy-menu-define gnus-article-commands-menu gnus-article-mode-map "" (cons "Commands" innards)) - ;; in Emacs, don't share menu. + ;; Don't share the menu. (setq gnus-article-commands-menu (copy-keymap gnus-summary-article-menu)) (define-key gnus-article-mode-map [menu-bar commands] @@ -2612,28 +2592,22 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) gnus-summary-post-menu gnus-summary-mode-map "" `("Post" ["Send a message (mail or news)" gnus-summary-post-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Compose a new message (mail or news)"))] + :help "Compose a new message (mail or news)"] ["Followup" gnus-summary-followup - ,@(if (featurep 'xemacs) '(t) - '(:help "Post followup to this article"))] + :help "Post followup to this article"] ["Followup and yank" gnus-summary-followup-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Post followup to this article, quoting its contents"))] + :help "Post followup to this article, quoting its contents"] ["Supersede article" gnus-summary-supersede-article t] ["Cancel article" gnus-summary-cancel-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Cancel an article you posted"))] + :help "Cancel an article you posted"] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Wide reply" gnus-summary-wide-reply t] ["Wide reply and yank" gnus-summary-wide-reply-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Mail a reply, quoting this article"))] + :help "Mail a reply, quoting this article"] ["Very wide reply" gnus-summary-very-wide-reply t] ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Mail a very wide reply, quoting this article"))] + :help "Mail a very wide reply, quoting this article"] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] @@ -2644,38 +2618,25 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Send a mail" gnus-summary-mail-other-window t] ["Create a local message" gnus-summary-news-other-window t] ["Uuencode and post" gnus-uu-post-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Post a uuencoded article"))] + :help "Post a uuencoded article"] ["Followup via news" gnus-summary-followup-to-mail t] ["Followup via news and yank" gnus-summary-followup-to-mail-with-original t] ["Strip signature on reply" (lambda () (interactive) - (if (not (memq message-cite-function - '(message-cite-original-without-signature - message-cite-original))) - ;; Stupid workaround for XEmacs not honoring :visible. - (message "Can't toggle this value of `message-cite-function'") - (setq message-cite-function - (if (eq message-cite-function - 'message-cite-original-without-signature) - 'message-cite-original - 'message-cite-original-without-signature)))) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (memq message-cite-function - '(message-cite-original-without-signature - message-cite-original)))) + (setq message-cite-function + (if (eq message-cite-function + 'message-cite-original-without-signature) + 'message-cite-original + 'message-cite-original-without-signature))) + :visible (memq message-cite-function + '(message-cite-original-without-signature + message-cite-original)) :style toggle :selected (eq message-cite-function 'message-cite-original-without-signature) - ,@(if (featurep 'xemacs) nil - '(:help "Strip signature from cited article when replying."))] - ;;("Draft" - ;;["Send" gnus-summary-send-draft t] - ;;["Send bounced" gnus-resend-bounced-mail t]) - )) + :help "Strip signature from cited article when replying."])) (cond ((not (keymapp gnus-summary-post-menu)) @@ -2696,13 +2657,11 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] ["Catchup" gnus-summary-catchup - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark unread articles in this group as read"))] + :help "Mark unread articles in this group as read"] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup from here" gnus-summary-catchup-from-here t] - ["Catchup region" gnus-summary-mark-region-as-read - (gnus-mark-active-p)] + ["Catchup region" gnus-summary-mark-region-as-read mark-active] ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) ("Mark Various" ["Tick" gnus-summary-tick-article-forward t] @@ -2741,8 +2700,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Invert marks" gnus-uu-invert-processable t] ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)] - ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)] + ["Mark region" gnus-uu-mark-region mark-active] + ["Unmark region" gnus-uu-unmark-region mark-active] ["Mark by regexp..." gnus-uu-mark-by-regexp t] ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] ["Mark all" gnus-uu-mark-all t] @@ -2759,11 +2718,9 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ("Registry Marks") ("Scroll article" ["Page forward" gnus-summary-next-page - ,@(if (featurep 'xemacs) '(t) - '(:help "Show next page of article"))] + :help "Show next page of article"] ["Page backward" gnus-summary-prev-page - ,@(if (featurep 'xemacs) '(t) - '(:help "Show previous page of article"))] + :help "Show previous page of article"] ["Line forward" gnus-summary-scroll-up t]) ("Move" ["Next unread article" gnus-summary-next-unread-article t] @@ -2811,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 @@ -2823,14 +2780,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Send a bug report" gnus-bug t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark unread articles in this group as read, then exit"))] + :help "Mark unread articles in this group as read, then exit"] ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t] ["Exit group" gnus-summary-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Exit current group, return to group selection mode"))] + :help "Exit current group, return to group selection mode"] ["Exit group without updating" gnus-summary-exit-no-update t] ["Exit and goto next group" gnus-summary-next-group t] ["Exit and goto prev group" gnus-summary-prev-group t] @@ -2979,17 +2934,12 @@ See `gmm-tool-bar-from-list' for the format of the list." (defun gnus-summary-make-tool-bar (&optional force) "Make a summary mode tool bar from `gnus-summary-tool-bar'. When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) + (when (and (boundp 'tool-bar-mode) tool-bar-mode (or (not gnus-summary-tool-bar-map) force)) (let* ((load-path - (gmm-image-load-path-for-library "gnus" - "mail/save.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path))) + (image-load-path-for-library "gnus" "mail/save.xpm" nil t)) + (image-load-path (cons (car load-path) image-load-path)) (map (gmm-tool-bar-from-list gnus-summary-tool-bar gnus-summary-tool-bar-zap-list 'gnus-summary-mode-map))) @@ -3120,12 +3070,10 @@ The following commands are available: (setq mode-name "Summary") (use-local-map gnus-summary-mode-map) (buffer-disable-undo) - (setq buffer-read-only t ;Disable modification - show-trailing-whitespace nil) - (setq truncate-lines t) - ;; Force paragraph direction to be left-to-right. Don't make it - ;; bound globally in old Emacsen and XEmacsen. - (set (make-local-variable 'bidi-paragraph-direction) 'left-to-right) + (setq buffer-read-only t + show-trailing-whitespace nil + truncate-lines t + bidi-paragraph-direction 'left-to-right) (add-to-invisibility-spec '(gnus-sum . t)) (gnus-summary-set-display-table) (gnus-set-default-directory) @@ -3134,7 +3082,6 @@ The following commands are available: (make-local-variable 'gnus-summary-dummy-line-format) (make-local-variable 'gnus-summary-dummy-line-format-spec) (make-local-variable 'gnus-summary-mark-positions) - (gnus-make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-mode-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) @@ -3479,13 +3426,13 @@ display only a single character." (i 32)) ;; Nix out all the control chars... (while (>= (setq i (1- i)) 0) - (gnus-put-display-table i [??] table)) + (aset table i [??])) ;; ... but not newline and cr, of course. (cr is necessary for the ;; selective display). - (gnus-put-display-table ?\n nil table) - (gnus-put-display-table ?\r nil table) + (aset table ?\n nil) + (aset table ?\r nil) ;; We keep TAB as well. - (gnus-put-display-table ?\t nil table) + (aset table ?\t nil) ;; We nix out any glyphs 127 through 255, or 127 through 159 in ;; Emacs 23 (unicode), that are not set already. (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160)) @@ -3493,8 +3440,8 @@ display only a single character." 256))) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. - (unless (gnus-get-display-table i table) - (gnus-put-display-table i [??] table)))) + (unless (aref table i) + (aset table i [??])))) (setq buffer-display-table table))) (defun gnus-summary-set-article-display-arrow (pos) @@ -3676,7 +3623,7 @@ buffer that was in action when the last article was fetched." (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) "Insert a dummy root in the summary buffer." (beginning-of-line) - (gnus-add-text-properties + (add-text-properties (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) @@ -3686,15 +3633,17 @@ buffer that was in action when the last article was fetched." (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) (let ((mail-parse-charset gnus-newsgroup-charset) - (ignored-from-addresses (gnus-ignored-from-addresses)) ;; Is it really necessary to do this next part for each summary line? ;; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) (or - (and ignored-from-addresses - (string-match ignored-from-addresses gnus-tmp-from) + (and gnus-ignored-from-addresses + (cond ((functionp gnus-ignored-from-addresses) + (funcall gnus-ignored-from-addresses + (mail-strip-quoted-names gnus-tmp-from))) + (t (string-match (gnus-ignored-from-addresses) gnus-tmp-from))) (let ((extra-headers (mail-header-extra header)) to newsgroups) @@ -3713,7 +3662,7 @@ buffer that was in action when the last article was fetched." gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (gnus-string-mark-left-to-right + (bidi-string-mark-left-to-right (inline (gnus-summary-extract-address-component gnus-tmp-from)))))) @@ -3780,7 +3729,7 @@ buffer that was in action when the last article was fetched." (setq gnus-tmp-lines "?") (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) (condition-case () - (gnus-put-text-property + (put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number gnus-tmp-number) @@ -3897,8 +3846,8 @@ respectively." Returns \" ? \" if there's bad input or if another error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () - (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date))) - (now (gnus-float-time)) + (let* ((messy-date (float-time (gnus-date-get-time messy-date))) + (now (float-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) (let* ((difference (- now messy-date)) @@ -4488,9 +4437,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-remove-odd-characters (string) "Translate STRING into something that doesn't contain weird characters." - (mm-subst-char-in-string + (subst-char-in-string ?\r ?\- - (mm-subst-char-in-string ?\n ?\- string t) t)) + (subst-char-in-string ?\n ?\- string t) t)) ;; This function has to be called with point after the article number ;; on the beginning of the line. @@ -4800,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." @@ -5110,7 +5059,7 @@ Unscored articles will be counted as having a score of zero." (defun gnus-thread-latest-date (thread) "Return the highest article date in THREAD." (apply 'max - (mapcar (lambda (header) (gnus-float-time + (mapcar (lambda (header) (float-time (gnus-date-get-time (mail-header-date header)))) (message-flatten-list thread)))) @@ -5470,7 +5419,7 @@ or a straight list of headers." (if (= gnus-tmp-lines -1) (setq gnus-tmp-lines "?") (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) - (gnus-put-text-property + (put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number number) @@ -5620,15 +5569,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" - (mm-decode-coding-string group charset) - (mm-decode-coding-string (gnus-status-message group) charset)))) + (decode-coding-string group charset) + (decode-coding-string (gnus-status-message group) charset)))) (unless (gnus-request-group group t nil (gnus-get-info group)) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" - (mm-decode-coding-string group charset) - (mm-decode-coding-string (gnus-status-message group) charset))) + (decode-coding-string group charset) + (decode-coding-string (gnus-status-message group) charset))) (when (and gnus-agent (gnus-active group)) @@ -6085,6 +6034,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) + ;; When exiting the group, everything that's previously been + ;; unseen is now seen. (when (eq (cdr type) 'seen) (setq list (gnus-range-add list gnus-newsgroup-unseen))) @@ -6677,7 +6628,7 @@ current article will be taken into consideration." (gnus-summary-find-next nil article))) (decf n))) (nreverse articles))) - ((and (gnus-region-active-p) (mark)) + ((and (and transient-mark-mode mark-active) (mark)) (message "region active") ;; Work on the region between point and mark. (let ((max (max (point) (mark))) @@ -6867,9 +6818,7 @@ Also do horizontal recentering." (when (and gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) - (if (fboundp 'recenter-top-bottom) - (recenter-top-bottom n) - (recenter n))) + (recenter-top-bottom n)) (put 'gnus-recenter 'isearch-scroll t) @@ -6880,8 +6829,8 @@ Like forward-line, but skip over (and don't count) invisible lines." (while (and (> n 0) (not done)) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. - (while (gnus-invisible-p (point)) - (goto-char (gnus-next-char-property-change (point)))) + (while (invisible-p (point)) + (goto-char (next-char-property-change (point)))) (forward-line 1) (if (eobp) (setq done t) @@ -6890,8 +6839,8 @@ Like forward-line, but skip over (and don't count) invisible lines." (forward-line -1) (if (bobp) (setq done t) (setq n (1+ n)) - (while (and (not (bobp)) (gnus-invisible-p (1- (point)))) - (goto-char (gnus-previous-char-property-change (point)))))))) + (while (and (not (bobp)) (invisible-p (1- (point)))) + (goto-char (previous-char-property-change (point)))))))) (defun gnus-summary-recenter () "Center point in the summary window. @@ -7110,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. @@ -7814,9 +7757,7 @@ If BACKWARD, the previous article is selected instead of the next." (t (unless (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd (if (featurep 'xemacs) - last-command-char - last-command-event)) + (let ((cmd last-command-event) (point (with-current-buffer gnus-group-buffer (point))) @@ -7844,7 +7785,7 @@ If BACKWARD, the previous article is selected instead of the next." "exiting")) (gnus-summary-next-group nil group backward))) (t - (when (gnus-key-press-event-p last-input-event) + (when (numberp last-input-event) ;; Somehow or other, we may now have selected a different ;; window. Make point go back to the summary buffer. (when (eq current-summary (current-buffer)) @@ -8368,15 +8309,14 @@ in `nnmail-extra-headers'." (gnus-summary-position-point)))) (defun gnus-summary-limit-strange-charsets-predicate (header) - (when (fboundp 'char-charset) - (let ((string (concat (mail-header-subject header) - (mail-header-from header))) - charset found) - (dotimes (i (1- (length string))) - (setq charset (format "%s" (char-charset (aref string (1+ i))))) - (when (string-match "unicode\\|big\\|japanese" charset) - (setq found t))) - found))) + (let ((string (concat (mail-header-subject header) + (mail-header-from header))) + charset found) + (dotimes (i (1- (length string))) + (setq charset (format "%s" (char-charset (aref string (1+ i))))) + (when (string-match "unicode\\|big\\|japanese" charset) + (setq found t))) + found)) (defun gnus-summary-limit-to-predicate (predicate) "Limit to articles where PREDICATE returns non-nil. @@ -8671,7 +8611,7 @@ fetched for this group." (gnus-agent nil) (gnus-read-all-available-headers t)) (setq gnus-newsgroup-headers - (gnus-merge + (cl-merge 'list gnus-newsgroup-headers (gnus-fetch-headers articles nil t) 'gnus-article-sort-by-number)) @@ -9083,7 +9023,7 @@ non-numeric or nil fetch the number specified by the (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads)) (setq gnus-newsgroup-headers (gnus-delete-duplicate-headers - (gnus-merge + (cl-merge 'list gnus-newsgroup-headers new-headers 'gnus-article-sort-by-number))) (setq gnus-newsgroup-articles @@ -9132,7 +9072,7 @@ non-numeric or nil fetch the number specified by the (gnus-warp-to-article) (when (and (stringp message-id) (not (zerop (length message-id)))) - (setq message-id (gnus-replace-in-string message-id " " "")) + (setq message-id (replace-regexp-in-string " " "" message-id)) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (unless (string-match "^<" message-id) @@ -9435,7 +9375,6 @@ Optional argument BACKWARD means do search for backward. (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) - (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. (gnus-visual nil) (gnus-keep-backlog nil) @@ -9611,10 +9550,10 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-print-truncate-and-quote (string &optional len) "Truncate to LEN and quote all \"(\"'s in STRING." - (gnus-replace-in-string (if (and len (> (length string) len)) - (substring string 0 len) - string) - "[()]" "\\\\\\&")) + (replace-regexp-in-string "[()]" "\\\\\\&" + (if (and len (> (length string) len)) + (substring string 0 len) + string))) (defun gnus-summary-print-article (&optional filename n) "Generate and print a PostScript image of the process-marked (mail) articles. @@ -9701,7 +9640,7 @@ C-u g', show the raw article." (gnus-summary-show-article t) (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system + (read-coding-system "View as charset: " ;; actually it is coding system. (with-current-buffer gnus-article-buffer (mm-detect-coding-region (point) (point-max)))))) @@ -9862,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 @@ -9873,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." @@ -9996,7 +9924,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." encoded to-newsgroup to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) (set (intern (format "gnus-current-%s-group" action)) - (mm-decode-coding-string + (decode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup)))) (unless to-method @@ -10006,7 +9934,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (setq to-newsgroup (or encoded (and to-newsgroup - (mm-encode-coding-string + (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))))) ;; Check the method we are to move this article to... @@ -10589,7 +10517,6 @@ groups." (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) `(lambda (no-highlight) (let ((mail-parse-charset ',gnus-newsgroup-charset) @@ -10830,7 +10757,7 @@ If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." (interactive "P") - (if (and (null n) (gnus-region-active-p)) + (if (and (null n) (and transient-mark-mode mark-active)) (gnus-uu-mark-region (region-beginning) (region-end) unmark) (setq n (prefix-numeric-value n)) (let ((backward (< n 0)) @@ -11184,7 +11111,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (goto-char (+ forward (point))) ;; Replace the old mark with the new mark. (let ((to-insert - (mm-subst-char-in-string + (subst-char-in-string (char-after) mark (buffer-substring (point) (1+ (point)))))) (delete-region (point) (1+ (point))) @@ -11716,17 +11643,7 @@ Returns nil if no thread was there to be shown." (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) ;; Leave point at bol (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) - (eoi (when end - (if (fboundp 'next-single-char-property-change) - ;; Note: XEmacs version of n-s-c-p-c may return nil - (or (next-single-char-property-change end 'invisible) - (point-max)) - (while (progn - (end-of-line 2) - (and (not (eobp)) - (eq (get-char-property (point) 'invisible) - 'gnus-sum)))) - (point))))) + (eoi (and end (next-single-char-property-change end 'invisible)))) (when eoi (remove-overlays beg eoi 'invisible 'gnus-sum) (goto-char orig) @@ -12130,7 +12047,7 @@ no matter what the properties `:decode' and `:headers' are." command result) (unless (numberp (car articles)) (error "No article to pipe")) - (setq command (gnus-read-shell-command + (setq command (read-shell-command (concat "Shell command on " (if (cdr articles) (format "these %d articles" (length articles)) @@ -12301,7 +12218,6 @@ save those articles instead." (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) - (minibuffer-confirm-incomplete nil) ; XEmacs (prom (format "%s %s to" prompt @@ -12331,7 +12247,7 @@ save those articles instead." (setq to-newsgroup default)) (unless to-newsgroup (error "No group name entered")) - (setq encoded (mm-encode-coding-string + (setq encoded (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))) (or (gnus-active encoded) @@ -12457,9 +12373,9 @@ If REVERSE, save parts that do not match TYPE." ": " (or (cdr (assq 'execute (car pslist))) "") "\n") (setq e (point)) (forward-line -1) ; back to `b' - (gnus-add-text-properties + (add-text-properties b (1- e) (list 'gnus-number gnus-reffed-article-number - gnus-mouse-face-prop gnus-mouse-face)) + 'mouse-face gnus-mouse-face)) (gnus-data-enter after-article gnus-reffed-article-number gnus-unread-mark b (car pslist) 0 (- e b)) @@ -12601,16 +12517,16 @@ If REVERSE, save parts that do not match TYPE." (let* ((beg (point-at-bol)) (end (point-at-eol)) ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. - (from (if (get-text-property beg gnus-mouse-face-prop) + (from (if (get-text-property beg 'mouse-face) beg (or (next-single-property-change - beg gnus-mouse-face-prop nil end) + beg 'mouse-face nil end) beg))) (to (if (= from end) (- from 2) (or (next-single-property-change - from gnus-mouse-face-prop nil end) + from 'mouse-face nil end) end)))) ;; If no mouse-face prop on line we will have to = from = end, ;; so we highlight the entire line instead. @@ -12914,10 +12830,10 @@ returned." (mail-header-number h)) gnus-newsgroup-headers))) (setq gnus-newsgroup-headers - (gnus-merge 'list - gnus-newsgroup-headers - (gnus-fetch-headers articles nil t) - 'gnus-article-sort-by-number)) + (cl-merge 'list + gnus-newsgroup-headers + (gnus-fetch-headers articles nil t) + 'gnus-article-sort-by-number)) (setq gnus-newsgroup-articles (gnus-sorted-nunion gnus-newsgroup-articles articles)) ;; Suppress duplicates? @@ -13115,8 +13031,6 @@ BOOKMARK is a bookmark name or a bookmark record." (gnus-summary-make-all-marking-commands) -(gnus-ems-redefine) - (provide 'gnus-sum) (run-hooks 'gnus-sum-load-hook) diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el deleted file mode 100644 index cd8a753607a..00000000000 --- a/lisp/gnus/gnus-sync.el +++ /dev/null @@ -1,917 +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)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-alist-p (list) - "Non-null if and only if LIST is an alist." - (while (consp list) - (setq list (if (consp (car list)) - (cdr list) - 'not-alist))) - (null list)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-plist-p (list) - "Non-null if and only if LIST is a plist." - (while (consp list) - (setq list (if (and (keywordp (car list)) - (consp (cdr list))) - (cddr list) - 'not-plist))) - (null list)) - -; (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 24ae4cfae48..809caee64a0 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -44,9 +44,6 @@ :type 'hook :group 'gnus-topic) -(when (featurep 'xemacs) - (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)) - (defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" "Format of topic lines. It works along the same lines as a normal formatting string, @@ -66,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) @@ -575,7 +572,6 @@ articles in the topic and its subtopics." (not (zerop unread)) ;Non-empty tick ;Ticked articles (/= point-max (point-max)))) ;Inactive groups - (gnus-extent-start-open (point)) (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) @@ -644,7 +640,7 @@ articles in the topic and its subtopics." (beginning-of-line) ;; Insert the text. (if shownp - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec)) @@ -1065,7 +1061,7 @@ articles in the topic and its subtopics." [(meta tab)] gnus-topic-unindent "\C-i" gnus-topic-indent "\M-\C-i" gnus-topic-unindent - gnus-mouse-2 gnus-mouse-pick-topic) + [mouse-2] gnus-mouse-pick-topic) ;; Define a new submap. (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) @@ -1153,7 +1149,6 @@ articles in the topic and its subtopics." 'gnus-group-sort-topic) (setq gnus-group-change-level-function 'gnus-topic-change-level) (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (gnus-make-local-hook 'gnus-check-bogus-groups-hook) (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist nil 'local) (setq gnus-topology-checked-p nil) @@ -1167,7 +1162,7 @@ articles in the topic and its subtopics." (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when (gmm-called-interactively-p 'any) + (when (called-interactively-p 'any) (gnus-group-list-groups)))) (defun gnus-topic-select-group (&optional all) @@ -1294,7 +1289,7 @@ If COPYP, copy the groups instead." (list current-prefix-arg (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t nil 'gnus-topic-history))) - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) @@ -1319,7 +1314,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) (mapc @@ -1615,8 +1610,8 @@ If performed on a topic, edit the topic parameters instead." (let ((topic (gnus-group-topic-name))) (gnus-edit-form (gnus-topic-parameters topic) - (gnus-format-message "Editing the topic parameters for `%s'." - (or group topic)) + (format-message "Editing the topic parameters for `%s'." + (or group topic)) `(lambda (form) (gnus-topic-set-parameters ,topic form))))))) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index b3afcd7f440..ad27e8996fb 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -44,9 +44,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (require 'gnus-util) (require 'gnus) @@ -111,7 +108,6 @@ ;; Set up the menu. (when (gnus-visual-p 'undo-menu 'menu) (gnus-undo-make-menu-bar)) - (gnus-make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'gnus-undo-boundary nil t))) ;;; Interface functions. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 31645fcd315..7eb44629076 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -44,24 +44,18 @@ :type `(radio (function-item :doc "Use Emacs standard `completing-read' function." gnus-emacs-completing-read) - ;; iswitchb.el is very old and ido.el is unavailable - ;; in XEmacs, so we exclude those function items. - ,@(unless (featurep 'xemacs) - '((function-item - :doc "Use `ido-completing-read' function." - gnus-ido-completing-read) - (function-item - :doc "Use iswitchb based completing-read function." - gnus-iswitchb-completing-read))))) + (function-item + :doc "Use `ido-completing-read' function." + gnus-ido-completing-read) + (function-item + :doc "Use iswitchb based completing-read function." + gnus-iswitchb-completing-read))) (defcustom gnus-completion-styles - (if (and (boundp 'completion-styles-alist) - (boundp 'completion-styles)) - (append (when (and (assq 'substring completion-styles-alist) - (not (memq 'substring completion-styles))) - (list 'substring)) - completion-styles) - nil) + (append (when (and (assq 'substring completion-styles-alist) + (not (memq 'substring completion-styles))) + (list 'substring)) + completion-styles) "Value of `completion-styles' to use when completing." :version "24.1" :group 'gnus-meta @@ -81,23 +75,14 @@ (autoload 'nnheader-replace-chars-in-string "nnheader") (autoload 'mail-header-remove-comments "mail-parse") -(eval-and-compile - (cond - ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5, - ;; SXEmacs 22.1.4) over `replace-in-string'. The latter leads to inf-loops - ;; on empty matches: - ;; (replace-in-string "foo" "/*$" "/") - ;; (replace-in-string "xe" "\\(x\\)?" "") - ((fboundp 'replace-regexp-in-string) - (defun gnus-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. +(defun gnus-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. If LITERAL is non-nil, insert NEWTEXT literally. Return a new string containing the replacements. This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))) - ((fboundp 'replace-in-string) - (defalias 'gnus-replace-in-string 'replace-in-string)))) + (declare (obsolete replace-regexp-in-string "26.1")) + (replace-regexp-in-string regexp newtext string nil literal)) (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." @@ -141,14 +126,6 @@ This is a compatibility function for different Emacsen." (funcall (if (stringp buffer) 'get-buffer 'buffer-name) buffer)))) -;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and -;; XEmacs. In Emacs we don't need to call `make-local-hook' first. -;; It's harmless, though, so the main purpose of this alias is to shut -;; up the byte compiler. -(defalias 'gnus-make-local-hook (if (featurep 'xemacs) - 'make-local-hook - 'ignore)) - (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." (if (equal (car list) elt) @@ -311,13 +288,6 @@ Symbols are also allowed; their print names are used instead." (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) -;; Every version of Emacs Gnus supports has built-in float-time. -;; The featurep test silences an irritating compiler warning. -(defalias 'gnus-float-time - (if (or (featurep 'emacs) - (fboundp 'float-time)) - 'float-time 'time-to-seconds)) - ;;; Keymap macros. (defmacro gnus-local-set-keys (&rest plist) @@ -326,13 +296,6 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - ;; Convert the key [?\S-\ ] to [(shift space)] for XEmacs. - (when (featurep 'xemacs) - (let ((bindings plist)) - (while bindings - (when (equal (car bindings) [?\S-\ ]) - (setcar bindings [(shift space)])) - (setq bindings (cddr bindings))))) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) @@ -434,7 +397,7 @@ Cache the result as a text property stored in DATE." (defun gnus-mode-string-quote (string) "Quote all \"%\"'s in STRING." - (gnus-replace-in-string string "%" "%%")) + (replace-regexp-in-string "%" "%%" string)) ;; Make a hash table (default and minimum size is 256). ;; Optional argument HASHSIZE specifies the table size. @@ -454,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 @@ -465,10 +428,10 @@ jabbering all the time." (defcustom gnus-add-timestamp-to-message nil "Non-nil means add timestamps to messages that Gnus issues. -If it is `log', add timestamps to only the messages that go into the -\"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer). -If it is neither nil nor `log', add timestamps not only to log messages -but also to the ones displayed in the echo area." +If it is `log', add timestamps to only the messages that go into +the \"*Messages*\" buffer. If it is neither nil nor `log', add +timestamps not only to log messages but also to the ones +displayed in the echo area." :version "23.1" ;; No Gnus :group 'gnus-various :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" @@ -481,56 +444,37 @@ but also to the ones displayed in the echo area." (eval-when-compile (defmacro gnus-message-with-timestamp-1 (format-string args) (let ((timestamp '(format-time-string "%Y%m%dT%H%M%S.%3N> " time))) - (if (featurep 'xemacs) - `(let (str time) - (if (or (and (null ,format-string) (null ,args)) - (progn - (setq str (apply 'format ,format-string ,args)) - (zerop (length str)))) - (prog1 - (and ,format-string str) - (clear-message nil)) - (cond ((eq gnus-add-timestamp-to-message 'log) - (setq time (current-time)) - (display-message 'no-log str) - (log-message 'message (concat ,timestamp str))) - (gnus-add-timestamp-to-message - (setq time (current-time)) - (display-message 'message (concat ,timestamp str))) - (t - (display-message 'message str)))) - str) - `(let (str time) - (cond ((eq gnus-add-timestamp-to-message 'log) - (setq str (let (message-log-max) - (apply 'message ,format-string ,args))) - (when (and message-log-max - (> message-log-max 0) - (/= (length str) 0)) - (setq time (current-time)) - (with-current-buffer (if (fboundp 'messages-buffer) - (messages-buffer) - (get-buffer-create "*Messages*")) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert ,timestamp str "\n") - (forward-line (- message-log-max)) - (delete-region (point-min) (point))) - (goto-char (point-max)))) - str) - (gnus-add-timestamp-to-message - (if (or (and (null ,format-string) (null ,args)) - (progn - (setq str (apply 'format ,format-string ,args)) - (zerop (length str)))) - (prog1 - (and ,format-string str) - (message nil)) - (setq time (current-time)) - (message "%s" (concat ,timestamp str)) - str)) - (t - (apply 'message ,format-string ,args)))))))) + `(let (str time) + (cond ((eq gnus-add-timestamp-to-message 'log) + (setq str (let (message-log-max) + (apply 'message ,format-string ,args))) + (when (and message-log-max + (> message-log-max 0) + (/= (length str) 0)) + (setq time (current-time)) + (with-current-buffer (if (fboundp 'messages-buffer) + (messages-buffer) + (get-buffer-create "*Messages*")) + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert ,timestamp str "\n") + (forward-line (- message-log-max)) + (delete-region (point-min) (point))) + (goto-char (point-max)))) + str) + (gnus-add-timestamp-to-message + (if (or (and (null ,format-string) (null ,args)) + (progn + (setq str (apply 'format ,format-string ,args)) + (zerop (length str)))) + (prog1 + (and ,format-string str) + (message nil)) + (setq time (current-time)) + (message "%s" (concat ,timestamp str)) + str)) + (t + (apply 'message ,format-string ,args))))))) (defvar gnus-action-message-log nil) @@ -646,7 +590,6 @@ If N, return the Nth ancestor instead." (defun gnus-read-event-char (&optional prompt) "Get the next event." (let ((event (read-event prompt))) - ;; should be gnus-characterp, but this can't be called in XEmacs anyway (cons (and (numberp event) event) event))) (defun gnus-copy-file (file &optional to) @@ -839,9 +782,6 @@ If there's no subdirectory, delete DIRECTORY as well." (setq string (replace-match "" t t string))) string) -(declare-function gnus-put-text-property "gnus" - (start end property value &optional object)) - (defsubst gnus-put-text-property-excluding-newlines (beg end prop val) "The same as `put-text-property', but don't put this prop on any newlines in the region." (save-match-data @@ -849,9 +789,9 @@ If there's no subdirectory, delete DIRECTORY as well." (save-restriction (goto-char beg) (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) - (gnus-put-text-property beg (match-beginning 0) prop val) + (put-text-property beg (match-beginning 0) prop val) (setq beg (point))) - (gnus-put-text-property beg (point) prop val))))) + (put-text-property beg (point) prop val))))) (defsubst gnus-put-overlay-excluding-newlines (beg end prop val) "The same as `put-text-property', but don't put this prop on any newlines in the region." @@ -875,7 +815,7 @@ Otherwise, do nothing." (when (eq prop 'face) (setcar (cdr (get-text-property beg 'face)) (or val 'default))) (inline - (gnus-put-text-property beg stop prop val))) + (put-text-property beg stop prop val))) (setq beg stop)))) (defun gnus-get-text-property-excluding-characters-with-faces (pos prop) @@ -890,39 +830,12 @@ Otherwise, return the value." (defmacro gnus-faces-at (position) "Return a list of faces at POSITION." - (if (featurep 'xemacs) - `(let ((pos ,position)) - (mapcar-extents 'extent-face - nil (current-buffer) pos pos nil 'face)) - `(let ((pos ,position)) - (delq nil (cons (get-text-property pos 'face) - (mapcar - (lambda (overlay) - (overlay-get overlay 'face)) - (overlays-at pos))))))) - -(if (fboundp 'invisible-p) - (defalias 'gnus-invisible-p 'invisible-p) - ;; for Emacs < 22.2, and XEmacs. - (defun gnus-invisible-p (pos) - "Return non-nil if the character after POS is currently invisible." - (let ((prop (get-char-property pos 'invisible))) - (if (eq buffer-invisibility-spec t) - prop - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec)))))) - -;; Note: the optional 2nd argument has a different meaning between -;; Emacs and XEmacs. -;; (next-char-property-change POSITION &optional LIMIT) -;; (next-extent-change POS &optional OBJECT) -(defalias 'gnus-next-char-property-change - (if (fboundp 'next-extent-change) - 'next-extent-change 'next-char-property-change)) - -(defalias 'gnus-previous-char-property-change - (if (fboundp 'previous-extent-change) - 'previous-extent-change 'previous-char-property-change)) + `(let ((pos ,position)) + (delq nil (cons (get-text-property pos 'face) + (mapcar + (lambda (overlay) + (overlay-get overlay 'face)) + (overlays-at pos)))))) ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;; The primary idea here is to try to protect internal data structures @@ -1001,16 +914,8 @@ with potentially long computations." ;;; Functions for saving to babyl/mail files. -(eval-when-compile - (if (featurep 'xemacs) - ;; Don't load tm and apel XEmacs packages that provide some - ;; Emacs emulating functions and variables. - (let ((features features)) - (provide 'tm-view) - (unless (fboundp 'set-alist) (defalias 'set-alist 'ignore)) - (require 'rmail)) ;; It requires tm-view that loads apel. - (require 'rmail)) - (autoload 'rmail-update-summary "rmailsum")) +(require 'rmail) +(autoload 'rmail-update-summary "rmailsum") (defvar mm-text-coding-system) @@ -1207,11 +1112,8 @@ ARG is passed to the first function." (apply 'run-hook-with-args hook args))) (defun gnus-run-mode-hooks (&rest funcs) - "Run `run-mode-hooks' if it is available, otherwise `run-hooks'. -This function saves the current buffer." - (if (fboundp 'run-mode-hooks) - (save-current-buffer (apply 'run-mode-hooks funcs)) - (save-current-buffer (apply 'run-hooks funcs)))) + "Run `run-mode-hooks', saving the current buffer." + (save-current-buffer (apply 'run-mode-hooks funcs))) ;;; Various @@ -1259,16 +1161,6 @@ If HASH-TABLE-P is non-nil, regards SEQUENCE as a hash table." (setq sequence (cdr sequence)))) (nreverse out))) -(if (fboundp 'assq-delete-all) - (defalias 'gnus-delete-alist 'assq-delete-all) - (defun gnus-delete-alist (key alist) - "Delete from ALIST all elements whose car is KEY. -Return the modified alist." - (let (entry) - (while (setq entry (assq key alist)) - (setq alist (delq entry alist))) - alist))) - (defun gnus-grep-in-list (word list) "Find if a WORD matches any regular expression in the given LIST." (when (and word list) @@ -1370,43 +1262,17 @@ Return the modified alist." (put 'gnus-with-output-to-file 'lisp-indent-function 1) (put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) -(if (fboundp 'union) - (defalias 'gnus-union 'union) - (defun gnus-union (l1 l2 &rest keys) - "Set union of lists L1 and L2. -If KEYS contains the `:test' and `equal' pair, use `equal' to compare -items in lists, otherwise use `eq'." - (cond ((null l1) l2) - ((null l2) l1) - ((equal l1 l2) l1) - (t - (or (>= (length l1) (length l2)) - (setq l1 (prog1 l2 (setq l2 l1)))) - (if (eq 'equal (plist-get keys :test)) - (while l2 - (or (member (car l2) l1) - (push (car l2) l1)) - (pop l2)) - (while l2 - (or (memq (car l2) l1) - (push (car l2) l1)) - (pop l2))) - l1)))) - -(declare-function gnus-add-text-properties "gnus" - (start end properties &optional object)) - (defun gnus-add-text-properties-when (property value start end properties &optional object) - "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." + "Like `add-text-properties', only applied on where PROPERTY is VALUE." (let (point) (while (and start (< start end) ;; XEmacs will loop for every when start=end. (setq point (text-property-not-all start end property value))) - (gnus-add-text-properties start point properties object) + (add-text-properties start point properties object) (setq start (text-property-any point end property value))) (if start - (gnus-add-text-properties start end properties object)))) + (add-text-properties start end properties object)))) (defun gnus-remove-text-properties-when (property value start end properties &optional object) @@ -1449,10 +1315,6 @@ is run." "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." (if gnus-use-byte-compile (progn - (condition-case nil - ;; Work around a bug in XEmacs 21.4 - (require 'byte-optimize) - (error)) (require 'bytecomp) (defalias 'gnus-byte-compile (lambda (form) @@ -1555,16 +1417,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', initial-input history def) "Call standard `completing-read-function'." (let ((completion-styles gnus-completion-styles)) - (completing-read prompt - (if (featurep 'xemacs) - ;; Old XEmacs (at least 21.4) expect an alist, - ;; in which the car of each element is a string, - ;; for collection. - (mapcar - (lambda (elem) - (list (format "%s" (or (car-safe elem) elem)))) - collection) - collection) + (completing-read prompt collection nil require-match initial-input history def))) (autoload 'ido-completing-read "ido") @@ -1605,11 +1458,6 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (or iswitchb-mode (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) -(defun gnus-graphic-display-p () - (if (featurep 'xemacs) - (device-on-window-system-p) - (display-graphic-p))) - (put 'gnus-parse-without-error 'lisp-indent-function 0) (put 'gnus-parse-without-error 'edebug-form-spec '(body)) @@ -1655,7 +1503,7 @@ CHOICE is a list of the choice char and help message at IDX." (setq tchar nil) (setq buf (get-buffer-create "*Gnus Help*")) (pop-to-buffer buf) - (fundamental-mode) ; for Emacs 20.4+ + (fundamental-mode) (buffer-disable-undo) (erase-buffer) (insert prompt ":\n\n") @@ -1690,31 +1538,18 @@ CHOICE is a list of the choice char and help message at IDX." (kill-buffer buf)) tchar)) -(if (featurep 'emacs) - (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) - (if (fboundp 'select-frame-set-input-focus) - (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) - ;; XEmacs 21.4, SXEmacs - (defun gnus-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (raise-frame frame) - (select-frame frame) - (focus-frame frame)))) - (defun gnus-frame-or-window-display-name (object) "Given a frame or window, return the associated display name. Return nil otherwise." - (if (featurep 'xemacs) - (device-connection (dfw-device object)) - (if (or (framep object) - (and (windowp object) - (setq object (window-frame object)))) - (let ((display (frame-parameter object 'display))) - (if (and (stringp display) - ;; Exclude invalid display names. - (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" - display)) - display))))) + (if (or (framep object) + (and (windowp object) + (setq object (window-frame object)))) + (let ((display (frame-parameter object 'display))) + (if (and (stringp display) + ;; Exclude invalid display names. + (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" + display)) + display)))) (defvar tool-bar-mode) @@ -1723,9 +1558,7 @@ Return nil otherwise." (when (and (boundp 'tool-bar-mode) tool-bar-mode) (let* ((args nil) - (func (cond ((featurep 'xemacs) - 'ignore) - ((fboundp 'tool-bar-update) + (func (cond ((fboundp 'tool-bar-update) 'tool-bar-update) ((fboundp 'force-window-update) 'force-window-update) @@ -1766,29 +1599,10 @@ 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))) -(if (fboundp 'merge) - (defalias 'gnus-merge 'merge) - ;; Adapted from cl-seq.el - (defun gnus-merge (type list1 list2 pred) - "Destructively merge lists LIST1 and LIST2 to produce a new list. -Argument TYPE is for compatibility and ignored. -Ordering of the elements is preserved according to PRED, a `less-than' -predicate on the elements." - (let ((res nil)) - (while (and list1 list2) - (if (funcall pred (car list2) (car list1)) - (push (pop list2) res) - (push (pop list1) res))) - (nconc (nreverse res) list1 list2)))) - -(defvar xemacs-codename) -(defvar sxemacs-codename) -(defvar emacs-program-version) - (defun gnus-emacs-version () "Stringified Emacs version." (let* ((lst (if (listp gnus-user-agent) @@ -1799,37 +1613,15 @@ predicate on the elements." ((memq 'type lst) (symbol-name system-type)) (t nil))) - codename emacsname) - (cond ((featurep 'sxemacs) - (setq emacsname "SXEmacs" - codename sxemacs-codename)) - ((featurep 'xemacs) - (setq emacsname "XEmacs" - codename xemacs-codename)) - (t - (setq emacsname "Emacs"))) + codename) (cond ((not (memq 'emacs lst)) nil) ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) - ;; Emacs: (concat "Emacs/" (match-string 1 emacs-version) (if system-v (concat " (" system-v ")") ""))) - ((or (featurep 'sxemacs) (featurep 'xemacs)) - ;; XEmacs or SXEmacs: - (concat emacsname "/" emacs-program-version - (let (plst) - (when (memq 'codename lst) - (push codename plst)) - (when system-v - (push system-v plst)) - (unless (featurep 'mule) - (push "no MULE" plst)) - (when (> (length plst) 0) - (concat - " (" (mapconcat 'identity (reverse plst) ", ") ")"))))) (t emacs-version)))) (defun gnus-rename-file (old-path new-path &optional trim) @@ -1858,36 +1650,6 @@ empty directories from OLD-PATH." (ignore-errors (set-file-modes filename mode))) -(if (fboundp 'set-process-query-on-exit-flag) - (defalias 'gnus-set-process-query-on-exit-flag - 'set-process-query-on-exit-flag) - (defalias 'gnus-set-process-query-on-exit-flag - 'process-kill-without-query)) - -(defalias 'gnus-read-shell-command - (if (fboundp 'read-shell-command) 'read-shell-command 'read-string)) - -(defmacro gnus-put-display-table (range value display-table) - "Set the value for char RANGE to VALUE in DISPLAY-TABLE. " - (if (featurep 'xemacs) - (progn - `(if (fboundp 'put-display-table) - (put-display-table ,range ,value ,display-table) - (if (sequencep ,display-table) - (aset ,display-table ,range ,value) - (put-char-table ,range ,value ,display-table)))) - `(aset ,display-table ,range ,value))) - -(defmacro gnus-get-display-table (character display-table) - "Find value for CHARACTER in DISPLAY-TABLE. " - (if (featurep 'xemacs) - `(if (fboundp 'get-display-table) - (get-display-table ,character ,display-table) - (if (sequencep ,display-table) - (aref ,display-table ,character) - (get-char-table ,character ,display-table))) - `(aref ,display-table ,character))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun gnus-rescale-image (image size) @@ -1910,12 +1672,11 @@ Sizes are in pixels." image))) image))) -(eval-when-compile (require 'gmm-utils)) (defun gnus-recursive-directory-files (dir) "Return all regular files below DIR. The first found will be returned if a file has hard or symbolic links." (let (files attr attrs) - (gmm-labels + (cl-labels ((fn (directory) (dolist (file (directory-files directory t)) (setq attr (file-attributes (file-truename file))) @@ -1939,63 +1700,6 @@ The first found will be returned if a file has hard or symbolic links." (memq elem list)))) found)) -(eval-and-compile - (cond - ((fboundp 'match-substitute-replacement) - (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement)) - (t - (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp) - "Return REPLACEMENT as it will be inserted by `replace-match'. -In other words, all back-references in the form `\\&' and `\\N' -are substituted with actual strings matched by the last search. -Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same -meaning as for `replace-match'. - -This is the definition of match-substitute-replacement in subr.el from GNU Emacs." - (let ((match (match-string 0 string))) - (save-match-data - (set-match-data (mapcar (lambda (x) - (if (numberp x) - (- x (match-beginning 0)) - x)) - (match-data t))) - (replace-match replacement fixedcase literal match subexp))))))) - -(if (fboundp 'string-match-p) - (defalias 'gnus-string-match-p 'string-match-p) - (defsubst gnus-string-match-p (regexp string &optional start) - "\ -Same as `string-match' except this function does not change the match data." - (save-match-data - (string-match regexp string start)))) - -(if (fboundp 'string-prefix-p) - (defalias 'gnus-string-prefix-p 'string-prefix-p) - (defun gnus-string-prefix-p (str1 str2 &optional ignore-case) - "Return non-nil if STR1 is a prefix of STR2. -If IGNORE-CASE is non-nil, the comparison is done without paying attention -to case differences." - (and (<= (length str1) (length str2)) - (let ((prefix (substring str2 0 (length str1)))) - (if ignore-case - (string-equal (downcase str1) (downcase prefix)) - (string-equal str1 prefix)))))) - -(defalias 'gnus-format-message - (if (fboundp 'format-message) 'format-message - ;; for Emacs < 25, and XEmacs, don't worry about quote translation. - 'format)) - -;; Simple check: can be a macro but this way, although slow, it's really clear. -;; We don't use `bound-and-true-p' because it's not in XEmacs. -(defun gnus-bound-and-true-p (sym) - (and (boundp sym) (symbol-value sym))) - -(if (fboundp 'timer--function) - (defalias 'gnus-timer--function 'timer--function) - (defun gnus-timer--function (timer) - (elt timer 5))) - (defun gnus-test-list (list predicate) "To each element of LIST apply PREDICATE. Return nil if LIST is no list or is empty or some test returns nil; @@ -2021,6 +1725,59 @@ lists of strings." (gnus-setdiff (cdr list1) list2) (cons (car list1) (gnus-setdiff (cdr list1) list2))))) +;;; Image functions. + +(defun gnus-image-type-available-p (type) + (and (display-images-p) + (image-type-available-p type))) + +(defun gnus-create-image (file &optional type data-p &rest props) + (let ((face (plist-get props :face))) + (when face + (setq props (plist-put props :foreground (face-foreground face))) + (setq props (plist-put props :background (face-background face)))) + (ignore-errors + (apply 'create-image file type data-p props)))) + +(defun gnus-put-image (glyph &optional string category) + (let ((point (point))) + (insert-image glyph (or string " ")) + (put-text-property point (point) 'gnus-image-category category) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t)) + glyph)) + +(defun gnus-remove-image (image &optional category) + "Remove the image matching IMAGE and CATEGORY found first." + (let ((start (point-min)) + val end) + (while (and (not end) + (or (setq val (get-text-property start 'display)) + (and (setq start + (next-single-property-change start 'display)) + (setq val (get-text-property start 'display))))) + (setq end (or (next-single-property-change start 'display) + (point-max))) + (if (and (equal val image) + (equal (get-text-property start 'gnus-image-category) + category)) + (progn + (put-text-property start end 'display nil) + (when (get-text-property start 'gnus-image-text-deletable) + (delete-region start end))) + (unless (= end (point-max)) + (setq start end + end nil)))))) + +(defun gnus-kill-all-overlays () + "Delete all overlays in the current buffer." + (let* ((overlayss (overlay-lists)) + (buffer-read-only nil) + (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) + (while overlays + (delete-overlay (pop overlays))))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 416567ed285..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 @@ -217,23 +217,20 @@ Note that this variable can be used in conjunction with the ;; Various variables users may set -(defcustom gnus-uu-tmp-dir - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "*Variable saying where gnus-uu is to do its work. +(defcustom gnus-uu-tmp-dir temporary-file-directory + "Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract :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) @@ -248,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." @@ -268,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, @@ -298,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 @@ -408,7 +405,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir)))) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) + (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-yenc (n dir) @@ -474,7 +471,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir gnus-uu-default-dir))) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) + (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) @@ -486,7 +483,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive "P") (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) - (file (mm-make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) + (file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) (message-forward-as-mime message-forward-as-mime) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) @@ -876,10 +873,7 @@ When called interactively, prompt for REGEXP." (with-current-buffer buffer (save-restriction (let ((inhibit-read-only t)) - (set-text-properties (point-min) (point-max) nil) - ;; These two are necessary for XEmacs 19.12 fascism. - (put-text-property (point-min) (point-max) 'invisible nil) - (put-text-property (point-min) (point-max) 'intangible nil)) + (set-text-properties (point-min) (point-max) nil)) (when (and message-forward-as-mime message-forward-show-mml gnus-uu-digest-buffer) @@ -1787,7 +1781,7 @@ Gnus might fail to display all of it.") gnus-uu-tmp-dir))) (setq gnus-uu-work-dir - (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) + (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) (gnus-set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index b1498fd7852..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) @@ -273,9 +273,7 @@ See the Gnus manual for an explanation of the syntax used.") (cond ((eq buf (window-buffer (selected-window))) (set-buffer buf)) - ((eq t (window-dedicated-p - ;; XEmacs version of `window-dedicated-p' requires it. - (selected-window))) + ((eq t (window-dedicated-p)) ;; If the window is hard-dedicated, we have a problem because ;; we just can't do what we're asked. But signaling an error, ;; like `switch-to-buffer' would do, is not an option because @@ -417,19 +415,15 @@ See the Gnus manual for an explanation of the syntax used.") (gnus-delete-windows-in-gnusey-frames)) ;; Just remove some windows. (gnus-remove-some-windows) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer)) (select-frame frame))) (let (gnus-window-frame-focus) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer)) + (set-buffer nntp-server-buffer) (gnus-configure-frame split) (run-hooks 'gnus-configure-windows-hook) (when gnus-window-frame-focus - (gnus-select-frame-set-input-focus + (select-frame-set-input-focus (window-frame gnus-window-frame-focus))))))))) (defun gnus-delete-windows-in-gnusey-frames () @@ -510,27 +504,15 @@ should have point." lowest-buf buf)))) (when lowest-buf (pop-to-buffer lowest-buf) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer)) (mapcar (lambda (b) (delete-windows-on b t)) (delq lowest-buf bufs))))) -(eval-and-compile - (cond - ((fboundp 'frames-on-display-list) - (defalias 'gnus-frames-on-display-list 'frames-on-display-list)) - ((and (featurep 'xemacs) (fboundp 'frame-device)) - (defun gnus-frames-on-display-list () - (apply 'filtered-frame-list 'identity (list (frame-device nil))))) - (t - (defalias 'gnus-frames-on-display-list 'frame-list)))) - (defun gnus-get-buffer-window (buffer &optional frame) (cond ((and (null gnus-use-frames-on-any-display) (memq frame '(t 0 visible))) (car - (let ((frames (gnus-frames-on-display-list))) + (let ((frames (frames-on-display-list))) (gnus-remove-if (lambda (win) (not (memq (window-frame win) frames))) (get-buffer-window-list buffer nil frame))))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 5d2ce7ee19f..943ba0889b6 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -27,7 +27,7 @@ ;;; Code: -(eval '(run-hooks 'gnus-load-hook)) +(run-hooks 'gnus-load-hook) (eval-when-compile (require 'cl)) (require 'wid-edit) @@ -303,15 +303,9 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(unless (featurep 'gnus-xmas) - (defalias 'gnus-extent-detached-p 'ignore) - (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) - (defalias 'gnus-character-to-event 'identity) - (defalias 'gnus-assq-delete-all 'assq-delete-all) - (defalias 'gnus-add-text-properties 'add-text-properties) - (defalias 'gnus-put-text-property 'put-text-property) - (defvar gnus-mode-line-image-cache t) +(defvar gnus-mode-line-image-cache t) + +(eval-and-compile (if (fboundp 'find-image) (defun gnus-mode-line-buffer-identification (line) (let ((str (car-safe line)) @@ -336,12 +330,7 @@ be set in `.emacs' instead." str) (list str)) line))) - (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-deactivate-mark 'deactivate-mark) - (defalias 'gnus-window-edges 'window-edges) - (defalias 'gnus-key-press-event-p 'numberp) - ;;(defalias 'gnus-decode-rfc1522 'ignore) - ) + (defalias 'gnus-mode-line-buffer-identification 'identity))) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. @@ -914,14 +903,20 @@ be set in `.emacs' instead." (defun gnus-add-buffer () "Add the current buffer to the list of Gnus buffers." + (gnus-prune-buffers) (push (current-buffer) gnus-buffers)) (defmacro gnus-kill-buffer (buffer) "Kill BUFFER and remove from the list of Gnus buffers." `(let ((buf ,buffer)) (when (gnus-buffer-exists-p buf) - (setq gnus-buffers (delete (get-buffer buf) gnus-buffers)) - (kill-buffer buf)))) + (kill-buffer buf) + (gnus-prune-buffers)))) + +(defun gnus-prune-buffers () + (dolist (buf gnus-buffers) + (unless (buffer-live-p buf) + (setq gnus-buffers (delete buf gnus-buffers))))) (defun gnus-buffers () "Return a list of live Gnus buffers." @@ -1002,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) @@ -1245,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 @@ -1255,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)) @@ -1326,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'." @@ -1352,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 @@ -1438,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." @@ -1449,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. @@ -1489,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." @@ -1515,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." @@ -1526,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." @@ -1542,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 @@ -1586,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 @@ -1622,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 @@ -1681,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" @@ -1698,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 "\ @@ -1725,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 "\ @@ -1744,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 "\ @@ -1763,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 @@ -1782,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 @@ -1851,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) @@ -1875,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 @@ -1888,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 @@ -1918,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 @@ -2075,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." @@ -2134,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 @@ -2180,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." @@ -2232,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 @@ -2269,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 @@ -2314,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 @@ -2333,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." @@ -2341,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) @@ -2389,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. @@ -2442,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) @@ -2503,16 +2498,11 @@ Disabling the agent may result in noticeable loss of performance." (function-item gnus-slave-no-server))) (defcustom gnus-other-frame-parameters nil - "Frame parameters used by `gnus-other-frame' to create a Gnus frame. -This should be an alist for Emacs, or a plist for XEmacs." + "Frame parameters used by `gnus-other-frame' to create a Gnus frame." :group 'gnus-start - :type (if (featurep 'xemacs) - '(repeat (list :inline t :format "%v" - (symbol :tag "Property") - (sexp :tag "Value"))) - '(repeat (cons :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value"))))) + :type '(repeat (cons :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value")))) (defcustom gnus-user-agent '(emacs gnus type) "Which information should be exposed in the User-Agent header. @@ -2606,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) @@ -2940,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. @@ -3026,7 +3016,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) - (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 + (let ((keys `([delete] "\177" "\M-u"))) ;[mouse-2] (while keys (define-key keymap (pop keys) 'undefined)))) @@ -3155,10 +3145,6 @@ Return nil if not defined." (setcar (nthcdr 2 (gnus-gethash group gnus-newsrc-hashtb)) info)) -;;; Load the compatibility functions. - -(require 'gnus-ems) - ;;; ;;; Shutdown @@ -3243,8 +3229,7 @@ If ARG, insert string at point." 4.99 (+ 5 (* 0.02 (abs - (- (mm-char-int (aref (downcase alpha) 0)) - (mm-char-int ?t)))) + (- (aref (downcase alpha) 0) ?t))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) @@ -3448,7 +3433,7 @@ that that variable is buffer-local to the summary buffers." (defun gnus-simplify-mode-line () "Make mode lines a bit simpler." - (setq mode-line-modified (cdr gnus-mode-line-modified)) + (setq mode-line-modified "--") (when (listp mode-line-format) (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) @@ -4386,12 +4371,12 @@ current display is used." (with-current-buffer (window-buffer window) (string-match "\\`gnus-" (symbol-name major-mode)))) - (gnus-select-frame-set-input-focus + (select-frame-set-input-focus (setq gnus-other-frame-object (window-frame window))) (select-window window) (throw 'found t))) 'ignore t))) - (gnus-select-frame-set-input-focus + (select-frame-set-input-focus (setq gnus-other-frame-object (if display (make-frame-on-display display gnus-other-frame-parameters) @@ -4435,10 +4420,6 @@ prompt the user for the name of an NNTP server to use." (require 'debbugs-gnu) (debbugs-gnu nil "gnus")) -;; Allow redefinition of Gnus functions. - -(gnus-ems-redefine) - (provide 'gnus) ;;; gnus.el ends here diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index 7293e334335..a8c61faecc0 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -148,17 +148,17 @@ converted to the compressed format." (gnus-pp gnus-agent-expire-days) (insert - (gnus-format-message + (format-message "\nIn order to use version `%s' of gnus, you will need to set\n" converting-to)) (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") (insert "expiration days to individual groups, you must instead set the\n") - (insert (gnus-format-message + (insert (format-message "`agent-days-until-old' group and/or topic parameter.\n")) (insert "\n") (insert "If you would like, gnus can iterate over every group comparing its name to the\n") (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") - (insert (gnus-format-message + (insert (format-message "gnus finds a match, it will update that group's `agent-days-until-old' group\n")) (insert "parameter to the value associated with the regular expression.\n") (insert "\n") diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index f4a9e191010..8b7c8e08475 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -66,7 +66,7 @@ See Info node `(gnus)Mail Source Specifiers'." (repeat :tag "List" (choice :format "%[Value Menu%] %v" :value (file) - (cons :tag "Group parameter `mail-source'" + (list :tag "Group parameter `mail-source'" (const :format "" group)) (cons :tag "Spool file" (const :format "" file) @@ -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) @@ -603,8 +603,8 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." currday (+ currday (* low2days (nth 1 (current-time))))) (while files (let* ((ffile (car files)) - (bfile (gnus-replace-in-string - ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) + (bfile (replace-regexp-in-string "\\`.*/\\([^/]+\\)\\'" "\\1" + ffile)) (filetime (nth 5 (file-attributes ffile))) (fileday (* (car filetime) high2days)) (fileday (+ fileday (* low2days (nth 1 filetime))))) @@ -612,7 +612,7 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." (when (and (> (- currday fileday) diff) (if confirm (y-or-n-p - (gnus-format-message "\ + (format-message "\ Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile)) (gnus-message 8 "\ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) @@ -629,8 +629,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) 0) (funcall callback mail-source-crash-box info))) -(autoload 'gnus-float-time "gnus-util") - (defvar mail-source-incoming-last-checked-time nil) (defun mail-source-delete-crash-box () @@ -639,7 +637,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming - (mm-make-temp-file + (make-temp-file (expand-file-name mail-source-incoming-file-prefix mail-source-directory)))) @@ -651,7 +649,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Don't check for old incoming files more than once per day to ;; save a lot of file accesses. (when (or (null mail-source-incoming-last-checked-time) - (> (gnus-float-time + (> (float-time (time-since mail-source-incoming-last-checked-time)) (* 24 60 60))) (setq mail-source-incoming-last-checked-time (current-time)) @@ -997,7 +995,6 @@ This only works when `display-time' is enabled." (if on (progn (require 'time) - ;; display-time-mail-function is an Emacs feature. (setq display-time-mail-function #'mail-source-new-mail-p) ;; Set up the main timer. (setq mail-source-report-new-mail-timer diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index ed0422c1f4d..33c5339e54c 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. @@ -40,16 +40,18 @@ ;; This is apparently necessary even though things are autoloaded. ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better ;; require mailabbrev here. -(if (featurep 'xemacs) - (require 'mail-abbrevs) - (require 'mailabbrev)) +(require 'mailabbrev) (require 'mail-parse) (require 'mml) (require 'rfc822) (require 'format-spec) (require 'dired) +(require 'mm-util) +(require 'rfc2047) +(require 'puny) +(require 'subr-x) -(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ +(autoload 'mailclient-send-it "mailclient") (defvar gnus-message-group-art) (defvar gnus-list-identifiers) ; gnus-sum is required where necessary @@ -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 @@ -296,8 +298,8 @@ any confusion." regexp)) (defcustom message-subject-re-regexp - "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" - "*Regexp matching \"Re: \" in the subject line." + "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" + "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") @@ -1249,12 +1251,8 @@ called and its result is inserted." (if (and (boundp 'mail-archive-file-name) (stringp mail-archive-file-name)) (format "FCC: %s\n" mail-archive-file-name)) - ;; Use the value of `mail-default-headers' if available. - ;; Note: as for XEmacs 21.4 and 21.5, it is unavailable - ;; unless sendmail.el is loaded. - (if (boundp 'mail-default-headers) - mail-default-headers)) - "*A string of header lines to be inserted in outgoing mails." + mail-default-headers) + "A string of header lines to be inserted in outgoing mails." :version "23.2" :group 'message-headers :group 'message-mail @@ -1262,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") @@ -1284,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." @@ -1316,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." @@ -1340,26 +1338,29 @@ 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") :type '(choice directory (const :tag "Don't auto-save" nil))) -(defcustom message-default-charset - (and (not (mm-multibyte-p)) 'iso-8859-1) +(defcustom message-default-charset (and (not (mm-multibyte-p)) 'iso-8859-1) "Default charset used in non-MULE Emacsen. If nil, you might be asked to input the charset." :version "21.1" :group 'message :link '(custom-manual "(message)Various Message Variables") :type 'symbol) +(make-obsolete-variable + 'message-default-charset + "The default charset comes from the language environment" "26.1") -(defcustom message-dont-reply-to-names - (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names) - "*Addresses to prune when doing wide replies. -This can be a regexp or a list of regexps. Also, a value of nil means -exclude your own user name only." +(defcustom message-dont-reply-to-names mail-dont-reply-to-names + "Addresses to prune when doing wide replies. +This can be a regexp, a list of regexps or a predicate function. +Also, a value of nil means exclude your own user name only. + +If a function email is passed as the argument." :version "24.3" :group 'message :link '(custom-manual "(message)Wide Reply") @@ -1368,10 +1369,12 @@ exclude your own user name only." (repeat :tag "Regexp List" regexp))) (defsubst message-dont-reply-to-names () - (gmm-regexp-concat message-dont-reply-to-names)) + (if (functionp message-dont-reply-to-names) + 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 @@ -1381,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)) @@ -1630,11 +1637,6 @@ starting with `not' and followed by regexps." (0 'message-mml)))) "Additional expressions to highlight in Message mode.") - -;; XEmacs does it like this. For Emacs, we have to set the -;; `font-lock-defaults' buffer-local variable. -(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) - (defvar message-face-alist '((bold . message-bold-region) (underline . underline-region) @@ -1676,12 +1678,8 @@ news." (defvar message-send-coding-system 'binary "Coding system to encode outgoing mail.") -(defvar message-draft-coding-system - mm-auto-save-coding-system - "*Coding system to compose mail. -If you'd like to make it possible to share draft files between XEmacs -and Emacs, you may use `iso-2022-7bit' for this value at your own risk. -Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") +(defvar message-draft-coding-system mm-auto-save-coding-system + "Coding system to compose mail.") (defcustom message-send-mail-partially-limit nil "The limitation of messages sent as message/partial. @@ -1694,17 +1692,20 @@ should be sent in several parts. If it is nil, the size is unlimited." (integer 1000000))) (defcustom message-alternative-emails nil - "*Regexp 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. +If a function, an email string is passed as the argument. + This variable has precedence over posting styles and anything that runs off `message-setup-hook'." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "Always use primary" nil) - regexp)) + regexp + function)) (defcustom message-hierarchical-addresses nil "A list of hierarchical mail address definitions. @@ -1754,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) @@ -1787,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). @@ -1910,12 +1895,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-options nil "Some saved answers when sending message.") -;; FIXME: On XEmacs this causes problems since let-binding like: -;; (let ((message-options message-options)) ...) -;; as in `message-send' and `mml-preview' loses to buffer-local -;; variable initialization. -(unless (featurep 'xemacs) - (make-variable-buffer-local 'message-options)) +(make-variable-buffer-local 'message-options) (defvar message-send-mail-real-function nil "Internal send mail function.") @@ -1923,63 +1903,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'" "The regexp of bogus system names.") -(defcustom message-valid-fqdn-regexp - (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. - ;; valid TLDs: - "\\([a-z][a-z]\\|" ;; two letter country TDLs - "aero\\|arpa\\|asia\\|bitnet\\|biz\\|bofh\\|" - "cat\\|com\\|coop\\|edu\\|gov\\|" - "info\\|int\\|jobs\\|" - "mil\\|mobi\\|museum\\|name\\|net\\|" - "org\\|pro\\|tel\\|travel\\|uucp\\|" - ;; ICANN-era generic top-level domains - "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|" - "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|" - "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|" - "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|" - "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|" - "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|" - "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|" - "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|" - "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|" - "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|" - "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|" - "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|" - "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|" - "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|" - "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|" - "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|" - "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|" - "industries\\|info\\|ink\\|institute\\|insure\\|international\\|" - "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|" - "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|" - "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|" - "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|" - "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|" - "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|" - "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|" - "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|" - "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|" - "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|" - "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|" - "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|" - "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|" - "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|" - "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|" - "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|" - "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|" - "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|" - "zone\\)") - ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains - ;; http://en.wikipedia.org/wiki/GTLD - ;; `approved, but not yet in operation': .xxx - ;; "dead" nato bitnet uucp - "Regular expression that matches a valid FQDN." - ;; see also: gnus-button-valid-fqdn-regexp - :version "25.1" - :group 'message-headers - :type 'regexp) - (autoload 'gnus-alive-p "gnus-util") (autoload 'gnus-delay-article "gnus-delay") (autoload 'gnus-extract-address-components "gnus-util") @@ -1988,14 +1911,11 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-group-name-charset "gnus-group") (autoload 'gnus-group-name-decode "gnus-group") (autoload 'gnus-groups-from-server "gnus") -(autoload 'gnus-make-local-hook "gnus-util") (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-output-to-mail "gnus-util") (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'gnus-request-post "gnus-int") -(autoload 'gnus-select-frame-set-input-focus "gnus-util") (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") @@ -2005,20 +1925,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'rmail-msg-is-pruned "rmail") (autoload 'rmail-output "rmailout") -;; Emacs < 24.1 do not have mail-dont-reply-to -(unless (fboundp 'mail-dont-reply-to) - (defalias 'mail-dont-reply-to 'rmail-dont-reply-to)) - -(eval-and-compile - (if (featurep 'emacs) - (progn - (defun message-kill-all-overlays () - (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))) - (defalias 'message-window-inside-pixel-edges - 'window-inside-pixel-edges)) - (defun message-kill-all-overlays () - (map-extents (lambda (extent ignore) (delete-extent extent)))) - (defalias 'message-window-inside-pixel-edges 'ignore))) +(defun message-kill-all-overlays () + (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))) @@ -2238,8 +2146,8 @@ contains a valid encoded word. Decode again? " ;; No double encoded subject? => bogus charset. (unless cs-coding (setq cs-coding - (mm-read-coding-system - (gnus-format-message "\ + (read-coding-system + (format-message "\ Decoded Subject \"%s\" contains an encoded word. The charset `%s' is unknown or invalid. Hit RET to replace non-decodable characters with \"%s\" or enter replacement @@ -2277,33 +2185,26 @@ charset: " "Remove trailing \"(was: <old subject>)\" from SUBJECT lines. Leading \"Re: \" is not stripped by this function. Use the function `message-strip-subject-re' for this." - (let* ((query message-subject-trailing-was-query) - (new) (found)) - (setq found - (string-match - (if (eq query 'ask) - message-subject-trailing-was-ask-regexp - message-subject-trailing-was-regexp) - subject)) - (if found - (setq new (substring subject 0 (match-beginning 0)))) - (if (or (not found) (eq query nil)) - subject - (if (eq query 'ask) - (if (message-y-or-n-p - "Strip `(was: <old subject>)' in subject? " t - (concat - "Strip `(was: <old subject>)' in subject " - "and use the new one instead?\n\n" - "Current subject is: \"" - subject "\"\n\n" - "New subject would be: \"" - new "\"\n\n" - "See the variable `message-subject-trailing-was-query' " - "to get rid of this query." - )) - new subject) - new)))) + (or + (let ((query message-subject-trailing-was-query) new) + (and query + (string-match (if (eq query 'ask) + message-subject-trailing-was-ask-regexp + message-subject-trailing-was-regexp) + subject) + (setq new (substring subject 0 (match-beginning 0))) + (or (not (eq query 'ask)) + (message-y-or-n-p + "Strip `(was: <old subject>)' in subject? " t + (concat + "Strip `(was: <old subject>)' in subject " + "and use the new one instead?\n\n" + "Current subject is: \"" subject "\"\n\n" + "New subject would be: \"" new "\"\n\n" + "See the variable `message-subject-trailing-was-query' " + "to get rid of this query."))) + new)) + subject)) ;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/ @@ -2702,19 +2603,16 @@ Prefixed with one \\[universal-argument], display the Emacs MIME manual. With two \\[universal-argument]'s, display the EasyPG or PGG manual, depending on the value of `mml2015-use'." (interactive "p") - ;; Don't use `info' because support for `(filename)nodename' is not - ;; available in XEmacs < 21.5.12. - (Info-goto-node (format "(%s)Top" - (cond ((eq arg 16) - (require 'mml2015) - mml2015-use) - ((eq arg 4) 'emacs-mime) - ;; `booleanp' only available in Emacs 22+ - ((and (not (memq arg '(nil t))) - (symbolp arg)) - arg) - (t - 'message))))) + (info (format "(%s)Top" + (cond ((eq arg 16) + (require 'mml2015) + mml2015-use) + ((eq arg 4) 'emacs-mime) + ((and (not (booleanp arg)) + (symbolp arg)) + arg) + (t + 'message))))) @@ -2812,43 +2710,29 @@ PGG manual, depending on the value of `mml2015-use'." ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] ["Elide Region" message-elide-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Replace text in region with an ellipsis"))] + :help "Replace text in region with an ellipsis"] ["Delete Outside Region" message-delete-not-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Delete all quoted text outside region"))] + :help "Delete all quoted text outside region"] ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Spellcheck this message"))] + ["Spellcheck" ispell-message :help "Spellcheck this message"] "----" ["Insert Region Marked" message-mark-inserted-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Mark region with enclosing tags"))] + :active (message-mark-active-p) :help "Mark region with enclosing tags"] ["Insert File Marked..." message-mark-insert-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert file at point marked with enclosing tags"))] + :help "Insert file at point marked with enclosing tags"] "----" - ["Send Message" message-send-and-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Send this message"))] + ["Send Message" message-send-and-exit :help "Send this message"] ["Postpone Message" message-dont-send - ,@(if (featurep 'xemacs) '(t) - '(:help "File this draft message and exit"))] + :help "File this draft message and exit"] ["Send at Specific Time..." gnus-delay-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Ask, then arrange to send message at that time"))] + :help "Ask, then arrange to send message at that time"] ["Kill Message" message-kill-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Delete this message without sending"))] + :help "Delete this message without sending"] "----" - ["Message manual" message-info - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Message manual"))])) + ["Message manual" message-info :help "Display the Message manual"])) (easy-menu-define message-mode-field-menu message-mode-map "" @@ -2862,15 +2746,12 @@ PGG manual, depending on the value of `mml2015-use'." ["Fcc" message-goto-fcc t] ["Reply-To" message-goto-reply-to t] ["Flag As Important" message-insert-importance-high - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as important"))] + :help "Mark this message as important"] ["Flag As Unimportant" message-insert-importance-low - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as unimportant"))] + :help "Mark this message as unimportant"] ["Request Receipt" message-insert-disposition-notification-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Request a receipt notification"))] + :help "Request a receipt notification"] "----" ;; (typical) news stuff ["Summary" message-goto-summary t] @@ -2886,18 +2767,14 @@ PGG manual, depending on the value of `mml2015-use'." "----" ;; (typical) mailing-lists stuff ["Fetch To" message-insert-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a To header that points to the author."))] + :help "Insert a To header that points to the author."] ["Fetch To and Cc" message-insert-wide-reply - ,@(if (featurep 'xemacs) '(t) - '(:help - "Insert To and Cc headers as if you were doing a wide reply."))] + :help "Insert To and Cc headers as if you were doing a wide reply."] "----" ["Send to list only" message-to-list-only t] ["Mail-Followup-To" message-goto-mail-followup-to t] ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a reasonable `Mail-Followup-To:' header."))] + :help "Insert a reasonable `Mail-Followup-To:' header."] ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----" ["Sort Headers" message-sort-headers t] @@ -2943,7 +2820,6 @@ message composition doesn't break too bad." ;; category, face, display: probably doesn't do any harm. ;; fontified: is used by font-lock. ;; syntax-table, local-map: I dunno. - ;; We need to add XEmacs names to the list. "Property list of with properties forbidden in message buffers. The values of the properties are ignored, only the property names are used.") @@ -2979,8 +2855,6 @@ See also `message-forbidden-properties'." (inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) -(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. - (defvar message-smileys '(":-)" ":)" ":-(" ":(" ";-)" ";)") @@ -3078,25 +2952,19 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'comment-start) message-yank-prefix) (set (make-local-variable 'comment-start-skip) (concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) - (if (featurep 'xemacs) - (message-setup-toolbar) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t)) + (if (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) - (gnus-make-local-hook 'after-change-functions) ;; Mmmm... Forbidden properties... (add-hook 'after-change-functions 'message-strip-forbidden-properties nil 'local) ;; Allow mail alias things. (cond ((message-mail-alias-type-p 'abbrev) - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (if (fboundp 'mail-aliases-setup) ; warning avoidance - (mail-aliases-setup)))) + (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) (add-hook 'completion-at-point-functions 'message-completion-function nil t) @@ -3122,8 +2990,6 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (make-local-variable 'adaptive-fill-regexp) - (unless (boundp 'adaptive-fill-first-line-regexp) - (setq adaptive-fill-first-line-regexp nil)) (make-local-variable 'adaptive-fill-first-line-regexp) (let ((quote-prefix-regexp ;; User should change message-cite-prefix-regexp if @@ -3146,20 +3012,8 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (setq adaptive-fill-first-line-regexp (concat quote-prefix-regexp "\\|" adaptive-fill-first-line-regexp))) - (make-local-variable 'auto-fill-inhibit-regexp) - ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:") - (setq auto-fill-inhibit-regexp nil) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'message-do-auto-fill) - ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'. - ;; In that case, ensure that it uses the right function. The real - ;; solution would be not to use `define-derived-mode', and run - ;; `text-mode-hook' ourself at the end of the mode. - ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19. - ;; This kludge is unneeded in Emacs>=21 since define-derived-mode is - ;; now careful to run parent hooks after the body. --Stef - (when auto-fill-function - (setq auto-fill-function normal-auto-fill-function))) + (setq-local auto-fill-inhibit-regexp nil) + (setq-local normal-auto-fill-function 'message-do-auto-fill)) @@ -3250,7 +3104,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (defun message-goto-body () "Move point to the beginning of the message body." (interactive) - (when (and (gmm-called-interactively-p 'any) + (when (and (called-interactively-p 'any) (looking-at "[ \t]*\n")) (expand-abbrev)) (push-mark) @@ -3565,22 +3419,20 @@ Prefix arg means justify as well." This function is used as the value of `fill-paragraph-function' in Message buffers and is not meant to be called directly." (interactive (list (if current-prefix-arg 'full))) - (if (if (boundp 'filladapt-mode) filladapt-mode) - nil - (if (message-point-in-header-p) - (message-fill-field) - (message-newline-and-reformat arg t)) - t)) + (if (message-point-in-header-p) + (message-fill-field) + (message-newline-and-reformat arg t)) + t) (defun message-point-in-header-p () "Return t if point is in the header." (save-excursion - (and - (not - (re-search-backward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t)))) + (save-restriction + (widen) + (let ((bound (+ (point-at-eol) 1)) case-fold-search) + (goto-char (point-min)) + (not (search-forward (concat "\n" mail-header-separator "\n") + bound t)))))) (defun message-do-auto-fill () "Like `do-auto-fill', but don't fill in message header." @@ -3854,15 +3706,11 @@ If REMOVE is non-nil, remove newlines, too. To use this automatically, you may add this function to `gnus-message-setup-hook'." (interactive "P") - (let ((citexp - (concat - "^\\(" - (when (boundp 'message-yank-cited-prefix) - (concat message-yank-cited-prefix "\\|")) - message-yank-prefix - "\\)+ *\n" - ))) - (gnus-message 8 "removing `%s'" citexp) + (let ((citexp (concat "^\\(" + (concat message-yank-cited-prefix "\\|") + message-yank-prefix + "\\)+ *\n"))) + (message "Removing `%s'" citexp) (save-excursion (message-goto-body) (while (re-search-forward citexp nil t) @@ -4020,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. @@ -4112,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))) @@ -4283,7 +4136,7 @@ It should typically alter the sending method in some way or other." (or (eq message-allow-no-recipients 'always) (and (not (eq message-allow-no-recipients 'never)) (setq dont-barf-on-no-method - (gnus-y-or-n-p + (y-or-n-p (format "No receiver, perform %s anyway? " (cond ((and fcc gcc) "Fcc and Gcc") (fcc "Fcc") @@ -4353,14 +4206,14 @@ not have PROP." (nreverse regions))) (defcustom message-bogus-addresses - '("noreply" "nospam" "invalid" "@@" "[^[:ascii:]].*@" "[ \t]") + '("noreply" "nospam" "invalid" "@.*@" "[^[:ascii:]].*@" "[ \t]") "List of regexps of potentially bogus mail addresses. See `message-check-recipients' how to setup checking. This list should make it possible to catch typos or warn about spam-trap addresses. It doesn't aim to verify strict RFC conformance." - :version "23.1" ;; No Gnus + :version "26.1" ; @@ -> @.*@ :group 'message-headers :type '(choice (const :tag "None" nil) @@ -4369,10 +4222,9 @@ conformance." (const "noreply") (const "nospam") (const "invalid") - (const :tag "duplicate @" "@@") + (const :tag "duplicate @" "@.*@") (const :tag "non-ascii local part" "[^[:ascii:]].*@") - ;; Already caught by `message-valid-fqdn-regexp' - ;; (const :tag "`_' in domain part" "@.*_") + (const :tag "`_' in domain part" "@.*_") (const :tag "whitespace" "[ \t]")) (repeat :inline t :tag "Other" @@ -4418,7 +4270,7 @@ conformance." (point) 'no-illegible-text) (point-max)))) (setq char (char-after))) - (when (or (< (mm-char-int char) 128) + (when (or (< char 128) (and (mm-multibyte-p) (memq (char-charset char) '(eight-bit-control eight-bit-graphic @@ -4432,23 +4284,25 @@ conformance." (forward-char)) (when found (setq choice - (gnus-multiple-choice - (if nul-chars - "NUL characters found, which may cause problems. Continue sending?" - "Non-printable characters found. Continue sending?") - `((?d "Remove non-printable characters and send") - (?r ,(format - "Replace non-printable characters with \"%s\" and send" - message-replacement-char)) - (?s "Send as is without removing anything") - (?e "Continue editing")))) + (car + (read-multiple-choice + (if nul-chars + "NUL characters found, which may cause problems. Continue sending?" + "Non-printable characters found. Continue sending?") + `((?d "delete" "Remove non-printable characters and send") + (?r "replace" + ,(format + "Replace non-printable characters with \"%s\" and send" + message-replacement-char)) + (?s "send" "Send as is without removing anything") + (?e "edit" "Continue editing"))))) (if (eq choice ?e) (error "Non-printable characters")) (message-goto-body) (skip-chars-forward mm-7bit-chars) (while (not (eobp)) (when (let ((char (char-after))) - (or (< (mm-char-int char) 128) + (or (< char 128) (and (mm-multibyte-p) ;; FIXME: Wrong for Emacs 23 (unicode) and for ;; things like undecodable utf-8 (in Emacs 21?). @@ -4478,31 +4332,22 @@ conformance." RECIPIENTS is a mail header. Return a list of potentially bogus addresses. If none is found, return nil. -An address might be bogus if the domain part is not fully -qualified, see `message-valid-fqdn-regexp', or if there's a -matching entry in `message-bogus-addresses'." +An address might be bogus if if there's a matching entry in +`message-bogus-addresses'." ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"? (let (found) (mapc (lambda (address) (setq address (or (cadr address) "")) - (when - (or (string= "" address) - (not - (or - (not (string-match "@" address)) - (string-match - (concat ".@.*\\(" - message-valid-fqdn-regexp "\\)\\'") address))) - (and message-bogus-addresses - (let ((re - (if (listp message-bogus-addresses) - (mapconcat 'identity - message-bogus-addresses - "\\|") - message-bogus-addresses))) - (string-match re address)))) + (when (or (string= "" address) + (and message-bogus-addresses + (let ((re + (if (listp message-bogus-addresses) + (mapconcat 'identity + message-bogus-addresses + "\\|") + message-bogus-addresses))) + (string-match re address)))) (push address found))) - ;; (mail-extract-address-components recipients t)) found)) @@ -4519,7 +4364,7 @@ This function could be useful in `message-setup-hook'." (dolist (bog (message-bogus-recipient-p addr)) (and bog (not (y-or-n-p - (gnus-format-message + (format-message "Address `%s'%s might be bogus. Continue? " bog ;; If the encoded version of the email address @@ -4634,7 +4479,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) @@ -4703,7 +4548,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) @@ -4791,6 +4636,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 () @@ -4970,6 +4817,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." @@ -5067,7 +4916,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. @@ -5452,7 +5301,7 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Check for control characters. (message-check 'control-chars (if (re-search-forward - (mm-string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") + (string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") nil t) (y-or-n-p "The article contains control characters. Really post? ") @@ -5562,9 +5411,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)) @@ -5818,10 +5665,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." "Make a From header." (let* ((style message-from-style) (login (or address (message-make-address))) - (fullname (or name - (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) + (fullname (or name user-full-name (user-full-name)))) (when (string= fullname "&") (setq fullname (user-login-name))) (with-temp-buffer @@ -5914,24 +5758,19 @@ give as trustworthy answer as possible." (cond ((and message-user-fqdn (stringp message-user-fqdn) - (string-match message-valid-fqdn-regexp message-user-fqdn) (not (string-match message-bogus-system-names message-user-fqdn))) ;; `message-user-fqdn' seems to be valid message-user-fqdn) - ((and (string-match message-valid-fqdn-regexp sysname) - (not (string-match message-bogus-system-names sysname))) + ((and (string-match message-bogus-system-names sysname)) ;; `system-name' returned the right result. sysname) ;; Try `mail-host-address'. - ((and (boundp 'mail-host-address) - (stringp mail-host-address) - (string-match message-valid-fqdn-regexp mail-host-address) + ((and (stringp mail-host-address) (not (string-match message-bogus-system-names mail-host-address))) mail-host-address) ;; We try `user-mail-address' as a backup. ((and user-domain (stringp user-domain) - (string-match message-valid-fqdn-regexp user-domain) (not (string-match message-bogus-system-names user-domain))) user-domain) ;; Default to this bogus thing. @@ -6005,7 +5844,7 @@ subscribed address (and not the additional To and Cc header contents)." ace) (when field (dolist (rhs - (mm-delete-duplicates + (delete-dups (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) (mapcar 'downcase (mapcar @@ -6017,7 +5856,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:? " @@ -6051,41 +5890,27 @@ See `message-idna-encode'." (message-idna-to-ascii-rhs-1 "Mail-Followup-To") (message-idna-to-ascii-rhs-1 "Cc"))))) -(defvar Date) -(defvar Message-ID) -(defvar Organization) -(defvar From) -(defvar Path) -(defvar Subject) -(defvar Newsgroups) -(defvar In-Reply-To) -(defvar References) -(defvar To) -(defvar Distribution) -(defvar Lines) -(defvar User-Agent) -(defvar Expires) - (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." (setq headers (append headers message-required-headers)) (save-restriction (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (References (message-make-references)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (User-Agent message-newsreader) - (Expires (message-make-expires)) + (let* ((header-values + (list 'Date (message-make-date) + 'Message-ID (message-make-message-id) + 'Organization (message-make-organization) + 'From (message-make-from) + 'Path (message-make-path) + 'Subject nil + 'Newsgroups nil + 'In-Reply-To (message-make-in-reply-to) + 'References (message-make-references) + 'To nil + 'Distribution (message-make-distribution) + 'Lines (message-make-lines) + 'User-Agent message-newsreader + 'Expires (message-make-expires))) (case-fold-search t) (optionalp nil) header value elem header-string) @@ -6139,8 +5964,8 @@ Headers already prepared in the buffer are not modified." (setq header (cdr elem)) (or (and (functionp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) - (symbol-value (cdr elem))))) + (and (symbolp (cdr elem)) + (plist-get header-values (cdr elem))))) ((consp elem) ;; The element is a cons. Either the cdr is a ;; string to be inserted verbatim, or it is a @@ -6150,11 +5975,11 @@ Headers already prepared in the buffer are not modified." (cdr elem)) (and (functionp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) - (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) + ((and (symbolp header) + (plist-member header-values header)) + ;; The element is a symbol. We insert the value of + ;; this symbol, if any. + (plist-get header-values header)) ((not (message-check-element (intern (downcase (symbol-name header))))) ;; We couldn't generate a value for this header, @@ -6266,10 +6091,7 @@ Headers already prepared in the buffer are not modified." "Split current line, moving portion beyond point vertically down. If the current line has `message-yank-prefix', insert it on the new line." (interactive "*") - (condition-case nil - (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg. - (error - (split-line)))) + (split-line message-yank-prefix)) (defun message-insert-header (header value) (insert (capitalize (symbol-name header)) @@ -6412,35 +6234,73 @@ they are." (defvar visual-line-mode) (declare-function beginning-of-visual-line "simple" (&optional n)) +(defun message-beginning-of-header (handle-folded) + "Move point to beginning of header’s value. + +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 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 +case of single-line headers. + +No check whether point is inside of a header or body of the +message is performed. + +Returns point or nil if beginning of header’s value could not be +found. In the latter case, the point is still moved to the +beginning of line (possibly after attempting to move it to the +beginning of a folded header)." + ;; https://www.rfc-editor.org/rfc/rfc2822.txt, section 2.2.3. says that when + ;; unfolding a single WSP should be consumed. WSP is defined as a space + ;; character or a horizontal tab. + (beginning-of-line) + (when handle-folded + (while (and (> (point) (point-min)) + (or (eq (char-after) ?\s) (eq (char-after) ?\t))) + (beginning-of-line 0))) + (when (or (eq (char-after) ?\s) (eq (char-after) ?\t) + (search-forward ":" (point-at-eol) t)) + ;; We are a bit more lacks than the RFC and allow any positive number of WSP + ;; characters. + (skip-chars-forward " \t" (point-at-eol)) + (point))) + (defun message-beginning-of-line (&optional n) "Move point to beginning of header value or to beginning of line. The prefix argument N is passed directly to `beginning-of-line'. This command is identical to `beginning-of-line' if point is -outside the message header or if the option `message-beginning-of-line' -is nil. - -If point is in the message header and on a (non-continued) header -line, move point to the beginning of the header value or the beginning of line, -whichever is closer. If point is already at beginning of line, move point to -beginning of header value. Therefore, repeated calls will toggle point -between beginning of field and beginning of line." +outside the message header or if the option +`message-beginning-of-line' is nil. + +If point is in the message header and on a header line, move +point to the beginning of the header value or the beginning of +line, whichever is closer. If point is already at beginning of +line, move point to beginning of header value. Therefore, +repeated calls will toggle point between beginning of field and +beginning of line. + +When called without a prefix argument, header value spanning +multiple lines is treated as a single line. Otherwise, even if +N is 1, when point is on a continuation header line, it will be +moved to the beginning " (interactive "p") - (let ((zrs 'zmacs-region-stays)) - (when (and (featurep 'xemacs) (interactive-p) (boundp zrs)) - (set zrs t))) - (if (and message-beginning-of-line - (message-point-in-header-p)) - (let* ((here (point)) - (bol (progn (beginning-of-line n) (point))) - (eol (point-at-eol)) - (eoh (re-search-forward ": *" eol t))) - (goto-char - (if (and eoh (or (< eoh here) (= bol here))) - eoh bol))) - (if (and (boundp 'visual-line-mode) visual-line-mode) - (beginning-of-visual-line n) - (beginning-of-line n)))) + (cond + ;; Go to beginning of header or beginning of line. + ((and message-beginning-of-line (message-point-in-header-p)) + (let* ((point (point)) + (bol (progn (beginning-of-line n) (point))) + (boh (message-beginning-of-header visual-line-mode))) + (goto-char (if (and boh (or (< boh point) (= bol point))) boh bol)))) + ;; Go to beginning of visual line + (visual-line-mode + (beginning-of-visual-line n)) + ;; Go to beginning of line. + ((beginning-of-line n)))) (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." @@ -6507,7 +6367,7 @@ between beginning of field and beginning of line." (if window ;; Raise the frame already displaying the message buffer. (progn - (gnus-select-frame-set-input-focus (window-frame window)) + (select-frame-set-input-focus (window-frame window)) (select-window window)) (funcall (or switch-function #'pop-to-buffer) buffer) (set-buffer buffer)) @@ -6517,10 +6377,7 @@ between beginning of field and beginning of line." "Message already being composed; erase? ") (message nil)))) (error "Message being composed"))) - (funcall (or switch-function - (if (fboundp #'pop-to-buffer-same-window) - #'pop-to-buffer-same-window - #'pop-to-buffer)) + (funcall (or switch-function 'pop-to-buffer-same-window) name) (set-buffer name)) (erase-buffer) @@ -6938,9 +6795,20 @@ want to get rid of this query permanently."))) ;; Squeeze whitespace. (while (string-match "[ \t][ \t]+" recipients) (setq recipients (replace-match " " t t recipients))) - ;; Remove addresses that match `mail-dont-reply-to-names'. - (let ((mail-dont-reply-to-names (message-dont-reply-to-names))) - (setq recipients (mail-dont-reply-to recipients))) + ;; Remove addresses that match `message-dont-reply-to-names'. + (setq recipients + (cond ((functionp message-dont-reply-to-names) + (mapconcat + 'identity + (delq nil + (mapcar (lambda (mail) + (unless (funcall message-dont-reply-to-names + (mail-strip-quoted-names mail)) + mail)) + (message-tokenize-header recipients))) + ", ")) + (t (let ((mail-dont-reply-to-names (message-dont-reply-to-names))) + (mail-dont-reply-to recipients))))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") (setq recipients author)) @@ -7222,7 +7090,7 @@ want to get rid of this query permanently.")) If you have added `cancel-messages' to `message-shoot-gnksa-feet', all articles are yours except those that have Cancel-Lock header not belonging to you. Instead of shooting GNKSA feet, you should modify `message-alternative-emails' -regexp to match all of yours addresses." +to match all of yours addresses." ;; Canlock-logic as suggested by Per Abrahamsen ;; <abraham@dina.kvl.dk> ;; @@ -7254,12 +7122,14 @@ regexp to match all of yours addresses." (downcase (car (mail-header-parse-address (message-make-from)))))) ;; Email address in From field matches - ;; 'message-alternative-emails' regexp + ;; 'message-alternative-emails' regexp or function. (and from message-alternative-emails - (string-match - message-alternative-emails - (car (mail-header-parse-address from)))))))))) + (cond ((functionp message-alternative-emails) + (funcall message-alternative-emails + (mail-header-parse-address from))) + (t (string-match message-alternative-emails + (car (mail-header-parse-address from)))))))))))) ;;;###autoload (defun message-cancel-news (&optional arg) @@ -7339,7 +7209,7 @@ header line with the old Message-ID." (cond ((save-window-excursion (with-output-to-temp-buffer "*Directory*" (with-current-buffer standard-output - (fundamental-mode)) ; for Emacs 20.4+ + (fundamental-mode)) (buffer-disable-undo standard-output) (let ((default-directory "/")) (call-process @@ -7485,14 +7355,13 @@ Optional DIGEST will use digest to forward." (let ((b (point)) (contents (with-current-buffer forward-buffer (buffer-string))) e) - (unless (featurep 'xemacs) - (unless (mm-multibyte-string-p contents) - (error "Attempt to insert unibyte string from the buffer \"%s\"\ + (unless (multibyte-string-p contents) + (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" - (if (bufferp forward-buffer) - (buffer-name forward-buffer) - forward-buffer) - (buffer-name)))) + (if (bufferp forward-buffer) + (buffer-name forward-buffer) + forward-buffer) + (buffer-name))) (insert (mm-with-multibyte-buffer (insert contents) (mime-to-mml) @@ -7549,14 +7418,13 @@ Optional DIGEST will use digest to forward." (let ((b (point)) e) (if (not message-forward-decoded-p) (let ((contents (with-current-buffer forward-buffer (buffer-string)))) - (unless (featurep 'xemacs) - (unless (mm-multibyte-string-p contents) - (error "Attempt to insert unibyte string from the buffer \"%s\"\ + (unless (multibyte-string-p contents) + (error "Attempt to insert unibyte string from the buffer \"%s\"\ to the multibyte buffer \"%s\"" - (if (bufferp forward-buffer) - (buffer-name forward-buffer) - forward-buffer) - (buffer-name)))) + (if (bufferp forward-buffer) + (buffer-name forward-buffer) + forward-buffer) + (buffer-name))) (insert (mm-with-multibyte-buffer (insert contents) (mime-to-mml) @@ -7688,10 +7556,8 @@ is for the internal use." (defun message-forward-rmail-make-body (forward-buffer) (save-window-excursion (set-buffer forward-buffer) - (if (rmail-msg-is-pruned) - (if (fboundp 'rmail-msg-restore-non-pruned-header) - (rmail-msg-restore-non-pruned-header) ; Emacs 22 - (rmail-toggle-header 0)))) ; Emacs 23 + (when (rmail-msg-is-pruned) + (rmail-toggle-header 0))) (message-forward-make-body forward-buffer)) ;; Fixme: Should have defcustom. @@ -7765,6 +7631,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) @@ -7941,12 +7810,10 @@ Pre-defined symbols include `message-tool-bar-gnome' and (defcustom message-tool-bar-gnome '((ispell-message "spell" nil :vert-only t - :visible (or (not (boundp 'flyspell-mode)) - (not flyspell-mode))) + :visible (not flyspell-mode)) (flyspell-buffer "spell" t :vert-only t - :visible (and (boundp 'flyspell-mode) - flyspell-mode) + :visible flyspell-mode :help "Flyspell whole buffer") (message-send-and-exit "mail/send" t :label "Send") (message-dont-send "mail/save-draft") @@ -8003,18 +7870,14 @@ See `gmm-tool-bar-from-list' for the format of the list." (defun message-make-tool-bar (&optional force) "Make a message mode tool bar from `message-tool-bar-list'. When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) + (when (and (boundp 'tool-bar-mode) tool-bar-mode (or (not message-tool-bar-map) force)) (setq message-tool-bar-map (let* ((load-path - (gmm-image-load-path-for-library "message" - "mail/save-draft.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) + (image-load-path-for-library + "message" "mail/save-draft.xpm" nil t)) + (image-load-path (cons (car load-path) image-load-path))) (gmm-tool-bar-from-list message-tool-bar message-tool-bar-zap-list 'message-mode-map)))) @@ -8048,7 +7911,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 @@ -8065,10 +7928,8 @@ not in those headers. If that variable is nil, indent with the regular text mode tabbing command." (interactive) (cond - ((if (and (boundp 'completion-fail-discreetly) - (fboundp 'completion-at-point)) - (let ((completion-fail-discreetly t)) (completion-at-point)) - (funcall (or (message-completion-function) #'ignore))) + ((let ((completion-fail-discreetly t)) + (completion-at-point)) ;; Completion was performed; nothing else to do. nil) (message-tab-body-function (funcall message-tab-body-function)) @@ -8085,7 +7946,7 @@ regular text mode tabbing command." (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) (when (cdar alist) - (lexical-let ((fun (cdar alist))) + (let ((fun (cdar alist))) ;; Even if completion fails, return a non-nil value, so as to avoid ;; falling back to message-tab-body-function. (lambda () (funcall fun) 'completion-attempted))))) @@ -8114,41 +7975,7 @@ regular text mode tabbing command." group) collection)) gnus-active-hashtb)) - (message-completion-in-region b e collection))) - -(defalias 'message-completion-in-region - (if (fboundp 'completion-in-region) - 'completion-in-region - (lambda (b e hashtb) - (let* ((string (buffer-substring b e)) - (completions (all-completions string hashtb)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (save-selected-window - (pop-to-buffer "*Completions*") - (buffer-disable-undo) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (setq buffer-read-only nil) - (goto-char (point-min)) - (delete-region (point) - (progn (forward-line 3) (point)))))))))))) + (completion-in-region b e collection))) (defun message-expand-name () (cond ((and (memq 'eudc message-expand-name-databases) @@ -8177,7 +8004,7 @@ The following arguments may contain lists of values." (save-window-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" - (fundamental-mode) ; for Emacs 20.4+ + (fundamental-mode) (mapc 'princ text) (goto-char (point-min)))) (funcall ask question)) @@ -8270,13 +8097,9 @@ regexp VARSTR." (defun message-read-from-minibuffer (prompt &optional initial-contents) "Read from the minibuffer while providing abbrev expansion." - (if (fboundp 'mail-abbrevs-setup) - (let ((minibuffer-setup-hook 'mail-abbrevs-setup) - (minibuffer-local-map message-minibuffer-local-map)) - (read-from-minibuffer prompt initial-contents)) - (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) - (minibuffer-local-map message-minibuffer-local-map)) - (read-string prompt initial-contents)))) + (let ((minibuffer-setup-hook 'mail-abbrevs-setup) + (minibuffer-local-map message-minibuffer-local-map)) + (read-from-minibuffer prompt initial-contents))) (defun message-use-alternative-email-as-from () "Set From field of the outgoing message to the first matching @@ -8285,16 +8108,14 @@ From headers in the original article." (require 'mail-utils) (let* ((fields '("To" "Cc" "From")) (emails - (split-string + (message-tokenize-header (mail-strip-quoted-names - (mapconcat 'message-fetch-reply-field fields ",")) - "[ \f\t\n\r\v,]+")) - email) - (while emails - (if (string-match message-alternative-emails (car emails)) - (setq email (car emails) - emails nil)) - (pop emails)) + (mapconcat 'message-fetch-reply-field fields ",")))) + (email (cond ((functionp message-alternative-emails) + (car (cl-remove-if-not message-alternative-emails emails))) + (t (loop for email in emails + if (string-match-p message-alternative-emails email) + return email))))) (unless (or (not email) (equal email user-mail-address)) (message-remove-header "From") (goto-char (point-max)) @@ -8381,8 +8202,9 @@ From headers in the original article." (let ((value (message-field-value header))) (dolist (string (mail-header-parse-addresses value 'raw)) (setq string - (gnus-replace-in-string - (gnus-replace-in-string string "^ +\\| +$" "") "\n" "")) + (replace-regexp-in-string + "\n" "" + (replace-regexp-in-string "^ +\\| +$" "" string))) (ecomplete-add-item 'mail (car (mail-header-parse-address string)) string)))) (ecomplete-save)) @@ -8493,7 +8315,7 @@ Header and body are separated by `mail-header-separator'." (when force (sit-for message-send-form-letter-delay)) (if (or force - (y-or-n-p (gnus-format-message "Send message to `%s'? " to))) + (y-or-n-p (format-message "Send message to `%s'? " to))) (progn (setq sent (1+ sent)) (message-send-and-exit)) @@ -8569,34 +8391,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)) - (edges (message-window-inside-pixel-edges + (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) - " "))))))) - -(when (featurep 'xemacs) - (require 'messagexmas) - (message-xmas-redefine)) + 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-archive.el b/lisp/gnus/mm-archive.el index 45dbd901abf..bac722e31bf 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -37,7 +37,7 @@ (defun mm-dissect-archive (handle) (let ((decoder (cddr (assoc (car (mm-handle-type handle)) mm-archive-decoders))) - (dir (mm-make-temp-file + (dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir))) (set-file-modes dir #o700) (unwind-protect diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 11449f9d9de..6ccaa770dbd 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -86,15 +86,15 @@ If no encoding was done, nil is returned." (message-options-get 'mm-body-charset-encoding-alist) (message-options-set 'mm-body-charset-encoding-alist - (mm-read-coding-system "Charset used in the article: "))) + (read-coding-system "Charset used in the article: "))) ;; The logic in `mml-generate-mime-1' confirms that it's OK ;; to return nil here. nil))) (save-excursion (if charset (progn - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)) + (encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)) charset) (goto-char (point-min)) (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) @@ -110,8 +110,8 @@ If no encoding was done, nil is returned." (t (prog1 (setq charset (car charsets)) - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)))) + (encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)))) )))))) (defun mm-long-lines-p (length) @@ -243,8 +243,7 @@ decoding. If it is nil, default to `mail-parse-charset'." (save-excursion (when encoding (mm-decode-content-transfer-encoding encoding type)) - (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. - (not (eq charset 'gnus-decoded))) + (when (not (eq charset 'gnus-decoded)) (let ((coding-system (mm-charset-to-coding-system ;; Allow overwrite using ;; `mm-charset-override-alist'. @@ -255,18 +254,11 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq coding-system (mm-charset-to-coding-system mail-parse-charset))) (when (and charset coding-system - ;; buffer-file-coding-system - ;;Article buffer is nil coding system - ;;in XEmacs (mm-multibyte-p) (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset))) - (mm-decode-coding-region (point-min) (point-max) - coding-system)) - (setq buffer-file-coding-system - (if (boundp 'last-coding-system-used) - (symbol-value 'last-coding-system-used) - coding-system)))))) + (decode-coding-region (point-min) (point-max) coding-system)) + (setq buffer-file-coding-system last-coding-system-used))))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." @@ -278,22 +270,21 @@ decoding. If it is nil, default to `mail-parse-charset'." (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) (or - (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system - charset - ;; Allow overwrite using - ;; `mm-charset-override-alist'. - nil t))) - (if (and (not coding-system) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq coding-system - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset coding-system - (mm-multibyte-p) - (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset))) - (mm-decode-coding-string string coding-system)))) + (let ((coding-system (mm-charset-to-coding-system + charset + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + nil t))) + (if (and (not coding-system) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq coding-system + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset coding-system + (mm-multibyte-p) + (or (not (eq coding-system 'ascii)) + (setq coding-system mail-parse-charset))) + (decode-coding-string string coding-system))) string)) (provide 'mm-bodies) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index b6532b3b262..3127a22e41d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -28,9 +28,6 @@ (eval-when-compile (require 'cl)) (autoload 'gnus-map-function "gnus-util") -(autoload 'gnus-replace-in-string "gnus-util") -(autoload 'gnus-read-shell-command "gnus-util") -(autoload 'gnus-format-message "gnus-util") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") @@ -291,10 +288,7 @@ before the external MIME handler is invoked." (mm-insert-part handle) (let ((image (ignore-errors - (if (fboundp 'create-image) - (create-image (buffer-string) 'imagemagick 'data-p) - (mm-create-image-xemacs - (mm-handle-media-subtype handle)))))) + (create-image (buffer-string) 'imagemagick 'data-p)))) (when image (setcar (cdr handle) (list "image/imagemagick")) (mm-image-fit-p handle))))))) @@ -388,12 +382,7 @@ enables you to choose manually one of two types those mails include." :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. :group 'mime-display) -(defcustom mm-tmp-directory - (if (fboundp 'temp-directory) - (temp-directory) - (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp/")) +(defcustom mm-tmp-directory temporary-file-directory "Where mm will store its temporary files." :type 'directory :group 'mime-display) @@ -436,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 `\"_\"'.") @@ -778,7 +769,7 @@ MIME-Version header before proceeding." (with-current-buffer (generate-new-buffer " *mm*") ;; Preserve the data's unibyteness (for url-insert-file-contents). - (mm-set-buffer-multibyte mb) + (set-buffer-multibyte mb) (insert-buffer-substring obuf beg) (current-buffer)))) @@ -862,7 +853,7 @@ external if displayed external." (concat "using external program \"" (format method filename) "\"") - (gnus-format-message + (format-message "by calling `%s' on the contents)" method)) "? ")))))) (if external @@ -893,7 +884,7 @@ external if displayed external." (select-window win))) (switch-to-buffer (generate-new-buffer " *mm*"))) (buffer-disable-undo) - (mm-set-buffer-file-coding-system mm-binary-coding-system) + (set-buffer-file-coding-system mm-binary-coding-system) (insert-buffer-substring cur) (goto-char (point-min)) (when method @@ -920,7 +911,7 @@ external if displayed external." ;; The function is a string to be executed. (mm-insert-part handle) (mm-add-meta-html-tag handle) - (let* ((dir (mm-make-temp-file + (let* ((dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir)) (filename (or (mail-content-type-get @@ -950,8 +941,8 @@ external if displayed external." ;; `mailcap-mime-extensions'. (setq suffix (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))) - (setq file (mm-make-temp-file (expand-file-name "mm." dir) - nil suffix)))) + (setq file (make-temp-file (expand-file-name "mm." dir) + nil suffix)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) ;; The file is deleted after the viewer exists. If the users edits @@ -1149,9 +1140,6 @@ external if displayed external." (ignore-errors (cond ;; Internally displayed part. - ((mm-annotationp object) - (if (featurep 'xemacs) - (delete-annotation object))) ((or (functionp object) (and (listp object) (eq (car object) 'lambda))) @@ -1315,7 +1303,7 @@ are ignored." (with-current-buffer (mm-handle-buffer handle) (buffer-string))) ((mm-multibyte-p) - (mm-string-to-multibyte (mm-get-part handle no-cache))) + (string-to-multibyte (mm-get-part handle no-cache))) (t (mm-get-part handle no-cache))))) (save-restriction @@ -1361,12 +1349,12 @@ string if you do not like underscores." (defun mm-file-name-delete-control (filename) "Delete control characters from FILENAME." - (gnus-replace-in-string filename "[\x00-\x1f\x7f]" "")) + (replace-regexp-in-string "[\x00-\x1f\x7f]" "" filename)) (defun mm-file-name-delete-gotchas (filename) "Delete shell gotchas from FILENAME." - (setq filename (gnus-replace-in-string filename "[<>|]" "")) - (gnus-replace-in-string filename "^[.-]+" "")) + (setq filename (replace-regexp-in-string "[<>|]" "" filename)) + (replace-regexp-in-string "^[.-]+" "" filename)) (defun mm-save-part (handle &optional prompt) "Write HANDLE to a file. @@ -1459,7 +1447,7 @@ text/\\(\\sw+\\)\\(?:;\\s-*charset=\\([^\"'>]+\\)\\)?[^>]*>" nil t) Use CMD as the process." (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) (command (or cmd - (gnus-read-shell-command + (read-shell-command "Shell command on MIME part: " mm-last-shell-command)))) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -1575,73 +1563,29 @@ be determined." (prog1 (setq spec (ignore-errors - ;; Avoid testing `make-glyph' since W3 may define - ;; a bogus version of it. - (if (fboundp 'create-image) - (create-image (buffer-string) - (or (mm-image-type-from-buffer) - (intern type)) - 'data-p) - (mm-create-image-xemacs type)))) + (create-image (buffer-string) + (or (mm-image-type-from-buffer) + (intern type)) + 'data-p))) (mm-handle-set-cache handle spec)))))) -(defun mm-create-image-xemacs (type) - (when (featurep 'xemacs) - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (mm-make-temp-file - (expand-file-name "emm" mm-tmp-directory) - nil ".xbm"))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector - (or (mm-image-type-from-buffer) - (intern type)) - :data (buffer-string))))))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) (or (not image) - (if (featurep 'xemacs) - ;; XEmacs's glyphs can actually tell us about their width, so - ;; let's be nice and smart about them. - (or mm-inline-large-images - (and (<= (glyph-width image) (window-pixel-width)) - (<= (glyph-height image) (window-pixel-height)))) - (let* ((size (image-size image)) - (w (car size)) - (h (cdr size))) - (or mm-inline-large-images - (and (<= h (1- (window-height))) ; Don't include mode line. - (<= w (window-width))))))))) + (let* ((size (image-size image)) + (w (car size)) + (h (cdr size))) + (or mm-inline-large-images + (and (<= h (1- (window-height))) ; Don't include mode line. + (<= w (window-width)))))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." - (cond - ;; Handle XEmacs - ((fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format)) - ;; Handle Emacs - ((fboundp 'image-type-available-p) - (and (display-graphic-p) - (image-type-available-p format))) - ;; Nobody else can do images yet. - (t - nil))) + (and (display-graphic-p) + (image-type-available-p format))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." @@ -1839,8 +1783,7 @@ If RECURSIVE, search recursively." (defun mm-shr (handle) ;; Require since we bind its variables. (require 'shr) - (let ((shr-width (if (and (boundp 'shr-use-fonts) - shr-use-fonts) + (let ((shr-width (if shr-use-fonts nil fill-column)) (shr-content-function (lambda (id) @@ -1864,8 +1807,8 @@ If RECURSIVE, search recursively." (mm-charset-to-coding-system charset nil t)) (not (eq charset 'ascii))) - (mm-decode-coding-string (buffer-string) charset) - (mm-string-as-multibyte (buffer-string))) + (decode-coding-string (buffer-string) charset) + (string-as-multibyte (buffer-string))) (erase-buffer) (mm-enable-multibyte))) (goto-char (point-min)) @@ -1893,7 +1836,7 @@ 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) @@ -1908,7 +1851,7 @@ If RECURSIVE, search recursively." (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - :keymap (setq keymap (copy-keymap shr-map)) + :keymap (setq keymap (copy-keymap shr-image-map)) (get-text-property start 'shr-url)) ;; Mask keys that launch `widget-button-click'. ;; Those bindings are provided by `widget-keymap' @@ -1916,6 +1859,10 @@ If RECURSIVE, search recursively." (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-partial.el b/lisp/gnus/mm-partial.el index 523a53b7f5e..2b037f1cf96 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -136,13 +136,6 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." handle `(lambda () (let (buffer-read-only) - (condition-case nil - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground)) - (error nil)) (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) (provide 'mm-partial) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index e5c43fd1559..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 '( @@ -276,19 +276,10 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." (insert-file-contents (substring url (1- (match-end 0)))) (mm-url-insert-file-contents-external url)) (goto-char (point-min)) - (if (fboundp 'url-generic-parse-url) - (setq url-current-object - (url-generic-parse-url url))) + (setq url-current-object (url-generic-parse-url url)) (list url (buffer-size))) (mm-url-load-url) (let ((name buffer-file-name) - (url-request-extra-headers - ;; ISTM setting a Connection header was a workaround for - ;; older versions of url included with w3, but it does more - ;; harm than good with the one shipped with Emacs. --ansel - (if (not (and (boundp 'url-version) - (equal url-version "Emacs"))) - (list (cons "Connection" "Close")))) result) (setq result (url-insert-file-contents url)) (save-excursion @@ -296,10 +287,9 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." (while (re-search-forward "\r 1000\r ?" nil t) (replace-match ""))) (setq buffer-file-name name) - (if (and (fboundp 'url-generic-parse-url) - (listp result)) - (setq url-current-object (url-generic-parse-url - (car result)))) + (when (listp result) + (setq url-current-object + (url-generic-parse-url (car result)))) result))) ;;;###autoload @@ -364,7 +354,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (string-to-number (substring entity 1))))) (setq c (or (cdr (assq c mm-extra-numeric-entities)) (mm-ucs-to-char c))) - (if (mm-char-or-char-int-p c) c ?#)) + (if (characterp c) c ?#)) (or (cdr (assq (intern entity) mm-url-html-entities)) ?#)))) @@ -399,10 +389,7 @@ spaces. Die Die Die." ((= char ? ) "+") ((memq char mm-url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char))))) - (mm-encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) + (encode-coding-string chunk (car (find-coding-systems-string chunk))) ""))) (defun mm-url-encode-www-form-urlencoded (pairs) @@ -415,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 106d010a3dc..59ab7913912 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -25,279 +25,24 @@ (eval-when-compile (require 'cl)) (require 'mail-prsvr) +(require 'timer) -(eval-and-compile - (if (featurep 'xemacs) - (unless (ignore-errors - (require 'timer-funcs)) - (require 'timer)) - (require 'timer))) - -(defvar mm-mime-mule-charset-alist ) -;; Note this is not presently used on Emacs >= 23, which is good, -;; since it means standalone message-mode (which requires mml and -;; hence mml-util) does not load gnus-util. -(autoload 'gnus-completing-read "gnus-util") - -;; Emulate functions that are not available in every (X)Emacs version. -;; The name of a function is prefixed with mm-, like `mm-char-int' for -;; `char-int' that is a native XEmacs function, not available in Emacs. -;; Gnus programs all should use mm- functions, not the original ones. -(eval-and-compile - (mapc - (lambda (elem) - (let ((nfunc (intern (format "mm-%s" (car elem))))) - (if (fboundp (car elem)) - (defalias nfunc (car elem)) - (defalias nfunc (cdr elem))))) - `(;; `coding-system-list' is not available in XEmacs 21.4 built - ;; without the `file-coding' feature. - (coding-system-list . ignore) - ;; `char-int' is an XEmacs function, not available in Emacs. - (char-int . identity) - ;; `coding-system-equal' is an Emacs function, not available in XEmacs. - (coding-system-equal . equal) - ;; `annotationp' is an XEmacs function, not available in Emacs. - (annotationp . ignore) - ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4 - ;; built without the `file-coding' feature. - (set-buffer-file-coding-system . ignore) - ;; `read-charset' is an Emacs function, not available in XEmacs. - (read-charset - . ,(lambda (prompt) - "Return a charset." - (intern - (gnus-completing-read - prompt - (mapcar (lambda (e) (symbol-name (car e))) - mm-mime-mule-charset-alist) - t)))) - ;; `subst-char-in-string' is not available in XEmacs 21.4. - (subst-char-in-string - . ,(lambda (from to string &optional inplace) - ;; stolen (and renamed) from nnheader.el - "Replace characters in STRING from FROM to TO. - Unless optional argument INPLACE is non-nil, return a new string." - (let ((string (if inplace string (copy-sequence string))) - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string))) - ;; `replace-in-string' is an XEmacs function, not available in Emacs. - (replace-in-string - . ,(lambda (string regexp rep &optional literal) - "See `replace-regexp-in-string', only the order of args differs." - (replace-regexp-in-string regexp rep string nil literal))) - ;; `string-as-unibyte' is an Emacs function, not available in XEmacs. - (string-as-unibyte . identity) - ;; `string-make-unibyte' is an Emacs function, not available in XEmacs. - (string-make-unibyte . identity) - ;; string-as-multibyte often doesn't really do what you think it does. - ;; Example: - ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201) - ;; (aref (string-as-multibyte "\300") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 1) -> 129 (aka ?\201) - ;; but - ;; (aref (string-as-multibyte "\201\300") 0) -> 2240 - ;; (aref (string-as-multibyte "\201\300") 1) -> <error> - ;; Better use string-to-multibyte or encode-coding-string. - ;; If you really need string-as-multibyte somewhere it's usually - ;; because you're using the internal emacs-mule representation (maybe - ;; because you're using string-as-unibyte somewhere), which is - ;; generally a problem in itself. - ;; Here is an approximate equivalence table to help think about it: - ;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule) - ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary) - ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system) - ;; `string-as-multibyte' is an Emacs function, not available in XEmacs. - (string-as-multibyte . identity) - ;; `multibyte-string-p' is an Emacs function, not available in XEmacs. - (multibyte-string-p . ignore) - ;; `insert-byte' is available only in Emacs 23.1 or greater. - (insert-byte . insert-char) - ;; `multibyte-char-to-unibyte' is an Emacs function, not available - ;; in XEmacs. - (multibyte-char-to-unibyte . identity) - ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs. - (set-buffer-multibyte . ignore) - ;; `substring-no-properties' is available only in Emacs 22.1 or greater. - (substring-no-properties - . ,(lambda (string &optional from to) - "Return a substring of STRING, without text properties. -It starts at index FROM and ending before TO. -TO may be nil or omitted; then the substring runs to the end of STRING. -If FROM is nil or omitted, the substring starts at the beginning of STRING. -If FROM or TO is negative, it counts from the end. - -With one argument, just copy STRING without its properties." - (setq string (substring string (or from 0) to)) - (set-text-properties 0 (length string) nil string) - string)) - ;; `line-number-at-pos' is available only in Emacs 22.1 or greater - ;; and XEmacs 21.5. - (line-number-at-pos - . ,(lambda (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -Counting starts at (point-min), so the value refers -to the contents of the accessible portion of the buffer." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))))))) - -;; `special-display-p' is an Emacs function, not available in XEmacs. -(defalias 'mm-special-display-p - (if (featurep 'emacs) - 'special-display-p - (lambda (buffer-name) - "Returns non-nil if a buffer named BUFFER-NAME gets a special frame." - (and special-display-function - (or (and (member buffer-name special-display-buffer-names) t) - (cdr (assoc buffer-name special-display-buffer-names)) - (catch 'return - (dolist (elem special-display-regexps) - (and (stringp elem) - (string-match elem buffer-name) - (throw 'return t)) - (and (consp elem) - (stringp (car elem)) - (string-match (car elem) buffer-name) - (throw 'return (cdr elem)))))))))) - -;; `decode-coding-string', `encode-coding-string', `decode-coding-region' -;; and `encode-coding-region' are available in Emacs and XEmacs built with -;; the `file-coding' feature, but the XEmacs versions treat nil, that is -;; given as the `coding-system' argument, as the `binary' coding system. -(eval-and-compile - (if (featurep 'xemacs) - (if (featurep 'file-coding) - (progn - (defun mm-decode-coding-string (str coding-system) - (if coding-system - (decode-coding-string str coding-system) - str)) - (defun mm-encode-coding-string (str coding-system) - (if coding-system - (encode-coding-string str coding-system) - str)) - (defun mm-decode-coding-region (start end coding-system) - (if coding-system - (decode-coding-region start end coding-system))) - (defun mm-encode-coding-region (start end coding-system) - (if coding-system - (encode-coding-region start end coding-system)))) - (defun mm-decode-coding-string (str coding-system) str) - (defun mm-encode-coding-string (str coding-system) str) - (defalias 'mm-decode-coding-region 'ignore) - (defalias 'mm-encode-coding-region 'ignore)) - (defalias 'mm-decode-coding-string 'decode-coding-string) - (defalias 'mm-encode-coding-string 'encode-coding-string) - (defalias 'mm-decode-coding-region 'decode-coding-region) - (defalias 'mm-encode-coding-region 'encode-coding-region))) - -;; `string-to-multibyte' is available only in Emacs. -(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) - 'identity - 'string-to-multibyte)) - -;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. -(eval-and-compile - (defalias 'mm-char-or-char-int-p - (cond - ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) - (t 'identity)))) - -;; `ucs-to-char' is a function that Mule-UCS provides. -(eval-and-compile - (if (featurep 'xemacs) - (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. - (subrp (symbol-function 'unicode-to-char))) - (if (featurep 'mule) - (defalias 'mm-ucs-to-char 'unicode-to-char) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (unicode-to-char codepoint) ?#)))) - ((featurep 'mule) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. - (progn - (defalias 'mm-ucs-to-char - (lambda (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (ucs-to-char codepoint) ?#) - (error ?#)))) - (mm-ucs-to-char codepoint)) - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (t - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (if (let ((char (make-char 'japanese-jisx0208 36 34))) - (eq char (decode-char 'ucs char))) - ;; Emacs 23. - (defalias 'mm-ucs-to-char 'identity) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#))))) - -;; Fixme: This seems always to be used to read a MIME charset, so it -;; should be re-named and fixed (in Emacs) to offer completion only on -;; proper charset names (base coding systems which have a -;; mime-charset defined). XEmacs doesn't believe in mime-charset; -;; test with -;; `(or (coding-system-get 'iso-8859-1 'mime-charset) -;; (coding-system-get 'iso-8859-1 :mime-charset))' -;; Actually, there should be an `mm-coding-system-mime-charset'. -(eval-and-compile - (defalias 'mm-read-coding-system - (if (featurep 'emacs) 'read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist)))))))) +(defvar mm-mime-mule-charset-alist) + +(defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (decode-char 'ucs codepoint) ?#)) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () "Get the coding system list." (or mm-coding-system-list - (setq mm-coding-system-list (mm-coding-system-list)))) + (setq mm-coding-system-list (coding-system-list)))) (defun mm-coding-system-p (cs) - "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object. -If CS is available, return CS itself in Emacs, and return a coding -system object in XEmacs." - (if (fboundp 'find-coding-system) - (and cs (find-coding-system cs)) - (if (fboundp 'coding-system-p) - (when (coding-system-p cs) - cs) - ;; no-MULE XEmacs: - (car (memq cs (mm-get-coding-system-list)))))) + "Return CS if CS is a coding system." + (and (coding-system-p cs) + cs)) (defvar mm-charset-synonym-alist `( @@ -343,170 +88,17 @@ system object in XEmacs." (mm-coding-system-p 'iso-8859-1)) '((iso_8859-1 . iso-8859-1))) ) - "A mapping from unknown or invalid charset names to the real charset names. - -See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.") - -(defun mm-codepage-setup (number &optional alias) - "Create a coding system cpNUMBER. -The coding system is created using `codepage-setup'. If ALIAS is -non-nil, an alias is created and added to -`mm-charset-synonym-alist'. If ALIAS is a string, it's used as -the alias. Else windows-NUMBER is used." - (interactive - (let ((completion-ignore-case t) - (candidates (if (fboundp 'cp-supported-codepages) - (cp-supported-codepages) - ;; Removed in Emacs 23 (unicode), so signal an error: - (error "`codepage-setup' not present in this Emacs version")))) - (list (gnus-completing-read "Setup DOS Codepage" candidates - t nil nil "437")))) - (when alias - (setq alias (if (stringp alias) - (intern alias) - (intern (format "windows-%s" number))))) - (let* ((cp (intern (format "cp%s" number)))) - (unless (mm-coding-system-p cp) - (if (fboundp 'codepage-setup) ; silence compiler - (codepage-setup number) - (error "`codepage-setup' not present in this Emacs version"))) - (when (and alias - ;; Don't add alias if setup of cp failed. - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) - -(defcustom mm-codepage-iso-8859-list - (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft - ;; Outlook users in Czech republic. Use this to allow reading of - ;; their e-mails. - '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West - ;; Europe). See also `gnus-article-dumbquotes-map'. - '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish). - '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew). - "A list of Windows codepage numbers and iso-8859 charset numbers. - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-iso-8859'. An element may also be a -cons cell where the car is a codepage number and the cdr is the -corresponding number of an iso-8859 charset." - :type '(list (set :inline t - (const 1250 :tag "Central and East European") - (const (1252 . 1) :tag "West European") - (const (1254 . 9) :tag "Turkish") - (const (1255 . 8) :tag "Hebrew")) - (repeat :inline t - :tag "Other options" - (choice - (integer :tag "Windows codepage number") - (cons (integer :tag "Windows codepage number") - (integer :tag "iso-8859 charset number"))))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defcustom mm-codepage-ibm-list - (list 437 ;; (US etc.) - 860 ;; (Portugal) - 861 ;; (Iceland) - 862 ;; (Israel) - 863 ;; (Canadian French) - 865 ;; (Nordic) - 852 ;; - 850 ;; (Latin 1) - 855 ;; (Cyrillic) - 866 ;; (Cyrillic - Russian) - 857 ;; (Turkish) - 864 ;; (Arabic) - 869 ;; (Greek) - 874);; (Thai) - ;; In Emacs 23 (unicode), cp... and ibm... are aliases. - ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de - "List of IBM codepage numbers. - -The codepage mappings slightly differ between IBM and other vendors. -See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\". - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-ibm'." - :type '(list (set :inline t - (const 437 :tag "US etc.") - (const 860 :tag "Portugal") - (const 861 :tag "Iceland") - (const 862 :tag "Israel") - (const 863 :tag "Canadian French") - (const 865 :tag "Nordic") - (const 852) - (const 850 :tag "Latin 1") - (const 855 :tag "Cyrillic") - (const 866 :tag "Cyrillic - Russian") - (const 857 :tag "Turkish") - (const 864 :tag "Arabic") - (const 869 :tag "Greek") - (const 874 :tag "Thai")) - (repeat :inline t - :tag "Other options" - (integer :tag "Codepage number"))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defun mm-setup-codepage-iso-8859 (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-iso-8859-list' is used." - (unless list - (setq list mm-codepage-iso-8859-list)) - (dolist (i list) - (let (cp windows iso) - (if (consp i) - (setq cp (intern (format "cp%d" (car i))) - windows (intern (format "windows-%d" (car i))) - iso (intern (format "iso-8859-%d" (cdr i)))) - (setq cp (intern (format "cp%d" i)) - windows (intern (format "windows-%d" i)))) - (unless (mm-coding-system-p windows) - (if (mm-coding-system-p cp) - (add-to-list 'mm-charset-synonym-alist (cons windows cp)) - (add-to-list 'mm-charset-synonym-alist (cons windows iso))))))) - -(defun mm-setup-codepage-ibm (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-ibm-list' is used." - (unless list - (setq list mm-codepage-ibm-list)) - (dolist (number list) - (let ((ibm (intern (format "ibm%d" number))) - (cp (intern (format "cp%d" number)))) - (when (and (not (mm-coding-system-p ibm)) - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons ibm cp)))))) - -;; Initialize: -(mm-setup-codepage-iso-8859) -(mm-setup-codepage-ibm) + "A mapping from unknown or invalid charset names to the real charset names.") ;; Note: this has to be defined before `mm-charset-to-coding-system'. -(defcustom mm-charset-eval-alist - (if (featurep 'xemacs) - nil ;; I don't know what would be useful for XEmacs. - '(;; Emacs 22 provides autoloads for 1250-1258 - ;; (i.e. `mm-codepage-setup' does nothing). - (windows-1250 . (mm-codepage-setup 1250 t)) - (windows-1251 . (mm-codepage-setup 1251 t)) - (windows-1253 . (mm-codepage-setup 1253 t)) - (windows-1257 . (mm-codepage-setup 1257 t)))) +(defcustom mm-charset-eval-alist nil "An alist of (CHARSET . FORM) pairs. If an article is encoded in an unknown CHARSET, FORM is evaluated. This allows the loading of additional libraries providing charsets on demand. If supported by your Emacs version, you could use `autoload-coding-system' here." :version "22.1" ;; Gnus 5.10.9 - :type '(list (set :inline t - (const (windows-1250 . (mm-codepage-setup 1250 t))) - (const (windows-1251 . (mm-codepage-setup 1251 t))) - (const (windows-1253 . (mm-codepage-setup 1253 t))) - (const (windows-1257 . (mm-codepage-setup 1257 t))) - (const (cp850 . (mm-codepage-setup 850 nil)))) - (repeat :inline t + :type '(list (repeat :inline t :tag "Other options" (cons (symbol :tag "charset") (symbol :tag "form")))) @@ -706,7 +298,7 @@ superset of iso-8859-1." ;; Fixme: some of the cars here aren't valid MIME charsets. That ;; should only matter with XEmacs, though. (defvar mm-mime-mule-charset-alist - `((us-ascii ascii) + '((us-ascii ascii) (iso-8859-1 latin-iso8859-1) (iso-8859-2 latin-iso8859-2) (iso-8859-3 latin-iso8859-3) @@ -756,56 +348,24 @@ superset of iso-8859-1." (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 japanese-jisx0213-1 japanese-jisx0213-2) (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - ,(cond ((fboundp 'unicode-precedence-list) - (cons 'utf-8 (delq 'ascii (mapcar 'charset-name - (unicode-precedence-list))))) - ((or (not (fboundp 'charsetp)) ;; non-Mule case - (charsetp 'unicode-a) - (not (mm-coding-system-p 'mule-utf-8))) - '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) - (t ;; If we have utf-8 we're in Mule 5+. - (append '(utf-8) - (delete 'ascii - (coding-system-get 'mule-utf-8 'safe-charsets)))))) + (utf-8)) "Alist of MIME-charset/MULE-charsets.") -(defun mm-enrich-utf-8-by-mule-ucs () - "Make the `utf-8' MIME charset usable by the Mule-UCS package. -This function will run when the `un-define' module is loaded under -XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' -with Mule charsets. It is completely useless for Emacs." - (when (boundp 'unicode-basic-translation-charset-order-list) - (condition-case nil - (let ((val (delq - 'ascii - (copy-sequence - (symbol-value - 'unicode-basic-translation-charset-order-list)))) - (elem (assq 'utf-8 mm-mime-mule-charset-alist))) - (if elem - (setcdr elem val) - (setq mm-mime-mule-charset-alist - (nconc mm-mime-mule-charset-alist - (list (cons 'utf-8 val)))))) - (error)))) - ;; Correct by construction, but should be unnecessary for Emacs: -(if (featurep 'xemacs) - (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) - (when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset); Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) - (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) - (not (assq mime alist))) - (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist))))) +(when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist)))) (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. @@ -838,16 +398,11 @@ Valid elements include: "A table of the difference character between ISO-8859-X and ISO-8859-15.") (defcustom mm-coding-system-priorities - (let ((lang (if (boundp 'current-language-environment) - (symbol-value 'current-language-environment)))) - (cond (;; XEmacs without Mule but with `file-coding'. - (not lang) nil) - ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)". - ((string-match "\\`Japanese" lang) - ;; Japanese users prefer iso-2022-jp to others usually used - ;; for `buffer-file-coding-system', however iso-8859-1 should - ;; be used when there are only ASCII and Latin-1 characters. - '(iso-8859-1 iso-2022-jp utf-8)))) + (and (string-match "\\`Japanese" current-language-environment) + ;; Japanese users prefer iso-2022-jp to others usually used + ;; for `buffer-file-coding-system', however iso-8859-1 should + ;; be used when there are only ASCII and Latin-1 characters. + '(iso-8859-1 iso-2022-jp utf-8)) "Preferred coding systems for encoding outgoing messages. More than one suitable coding system may be found for some text. @@ -859,14 +414,13 @@ variable is set, it overrides the default priority." :group 'mime) ;; ?? -(defvar mm-use-find-coding-systems-region - (fboundp 'find-coding-systems-region) +(defvar mm-use-find-coding-systems-region t "Use `find-coding-systems-region' to find proper coding systems. 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)))) @@ -879,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: @@ -887,45 +443,26 @@ like \"€\" to the euro sign, mainly in html messages.") (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." - (if (and (fboundp 'find-coding-systems-for-charsets) - (fboundp 'sort-coding-systems)) - (let ((css (sort (sort-coding-systems - (find-coding-systems-for-charsets (list charset))) - 'mm-sort-coding-systems-predicate)) - cs mime) - (while (and (not mime) - css) - (when (setq cs (pop css)) - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset))))) - mime) - (let ((alist (mapcar (lambda (cs) - (assq cs mm-mime-mule-charset-alist)) - (sort (mapcar 'car mm-mime-mule-charset-alist) - 'mm-sort-coding-systems-predicate))) - out) - (while alist - (when (memq charset (cdar alist)) - (setq out (caar alist) - alist nil)) - (pop alist)) - out))) - -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-enable-multibyte 'ignore) - (defun mm-enable-multibyte () - "Set the multibyte flag of the current buffer. + (let ((css (sort (sort-coding-systems + (find-coding-systems-for-charsets (list charset))) + 'mm-sort-coding-systems-predicate)) + cs mime) + (while (and (not mime) + css) + (when (setq cs (pop css)) + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset))))) + mime)) + +(defun mm-enable-multibyte () + "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is -non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte 'to))) +non-nil." + (set-buffer-multibyte 'to)) - (if (featurep 'xemacs) - (defalias 'mm-disable-multibyte 'ignore) - (defun mm-disable-multibyte () - "Unset the multibyte flag of in the current buffer. -This is a no-op in XEmacs." - (set-buffer-multibyte nil)))) +(defun mm-disable-multibyte () + "Unset the multibyte flag of in the current buffer." + (set-buffer-multibyte nil)) (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. @@ -939,8 +476,7 @@ This is a no-op in XEmacs." mail-parse-mule-charset ;; cached mule-charset (progn (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last + (and (car (last (assq 'charset (assoc current-language-environment language-info-alist)))))) @@ -956,94 +492,53 @@ This is a no-op in XEmacs." (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. If POS is nil, it defaults to the current point. -If POS is out of range, the value is nil. -If the charset is `composition', return the actual one." +If POS is out of range, the value is nil." (let ((char (char-after pos)) charset) - (if (< (mm-char-int char) 128) + (if (< char 128) (setq charset 'ascii) - ;; charset-after is fake in some Emacsen. - (setq charset (and (fboundp 'char-charset) (char-charset char))) - (if (eq charset 'composition) ; Mule 4 - (let ((p (or pos (point)))) - (cadr (find-charset-region p (1+ p)))) - (if (and charset (not (memq charset '(ascii eight-bit-control - eight-bit-graphic)))) - charset - (mm-guess-charset)))))) + (setq charset (char-charset char)) + (if (and charset (not (memq charset '(ascii eight-bit-control + eight-bit-graphic)))) + charset + (mm-guess-charset))))) (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the given Mule CHARSET." - (if (eq charset 'unknown) - (error "The message contains non-printable characters, please use attachment")) - (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) - (or - (and (mm-preferred-coding-system charset) - (or (coding-system-get - (mm-preferred-coding-system charset) :mime-charset) - (coding-system-get - (mm-preferred-coding-system charset) 'mime-charset))) - (and (eq charset 'ascii) - 'us-ascii) - (mm-preferred-coding-system charset) - (mm-mule-charset-to-mime-charset charset)) - ;; This is for XEmacs. - (mm-mule-charset-to-mime-charset charset))) - -;; `delete-dups' is not available in XEmacs 21.4. -(if (fboundp 'delete-dups) - (defalias 'mm-delete-duplicates 'delete-dups) - (defun mm-delete-duplicates (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) + (when (eq charset 'unknown) + (error "The message contains non-printable characters, please use attachment")) + (or + (and (mm-preferred-coding-system charset) + (coding-system-get (mm-preferred-coding-system charset) 'mime-charset)) + (and (eq charset 'ascii) + 'us-ascii) + (mm-preferred-coding-system charset) + (mm-mule-charset-to-mime-charset charset))) ;; Fixme: This is used in places when it should be testing the -;; default multibyteness. See mm-default-multibyte-p. -(eval-and-compile - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defun mm-multibyte-p () - "Non-nil if multibyte is enabled in the current buffer." - enable-multibyte-characters) - (defun mm-multibyte-p () (featurep 'mule)))) - -(defun mm-default-multibyte-p () - "Return non-nil if the session is multibyte. -This affects whether coding conversion should be attempted generally." - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (default-value 'enable-multibyte-characters) - t))) +;; default multibyteness. +(defun mm-multibyte-p () + "Non-nil if multibyte is enabled in the current buffer." + enable-multibyte-characters) (defun mm-iso-8859-x-to-15-region (&optional b e) - (if (fboundp 'char-charset) - (let (charset item c inconvertible) - (save-restriction - (if e (narrow-to-region b e)) - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (while (not (eobp)) - (cond - ((not (setq item (assq (char-charset (setq c (char-after))) - mm-iso-8859-x-to-15-table))) - (forward-char)) - ((memq c (cdr (cdr item))) - (setq inconvertible t) - (forward-char)) - (t - (insert-before-markers (prog1 (+ c (car (cdr item))) - (delete-char 1))))) - (skip-chars-forward "\0-\177"))) - (not inconvertible)))) + (let (charset item c inconvertible) + (save-restriction + (if e (narrow-to-region b e)) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (while (not (eobp)) + (cond + ((not (setq item (assq (char-charset (setq c (char-after))) + mm-iso-8859-x-to-15-table))) + (forward-char)) + ((memq c (cdr (cdr item))) + (setq inconvertible t) + (forward-char)) + (t + (insert-before-markers (prog1 (+ c (car (cdr item))) + (delete-char 1))))) + (skip-chars-forward "\0-\177"))) + (not inconvertible))) (defun mm-sort-coding-systems-predicate (a b) (let ((priorities @@ -1058,85 +553,6 @@ This affects whether coding conversion should be attempted generally." (length (memq (coding-system-base b) priorities))) t)))) -(declare-function latin-unity-massage-name "ext:latin-unity") -(declare-function latin-unity-maybe-remap "ext:latin-unity") -(declare-function latin-unity-representations-feasible-region "ext:latin-unity") -(declare-function latin-unity-representations-present-region "ext:latin-unity") - -(defvar latin-unity-coding-systems) -(defvar latin-unity-ucs-list) - -(defun mm-xemacs-find-mime-charset-1 (begin end) - "Determine which MIME charset to use to send region as message. -This uses the XEmacs-specific latin-unity package to better handle the -case where identical characters from diverse ISO-8859-? character sets -can be encoded using a single one of the corresponding coding systems. - -It treats `mm-coding-system-priorities' as the list of preferred -coding systems; a useful example setting for this list in Western -Europe would be (iso-8859-1 iso-8859-15 utf-8), which would default -to the very standard Latin 1 coding system, and only move to coding -systems that are less supported as is necessary to encode the -characters that exist in the buffer. - -Latin Unity doesn't know about those non-ASCII Roman characters that -are available in various East Asian character sets. As such, its -behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a -buffer and it can otherwise be encoded as Latin 1, won't be ideal. -But this is very much a corner case, so don't worry about it." - (let ((systems mm-coding-system-priorities) csets psets curset) - - ;; Load the Latin Unity library, if available. - (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (require 'latin-unity)) - - ;; Now, can we use it? - (if (featurep 'latin-unity) - (progn - (setq csets (latin-unity-representations-feasible-region begin end) - psets (latin-unity-representations-present-region begin end)) - - (catch 'done - - ;; Pass back the first coding system in the preferred list - ;; that can encode the whole region. - (dolist (curset systems) - (setq curset (latin-unity-massage-name 'buffer-default curset)) - - ;; If the coding system is a universal coding system, then - ;; it can certainly encode all the characters in the region. - (if (memq curset latin-unity-ucs-list) - (throw 'done (list curset))) - - ;; If a coding system isn't universal, and isn't in - ;; the list that latin unity knows about, we can't - ;; decide whether to use it here. Leave that until later - ;; in `mm-find-mime-charset-region' function, whence we - ;; have been called. - (unless (memq curset latin-unity-coding-systems) - (throw 'done nil)) - - ;; Right, we know about this coding system, and it may - ;; conceivably be able to encode all the characters in - ;; the region. - (if (latin-unity-maybe-remap begin end curset csets psets t) - (throw 'done (list curset)))) - - ;; Can't encode using anything from the - ;; `mm-coding-system-priorities' list. - ;; Leave `mm-find-mime-charset' to do most of the work. - nil)) - - ;; Right, latin unity isn't available; let `mm-find-charset-region' - ;; take its default action, which equally applies to GNU Emacs. - nil))) - -(defmacro mm-xemacs-find-mime-charset (begin end) - (when (featurep 'xemacs) - `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end)))) - -(declare-function mm-delete-duplicates "mm-util" (list)) - (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. nil means ASCII, a single-element list represents an appropriate MIME @@ -1178,16 +594,9 @@ charset, and a longer list means no appropriate charset." (setq systems nil charsets (list cs)))))) charsets)) - ;; If we're XEmacs, and some coding system is appropriate, - ;; mm-xemacs-find-mime-charset will return an appropriate list. - ;; Otherwise, we'll get nil, and the next setq will get invoked. - (setq charsets (mm-xemacs-find-mime-charset b e)) - - ;; Fixme: won't work for unibyte Emacs 23: - ;; We're not multibyte, or a single coding system won't cover it. (setq charsets - (mm-delete-duplicates + (delete-dups (mapcar 'mm-mime-charset (delq 'ascii (mm-find-charset-region b e)))))) @@ -1200,17 +609,6 @@ charset, and a longer list means no appropriate charset." (if (and (memq 'iso-2022-jp-2 charsets) (memq 'iso-2022-jp-2 hack-charsets)) (setq charsets (delq 'iso-2022-jp charsets))) - ;; Attempt to reduce the number of charsets if utf-8 is available. - (if (and (featurep 'xemacs) - (> (length charsets) 1) - (mm-coding-system-p 'utf-8)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e))))))) charsets)) (defmacro mm-with-unibyte-buffer (&rest forms) @@ -1233,7 +631,6 @@ Use multibyte mode for this." (defmacro mm-with-unibyte-current-buffer (&rest forms) "Evaluate FORMS with current buffer temporarily made unibyte. -Equivalent to `progn' in XEmacs. Note: We recommend not using this macro any more; there should be better ways to do a similar thing. The previous version of this macro @@ -1241,31 +638,27 @@ bound the default value of `enable-multibyte-characters' to nil while evaluating FORMS but it is no longer done. So, some programs assuming it if any may malfunction." (declare (obsolete nil "25.1") (indent 0) (debug t)) - (if (featurep 'xemacs) - `(progn ,@forms) - (let ((multibyte (make-symbol "multibyte"))) - `(let ((,multibyte enable-multibyte-characters)) + (let ((multibyte (make-symbol "multibyte"))) + `(let ((,multibyte enable-multibyte-characters)) + (when ,multibyte + (set-buffer-multibyte nil)) + (prog1 + (progn ,@forms) (when ,multibyte - (set-buffer-multibyte nil)) - (prog1 - (progn ,@forms) - (when ,multibyte - (set-buffer-multibyte t))))))) + (set-buffer-multibyte t)))))) (defun mm-find-charset-region (b e) "Return a list of Emacs charsets in the region B to E." (cond - ((and (mm-multibyte-p) - (fboundp 'find-charset-region)) + ((mm-multibyte-p) ;; Remove composition since the base charsets have been included. ;; Remove eight-bit-*, treat them as ascii. (let ((css (find-charset-region b e))) - (dolist (cs - '(composition eight-bit-control eight-bit-graphic control-1) - css) - (setq css (delq cs css))))) + (dolist (cs '(composition eight-bit-control eight-bit-graphic control-1)) + (setq css (delq cs css))) + css)) (t - ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. + ;; We are in a unibyte buffer, so we futz around a bit. (save-excursion (save-restriction (narrow-to-region b e) @@ -1274,11 +667,9 @@ it if any may malfunction." (if (eobp) '(ascii) (let (charset) - (setq charset - (and (boundp 'current-language-environment) - (car (last (assq 'charset - (assoc current-language-environment - language-info-alist)))))) + (setq charset (car (last (assq 'charset + (assoc current-language-environment + language-info-alist))))) (if (eq charset 'ascii) (setq charset nil)) (or charset (setq charset @@ -1305,9 +696,9 @@ it if any may malfunction." "Like `insert-file-contents', but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, -`find-file-hooks', etc. +`find-file-hook', etc. If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. - This function ensures that none of these modifications will take place." +This function ensures that none of these modifications will take place." (letf* ((format-alist nil) (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) ((default-value 'major-mode) 'fundamental-mode) @@ -1322,14 +713,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers)) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) - (set ffh nil) - (unwind-protect - (insert-file-contents filename visit beg end replace) - (set ffh val)))) + (find-file-hook nil)) + (insert-file-contents filename visit beg end replace))) (defun mm-append-to-file (start end filename &optional codesys inhibit) "Append the contents of the region to the end of file FILENAME. @@ -1371,70 +756,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) -(autoload 'gmm-write-region "gmm-utils") - -;; It is not a MIME function, but some MIME functions use it. -(if (and (fboundp 'make-temp-file) - (ignore-errors - (let ((def (if (fboundp 'compiled-function-arglist) ;; XEmacs - (eval (list 'compiled-function-arglist - (symbol-function 'make-temp-file))) - (require 'help-fns) - (help-function-arglist 'make-temp-file t)))) - (and (>= (length def) 4) - (eq (nth 3 def) 'suffix))))) - (defalias 'mm-make-temp-file 'make-temp-file) - ;; Stolen (and modified for XEmacs) from Emacs 22. - (defun mm-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 -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes 448) - (while (condition-case err - (progn - (setq file - (make-temp-name - (expand-file-name - prefix - (if (fboundp 'temp-directory) - ;; XEmacs - (temp-directory) - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - ;; NOTE: This is unsafe if Emacs 20 - ;; users and XEmacs users don't use - ;; a secure temp directory. - (gmm-write-region "" nil file nil 'silent - nil 'excl)) - nil) - (file-already-exists t) - ;; The XEmacs version of `make-directory' issues - ;; `file-error'. - (file-error (or (and (featurep 'xemacs) - (file-exists-p file)) - (signal (car err) (cdr err))))) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask))))) +(defalias 'mm-make-temp-file 'make-temp-file) +(define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "26.1") (defvar mm-image-load-path-cache nil) @@ -1455,54 +778,23 @@ If SUFFIX is non-nil, add that at the end of the file name." result))) ;; Fixme: This doesn't look useful where it's used. -(if (fboundp 'detect-coding-region) - (defun mm-detect-coding-region (start end) - "Like `detect-coding-region' except returning the best one." - (let ((coding-systems - (detect-coding-region start end))) - (or (car-safe coding-systems) - coding-systems))) - (defun mm-detect-coding-region (start end) - (let ((point (point))) - (goto-char start) - (skip-chars-forward "\0-\177" end) - (prog1 - (if (eq (point) end) 'ascii (mm-guess-charset)) - (goto-char point))))) +(defun mm-detect-coding-region (start end) + "Like `detect-coding-region' except returning the best one." + (let ((coding-systems (detect-coding-region start end))) + (or (car-safe coding-systems) + coding-systems))) (declare-function mm-detect-coding-region "mm-util" (start end)) -(if (fboundp 'coding-system-get) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - cs))) - -(eval-when-compile - (unless (fboundp 'coding-system-to-mime-charset) - (defalias 'coding-system-to-mime-charset 'ignore))) +(defun mm-detect-mime-charset-region (start end) + "Detect MIME charset of the text in the region between START and END." + (let ((cs (mm-detect-coding-region start end))) + (coding-system-get cs 'mime-charset))) (defun mm-coding-system-to-mime-charset (coding-system) - "Return the MIME charset corresponding to CODING-SYSTEM. -To make this function work with XEmacs, the APEL package is required." - (when coding-system - (or (and (fboundp 'coding-system-get) - (or (coding-system-get coding-system :mime-charset) - (coding-system-get coding-system 'mime-charset))) - (and (featurep 'xemacs) - (or (and (fboundp 'coding-system-to-mime-charset) - (not (eq (symbol-function 'coding-system-to-mime-charset) - 'ignore))) - (and (condition-case nil - (require 'mcharset) - (error nil)) - (fboundp 'coding-system-to-mime-charset))) - (coding-system-to-mime-charset coding-system))))) + "Return the MIME charset corresponding to CODING-SYSTEM." + (and coding-system + (coding-system-get coding-system 'mime-charset))) (defvar jka-compr-acceptable-retval-list) (declare-function jka-compr-make-temp-name "jka-compr" (&optional local)) @@ -1571,14 +863,6 @@ decompressed data. The buffer's multibyteness must be turned off." (message "%s" (or err-msg (concat msg "done"))) retval))))) -(eval-when-compile - (unless (fboundp 'coding-system-name) - (defalias 'coding-system-name 'ignore)) - (unless (fboundp 'find-file-coding-system-for-read-from-filename) - (defalias 'find-file-coding-system-for-read-from-filename 'ignore)) - (unless (fboundp 'find-operation-coding-system) - (defalias 'find-operation-coding-system 'ignore))) - (defun mm-find-buffer-file-coding-system (&optional filename) "Find coding system used to decode the contents of the current buffer. This function looks for the coding system magic cookie or examines the @@ -1601,66 +885,16 @@ gzip, bzip2, etc. are allowed." (setq filename (file-name-sans-extension filename))) (goto-char (point-min)) (unwind-protect - (cond - ((boundp 'set-auto-coding-function) ;; Emacs - (if filename - (or (funcall (symbol-value 'set-auto-coding-function) - filename (- (point-max) (point-min))) - (car (find-operation-coding-system 'insert-file-contents - filename))) - (let (auto-coding-alist) - (condition-case nil - (funcall (symbol-value 'set-auto-coding-function) - nil (- (point-max) (point-min))) - (error nil))))) - ((and (featurep 'xemacs) (featurep 'file-coding)) ;; XEmacs - (let ((case-fold-search t) - (end (point-at-eol)) - codesys start) - (or - (and (re-search-forward "-\\*-+[\t ]*" end t) - (progn - (setq start (match-end 0)) - (re-search-forward "[\t ]*-+\\*-" end t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)") - (re-search-forward - "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)" - end t))) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:" - nil t) - (progn - (setq start (match-end 0)) - (re-search-forward "^[\t ]*;+[\t ]*End:" nil t)) - (progn - (setq end (match-beginning 0)) - (goto-char start) - (re-search-forward - "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)" - end t)) - (find-coding-system (setq codesys - (intern (match-string 1)))) - codesys) - (and (progn - (goto-char (point-min)) - (setq case-fold-search nil) - (re-search-forward "^;;;coding system: " - ;;(+ (point-min) 3000) t)) - nil t)) - (looking-at "[^\t\n\r ]+") - (find-coding-system - (setq codesys (intern (match-string 0)))) - codesys) - (and filename - (setq codesys - (find-file-coding-system-for-read-from-filename - filename)) - (coding-system-name (coding-system-base codesys))))))) + (if filename + (or (funcall (symbol-value 'set-auto-coding-function) + filename (- (point-max) (point-min))) + (car (find-operation-coding-system 'insert-file-contents + filename))) + (let (auto-coding-alist) + (condition-case nil + (funcall (symbol-value 'set-auto-coding-function) + nil (- (point-max) (point-min))) + (error nil)))) (when decomp (kill-buffer (current-buffer))))))) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 4197b2aa54a..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) @@ -249,14 +249,7 @@ To disable dissecting shar codes, for instance, add (defsubst mm-uu-function-2 (entry) (nth 5 entry)) -;; In Emacs 22, we could use `min-colors' in the face definition. But Emacs -;; 21 and XEmacs don't support it. -(defcustom mm-uu-hide-markers - (< 16 (or (and (fboundp 'defined-colors) - (length (defined-colors))) - (and (fboundp 'device-color-cells) - (device-color-cells)) - 0)) +(defcustom mm-uu-hide-markers (< 16 (length (defined-colors))) "If non-nil, hide verbatim markers. The value should be nil on displays where the face `mm-uu-extract' isn't distinguishable to the face `default'." @@ -297,12 +290,8 @@ If PROPERTIES is non-nil, PROPERTIES are applied to the buffer, see `set-text-properties'. If PROPERTIES equals t, this means to apply the face `mm-uu-extract'." (let ((obuf (current-buffer)) - (multi (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (coding-system - ;; Might not exist in non-MULE XEmacs - (when (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) + (multi enable-multibyte-characters) + (coding-system buffer-file-coding-system)) (with-current-buffer (generate-new-buffer " *mm-uu*") (if multi (mm-enable-multibyte) (mm-disable-multibyte)) (setq buffer-file-coding-system coding-system) @@ -322,13 +311,13 @@ apply the face `mm-uu-extract'." (interactive) (if symbol (set-default symbol value)) (setq mm-uu-beginning-regexp nil) - (mapcar (lambda (entry) - (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) + (mapcar (lambda (mm-uu-entry) + (if (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled) nil (setq mm-uu-beginning-regexp (concat mm-uu-beginning-regexp (if mm-uu-beginning-regexp "\\|") - (mm-uu-beginning-regexp entry))))) + (mm-uu-beginning-regexp mm-uu-entry))))) mm-uu-type-alist)) (mm-uu-configure) @@ -336,7 +325,7 @@ apply the face `mm-uu-extract'." (defvar file-name) (defvar start-point) (defvar end-point) -(defvar entry) +(defvar mm-uu-entry) (defun mm-uu-uu-filename () (if (looking-at ".+") @@ -523,7 +512,7 @@ apply the face `mm-uu-extract'." (when (and mml2015-use (null (mml2015-clear-verify-function))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (gnus-format-message + (format-message "Clear verification not supported by `%s'.\n" mml2015-use))) (mml2015-extract-cleartext-signature)) (list (mm-make-handle buf mm-uu-text-plain-type))))) @@ -587,11 +576,11 @@ apply the face `mm-uu-extract'." (not (eq charset 'ascii))) ;; Assume that buffer's multibyteness is turned off. ;; See `mml2015-pgg-clear-decrypt'. - (insert (mm-decode-coding-string (prog1 - (buffer-string) - (erase-buffer) - (mm-enable-multibyte)) - charset)) + (insert (decode-coding-string (prog1 + (buffer-string) + (erase-buffer) + (mm-enable-multibyte)) + charset)) (mm-enable-multibyte)) (list (mm-make-handle buf mm-uu-text-plain-type))) (list (mm-make-handle buf '("application/pgp-encrypted"))))))) @@ -612,10 +601,10 @@ apply the face `mm-uu-extract'." (defun mm-uu-gpg-key-skip-to-last () (let ((point (point)) - (end-regexp (mm-uu-end-regexp entry)) - (beginning-regexp (mm-uu-beginning-regexp entry))) + (end-regexp (mm-uu-end-regexp mm-uu-entry)) + (beginning-regexp (mm-uu-beginning-regexp mm-uu-entry))) (when (and end-regexp - (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))) + (not (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled))) (while (re-search-forward end-regexp nil t) (skip-chars-forward " \t\n\r") (if (looking-at beginning-regexp) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 8e1e3e782cf..e934f8b2841 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -31,7 +31,6 @@ (require 'mml-smime) (autoload 'gnus-completing-read "gnus-util") -(autoload 'gnus-window-inside-pixel-edges "gnus-ems") (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") @@ -80,7 +79,7 @@ (autoload 'gnus-rescale-image "gnus-util") -(defun mm-inline-image-emacs (handle) +(defun mm-inline-image (handle) (let ((b (point-marker)) (inhibit-read-only t)) (put-image @@ -88,7 +87,7 @@ (if (eq mm-inline-large-images 'resize) (gnus-rescale-image image - (let ((edges (gnus-window-inside-pixel-edges + (let ((edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))) (cons (truncate (* mm-inline-large-images-proportion (- (nth 2 edges) (nth 0 edges)))) @@ -105,27 +104,6 @@ (remove-images b b) (delete-region b (1+ b))))))) -(defun mm-inline-image-xemacs (handle) - (when (featurep 'xemacs) - (insert "\n") - (forward-char -1) - (let ((annot (make-annotation (mm-get-image handle) nil 'text)) - (inhibit-read-only t)) - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((b ,(point-marker)) - (inhibit-read-only t)) - (delete-annotation ,annot) - (delete-region (1- b) b)))) - (set-extent-property annot 'mm t) - (set-extent-property annot 'duplicable t)))) - -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-inline-image 'mm-inline-image-xemacs) - (defalias 'mm-inline-image 'mm-inline-image-emacs))) - (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -220,18 +198,19 @@ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) '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." (cond ((eq mm-w3m-standalone-supports-m17n-p t) t) ((eq mm-w3m-standalone-supports-m17n-p nil) nil) - ((not (featurep 'mule)) (setq mm-w3m-standalone-supports-m17n-p nil)) ((condition-case nil (let ((coding-system-for-write 'iso-2022-jp) (coding-system-for-read 'iso-2022-jp) - (str (mm-decode-coding-string "\ + (str (decode-coding-string "\ \e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp))) (mm-with-multibyte-buffer (insert str) @@ -283,7 +262,7 @@ (delete-region (match-beginning 0) (match-end 0)))) (defun mm-inline-wash-with-file (post-func cmd &rest args) - (let ((file (mm-make-temp-file + (let ((file (make-temp-file (expand-file-name "mm" mm-tmp-directory)))) (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) file nil 'silent)) @@ -463,11 +442,6 @@ handle `(lambda () (let ((inhibit-read-only t)) - (if (fboundp 'remove-specifier) - ;; This is only valid on XEmacs. - (dolist (prop '(background background-pixmap foreground)) - (remove-specifier - (face-property 'default prop) (current-buffer)))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) ;; Shut up byte-compiler. @@ -486,18 +460,14 @@ If MODE is not set, try to find mode automatically." (unless charset (setq coding-system (mm-find-buffer-file-coding-system))) (setq text (buffer-string)))) - ;; XEmacs @#$@ version of font-lock refuses to fully turn itself - ;; on for buffers whose name begins with " ". That's why we use - ;; `with-current-buffer'/`generate-new-buffer' rather than - ;; `with-temp-buffer'. - (with-current-buffer (generate-new-buffer "*fontification*") + (with-temp-buffer (buffer-disable-undo) (mm-enable-multibyte) (insert (cond ((eq charset 'gnus-decoded) (with-current-buffer (mm-handle-buffer handle) (buffer-string))) (coding-system - (mm-decode-coding-string text coding-system)) + (decode-coding-string text coding-system)) (charset (mm-decode-string text charset)) (t @@ -524,28 +494,16 @@ If MODE is not set, try to find mode automatically." ;; Do not fontify if the guess mode is fundamental. (unless (or font-lock-mode (eq major-mode 'fundamental-mode)) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (font-lock-fontify-buffer))))) - ;; By default, XEmacs font-lock uses non-duplicable text - ;; properties. This code forces all the text properties - ;; to be copied along with the text. - (when (featurep 'xemacs) - (map-extents (lambda (ext ignored) - (set-extent-property ext 'duplicable t) - nil) - nil nil nil nil nil 'text-prop)) + (font-lock-ensure)))) (setq text (buffer-string)) ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) + (set-buffer-modified-p nil)) (mm-insert-inline handle text))) ;; Shouldn't these functions check whether the user even wants to use -;; font-lock? At least under XEmacs, this fontification is pretty -;; much unconditional. Also, it would be nice to change for the size -;; of the fontified region. +;; font-lock? Also, it would be nice to change for the size of the +;; fontified region. (defun mm-display-patch-inline (handle) (mm-display-inline-fontify handle 'diff-mode)) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 254c427299e..0e2d4381993 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -27,6 +27,7 @@ (require 'gnus-util) (require 'epg) +(require 'epa) (require 'password-cache) (require 'mm-encode) @@ -46,6 +47,8 @@ (autoload 'mml-smime-verify "mml-smime") (autoload 'mml-smime-verify-test "mml-smime") (autoload 'epa--select-keys "epa") +(autoload 'message-options-get "message") +(autoload 'message-options-set "message") (declare-function message-options-set "message" (symbol value)) @@ -555,7 +558,7 @@ Return keys." (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage)) (curr-fprs (cdr (assoc name (cdr usage-prefs)))) (key-fprs (mapcar 'mml-secure-fingerprint keys)) - (new-fprs (gnus-union curr-fprs key-fprs :test 'equal))) + (new-fprs (cl-union curr-fprs key-fprs :test 'equal))) (if curr-fprs (setcdr (assoc name (cdr usage-prefs)) new-fprs) (setcdr usage-prefs (cons (cons name new-fprs) (cdr usage-prefs)))) @@ -623,7 +626,7 @@ Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead." The passphrase is read and cached." ;; Based on mml2015-epg-passphrase-callback. (if (eq key-id 'SYM) - (epg-passphrase-callback-function context key-id nil) + (epa-passphrase-callback-function context key-id nil) (let* ((password-cache-key-id (if (eq key-id 'PIN) "PIN" @@ -702,9 +705,9 @@ be present in the keyring." ;; In contrast, signing requires secret key. (mml-secure-secret-key-exists-p context subkey)) (or (not fingerprint) - (gnus-string-match-p (concat fingerprint "$") fpr) - (gnus-string-match-p (concat fingerprint "$") - (epg-sub-key-fingerprint subkey)))) + (string-match-p (concat fingerprint "$") fpr) + (string-match-p (concat fingerprint "$") + (epg-sub-key-fingerprint subkey)))) (throw 'break t))))))) (defun mml-secure-find-usable-keys (context name usage &optional justone) @@ -907,10 +910,10 @@ If no one is selected, symmetric encryption will be performed. " cipher signers) (when sign (setq signers (mml-secure-signers context signer-names)) - (epg-context-set-signers context signers)) + (setf (epg-context-signers context) signers)) (when (eq 'OpenPGP protocol) - (epg-context-set-armor context t) - (epg-context-set-textmode context t)) + (setf (epg-context-armor context) t) + (setf (epg-context-textmode context) t)) (when (mml-secure-cache-passphrase-p protocol) (epg-context-set-passphrase-callback context @@ -935,9 +938,9 @@ If no one is selected, symmetric encryption will be performed. " (signers (mml-secure-signers context signer-names)) signature micalg) (when (eq 'OpenPGP protocol) - (epg-context-set-armor context t) - (epg-context-set-textmode context t)) - (epg-context-set-signers context signers) + (setf (epg-context-armor context) t) + (setf (epg-context-textmode context) t)) + (setf (epg-context-signers context) signers) (when (mml-secure-cache-passphrase-p protocol) (epg-context-set-passphrase-callback context @@ -947,8 +950,9 @@ If no one is selected, symmetric encryption will be performed. " (if (eq 'OpenPGP protocol) (epg-sign-string context (buffer-string) mode) (epg-sign-string context - (mm-replace-in-string (buffer-string) - "\n" "\r\n") t)) + (replace-regexp-in-string + "\n" "\r\n" (buffer-string)) + t)) mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 502c65b2463..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))) @@ -149,8 +149,7 @@ Whether the passphrase is cached at all is controlled by (if (not (and (not (file-exists-p tmp)) (get-buffer tmp))) (push tmp certfiles) - (setq file (mm-make-temp-file (expand-file-name "mml." - mm-tmp-directory))) + (setq file (make-temp-file (expand-file-name "mml." mm-tmp-directory))) (with-current-buffer tmp (write-region (point-min) (point-max) file)) (push file certfiles) @@ -176,15 +175,12 @@ Whether the passphrase is cached at all is controlled by (list 'keyfile (if (= (length smime-keys) 1) (cadar smime-keys) - (or (let ((from (cadr (funcall (if (boundp - 'gnus-extract-address-components) - gnus-extract-address-components - 'mail-extract-address-components) - (or (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "from"))) - ""))))) + (or (let ((from (cadr (mail-extract-address-components + (or (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "from"))) + ""))))) (and from (smime-get-key-by-email from))) (smime-get-key-by-email (gnus-completing-read "Sign this part with what signature" @@ -205,18 +201,15 @@ Whether the passphrase is cached at all is controlled by (while (not result) (setq who (read-from-minibuffer (format "%sLookup certificate for: " (or bad "")) - (cadr (funcall (if (boundp - 'gnus-extract-address-components) - gnus-extract-address-components - 'mail-extract-address-components) - (or (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "to"))) - ""))))) + (cadr (mail-extract-address-components + (or (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "to"))) + ""))))) (if (setq cert (smime-cert-by-dns who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (gnus-format-message "`%s' not found. " who)))) + (setq bad (format-message "`%s' not found. " who)))) (quit)) result)) @@ -235,7 +228,7 @@ Whether the passphrase is cached at all is controlled by ""))))) (if (setq cert (smime-cert-by-ldap who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (gnus-format-message "`%s' not found. " who)))) + (setq bad (format-message "`%s' not found. " who)))) (quit)) result)) @@ -421,7 +414,7 @@ Content-Disposition: attachment; filename=smime.p7m (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (mm-replace-in-string part "\n" "\r\n") + (setq part (replace-regexp-in-string "\n" "\r\n" part) context (epg-make-context 'CMS)) (condition-case error (setq plain (epg-verify-string context (mm-get-part signature) part)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index c767ceb9061..6105f79ae23 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -29,13 +29,9 @@ (require 'mml-sec) (eval-when-compile (require 'cl)) (eval-when-compile (require 'url)) -(eval-when-compile - (when (featurep 'xemacs) - (require 'easy-mmode))) ; for `define-minor-mode' (autoload 'message-make-message-id "message") (declare-function gnus-setup-posting-charset "gnus-msg" (group)) -(autoload 'gnus-make-local-hook "gnus-util") (autoload 'gnus-completing-read "gnus-util") (autoload 'message-fetch-field "message") (autoload 'message-mark-active-p "message") @@ -50,7 +46,6 @@ (autoload 'message-mail-p "message") (defvar gnus-article-mime-handles) -(defvar gnus-mouse-2) (defvar gnus-newsrc-hashtb) (defvar message-default-charset) (defvar message-deletable-headers) @@ -63,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")) @@ -71,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")) @@ -153,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))) @@ -418,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)) @@ -440,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) @@ -519,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) @@ -532,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)))) @@ -636,6 +674,7 @@ be \"related\" or \"alternate\"." (let ((mm-coding-system-priorities (cons 'utf-8 mm-coding-system-priorities))) (setq charset (mm-encode-body)))) + (mm-disable-multibyte) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) @@ -645,7 +684,7 @@ be \"related\" or \"alternate\"." (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) - (insert (mm-string-as-unibyte + (insert (string-as-unibyte (with-current-buffer (cdr (assq 'buffer cont)) (buffer-string))))) ((and filename @@ -658,9 +697,7 @@ be \"related\" or \"alternate\"." filename))))) (t (let ((contents (cdr (assq 'contents cont)))) - (if (if (featurep 'xemacs) - (string-match "[^\000-\377]" contents) - (mm-multibyte-string-p contents)) + (if (multibyte-string-p contents) (progn (mm-enable-multibyte) (insert contents) @@ -670,7 +707,7 @@ be \"related\" or \"alternate\"." (if (setq encoding (cdr (assq 'encoding cont))) (setq encoding (intern (downcase encoding)))) (setq encoding (mm-encode-buffer type encoding) - coded (mm-string-as-multibyte (buffer-string)))) + coded (string-as-multibyte (buffer-string)))) (mml-insert-mime-headers cont type charset encoding nil) (insert "\n" coded)))) ((eq (car cont) 'external) @@ -1109,57 +1146,42 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (easy-menu-define mml-menu mml-mode-map "" `("Attachments" - ["Attach File..." mml-attach-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a file at point"))] + ["Attach File..." mml-attach-file :help "Attach a file at point"] ["Attach Buffer..." mml-attach-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a buffer to the outgoing message"))] + :help "Attach a buffer to the outgoing message"] ["Attach External..." mml-attach-external - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach reference to an external file"))] + :help "Attach reference to an external file"] ;; FIXME: Is it possible to do this without using ;; `gnus-gcc-externalize-attachments'? ["Externalize Attachments" (lambda () (interactive) - (if (not (and (boundp 'gnus-gcc-externalize-attachments) - (memq gnus-gcc-externalize-attachments - '(all t nil)))) - ;; Stupid workaround for XEmacs not honoring :visible. - (message "Can't handle this value of `gnus-gcc-externalize-attachments'") - (setq gnus-gcc-externalize-attachments - (not gnus-gcc-externalize-attachments)) - (message "gnus-gcc-externalize-attachments is `%s'." - gnus-gcc-externalize-attachments))) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'gnus-gcc-externalize-attachments) - (memq gnus-gcc-externalize-attachments - '(all t nil))))) + (setq gnus-gcc-externalize-attachments + (not gnus-gcc-externalize-attachments)) + (message "gnus-gcc-externalize-attachments is `%s'." + gnus-gcc-externalize-attachments)) + :visible (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil))) :style toggle :selected gnus-gcc-externalize-attachments - ,@(if (featurep 'xemacs) nil - '(:help "Save attachments as external parts in Gcc copies"))] + :help "Save attachments as external parts in Gcc copies"] "----" ;; ("Change Security Method" ["PGP/MIME" (lambda () (interactive) (setq mml-secure-method "pgpmime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to PGP/MIME")) + :help "Set Security Method to PGP/MIME" :style radio :selected (equal mml-secure-method "pgpmime") ] ["S/MIME" (lambda () (interactive) (setq mml-secure-method "smime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to S/MIME")) + :help "Set Security Method to S/MIME" :style radio :selected (equal mml-secure-method "smime") ] ["Inline PGP" (lambda () (interactive) (setq mml-secure-method "pgp")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to inline PGP")) + :help "Set Security Method to inline PGP" :style radio :selected (equal mml-secure-method "pgp") ] ) ;; @@ -1167,8 +1189,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Encrypt Message" mml-secure-message-encrypt t] ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t] ["Encrypt/Sign off" mml-unsecure-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Don't Encrypt/Sign Message"))] + :help "Don't Encrypt/Sign Message"] ;; Do we have separate encrypt and encrypt/sign commands for parts? ["Sign Part" mml-secure-sign t] ["Encrypt Part" mml-secure-encrypt t] @@ -1183,26 +1204,18 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;;["Narrow" mml-narrow-to-part t] ["Quote MML in region" mml-quote-region :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Quote MML tags in region"))] + :help "Quote MML tags in region"] ["Validate MML" mml-validate t] ["Preview" mml-preview t] "----" ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Emacs MIME manual"))] + :help "Display the Emacs MIME manual"] ["PGG manual" (lambda () (interactive) (message-info mml2015-use)) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)))) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the PGG manual"))] + :visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg)) + :help "Display the PGG manual"] ["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use)) - ;; XEmacs barfs on :visible. - ,@(if (featurep 'xemacs) nil - '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)))) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the EasyPG manual"))])) + :visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg)) + :help "Display the EasyPG manual"])) (define-minor-mode mml-mode "Minor mode for editing MML. @@ -1379,7 +1392,7 @@ body) or \"attachment\" (separate from the body)." 'type type ;; icicles redefines read-file-name and returns a ;; string w/ text properties :-/ - 'filename (mm-substring-no-properties file) + 'filename (substring-no-properties file) 'disposition (or disposition "attachment") 'description description) ;; When using Mail mode, make sure it does the mime encoding @@ -1575,12 +1588,11 @@ or the `pop-to-buffer' function." (message-sort-headers) (mml-to-mime)) (if raw - (when (fboundp 'set-buffer-multibyte) - (let ((s (buffer-string))) - ;; Insert the content into unibyte buffer. - (erase-buffer) - (mm-disable-multibyte) - (insert s))) + (let ((s (buffer-string))) + ;; Insert the content into unibyte buffer. + (erase-buffer) + (mm-disable-multibyte) + (insert s)) (let ((gnus-newsgroup-charset (car message-posting-charset)) gnus-article-prepare-hook gnus-original-article-buffer gnus-displaying-mime) @@ -1591,7 +1603,6 @@ or the `pop-to-buffer' function." (gnus-article-prepare-display)))) ;; Disable article-mode-map. (use-local-map nil) - (gnus-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook (lambda () (mm-destroy-parts gnus-article-mime-handles)) nil t) @@ -1602,14 +1613,14 @@ or the `pop-to-buffer' function." (lambda () (interactive) (widget-button-press (point)))) - (local-set-key gnus-mouse-2 + (local-set-key [mouse-2] (lambda (event) (interactive "@e") (widget-button-press (widget-event-point event) event))) ;; FIXME: Buffer is in article mode, but most tool bar commands won't ;; work. Maybe only keep the following icons: search, print, quit (goto-char (point-min)))) - (if (and (not (mm-special-display-p (buffer-name mml-preview-buffer))) + (if (and (not (special-display-p (buffer-name mml-preview-buffer))) (boundp 'gnus-buffer-configuration) (assq 'mml-preview gnus-buffer-configuration)) (let ((gnus-message-buffer (current-buffer))) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 568dc564d91..f98984c1cdf 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -195,17 +195,20 @@ Whether the passphrase is cached at all is controlled by (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n") + (buffer-string))) t)) (defun mml1991-pgg-encrypt (cont &optional sign) @@ -275,17 +278,20 @@ Whether the passphrase is cached at all is controlled by (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear)) (signature (car pair))) (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert signature) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (insert signature) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n") + (buffer-string))) t))) (defun mml1991-epg-encrypt (cont &optional sign) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 61ca53624d3..774821320f1 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -32,6 +32,7 @@ (require 'mm-util) (require 'mml) (require 'mml-sec) +(require 'epg-config) (defvar mc-pgp-always-sign) @@ -42,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'.") @@ -482,14 +463,17 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mm-with-unibyte-current-buffer - (mc-encrypt-generic - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (mc-cleanup-recipient-headers - (read-string "Recipients: ")))) - nil nil nil - (message-options-get 'message-sender)))) + (insert + (with-temp-buffer + (set-buffer-multibyte nil) + (mc-encrypt-generic + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (mc-cleanup-recipient-headers + (read-string "Recipients: ")))) + nil nil nil + (message-options-get 'message-sender)) + (buffer-string)))) (goto-char (point-min)) (unless (looking-at "-----BEGIN PGP MESSAGE-----") (error "Fail to encrypt the message")) @@ -614,7 +598,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (insert "\r")) (forward-line) (end-of-line)) - (with-temp-file (setq signature-file (mm-make-temp-file "pgg")) + (with-temp-file (setq signature-file (make-temp-file "pgg")) (mm-insert-part signature)) (if (condition-case err (prog1 @@ -655,7 +639,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (if (condition-case err (prog1 (mm-with-unibyte-buffer - (insert (mm-encode-coding-string text coding-system)) + (insert (encode-coding-string text coding-system)) (pgg-verify-region (point-min) (point-max) nil t)) (goto-char (point-min)) (while (search-forward "\r\n" nil t) @@ -775,12 +759,10 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa") -(autoload 'gnus-create-image "gnus-ems") - (defun mml2015-epg-key-image (key-id) "Return the image of a key, if any" (with-temp-buffer - (mm-set-buffer-multibyte nil) + (set-buffer-multibyte nil) (let* ((coding-system-for-write 'binary) (coding-system-for-read 'binary) (data (shell-command-to-string @@ -920,7 +902,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (mm-replace-in-string part "\n" "\r\n") + (setq part (replace-regexp-in-string "\n" "\r\n" part) signature (mm-get-part signature) context (epg-make-context)) (condition-case error @@ -943,8 +925,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-clear-verify () (let ((inhibit-redisplay t) (context (epg-make-context)) - (signature (mm-encode-coding-string (buffer-string) - coding-system-for-write)) + (signature (encode-coding-string (buffer-string) + coding-system-for-write)) plain) (condition-case error (setq plain (epg-verify-string context signature)) @@ -963,7 +945,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))) (delete-region (point-min) (point-max)) - (insert (mm-decode-coding-string plain coding-system-for-read))) + (insert (decode-coding-string plain coding-system-for-read))) (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 9245396149a..dbdbbadea87 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -88,16 +88,6 @@ (require 'gnus-start) (require 'gnus-sum) -;; Compatibility Functions ================================================= - -(eval-and-compile - (if (fboundp 'signal-error) - (defun nndiary-error (&rest args) - (apply #'signal-error 'nndiary args)) - (defun nndiary-error (&rest args) - (apply #'error args)))) - - ;; Back End behavior customization =========================================== (defgroup nndiary nil @@ -107,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." @@ -116,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." @@ -128,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 @@ -174,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) @@ -182,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) @@ -190,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) @@ -198,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) @@ -1157,12 +1147,12 @@ all. This may very well take some time.") ;; within the specified bounds. ;; Signals are caught by `nndiary-schedule'. (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str)) - (nndiary-error "not an integer value") + (error "Not an integer value") ;; else (let ((val (string-to-number str))) (and (or (< val min) (and max (> val max))) - (nndiary-error "value out of range")) + (error "Value out of range")) val))) (defun nndiary-parse-schedule-value (str min-or-values max) @@ -1179,7 +1169,7 @@ all. This may very well take some time.") (match-string 1 str)))) (if (and val (setq val (assoc val min-or-values))) (list (cadr val)) - (nndiary-error "invalid syntax"))) + (error "Invalid syntax"))) ;; min-or-values is min (mapcar (lambda (val) @@ -1199,7 +1189,7 @@ all. This may very well take some time.") (t (cons end beg))))) (t - (nndiary-error "invalid syntax"))) + (error "Invalid syntax"))) )) (split-string str ","))) )) @@ -1214,7 +1204,7 @@ all. This may very well take some time.") (let ((header (format "^X-Diary-%s: \\(.*\\)$" head))) (goto-char (point-min)) (if (not (re-search-forward header nil t)) - (nndiary-error "header missing") + (error "Header missing") ;; else (nndiary-parse-schedule-value (match-string 1) min-or-values max)) )) @@ -1288,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/nndoc.el b/lisp/gnus/nndoc.el index f8fefeb4ae1..09260cf33d1 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -761,7 +761,7 @@ from the document.") (looking-at "JMF")) (defun nndoc-oe-dbx-type-p () - (looking-at (mm-string-to-multibyte "\317\255\022\376"))) + (looking-at (string-to-multibyte "\317\255\022\376"))) (defun nndoc-read-little-endian () (+ (prog1 (char-after) (forward-char 1)) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 5f57dd2bf7c..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 @@ -203,12 +205,7 @@ are generated if and only if they are also in `message-draft-headers'.") (setq buffer-file-name (expand-file-name file) buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) - (let ((hook (if (boundp 'write-contents-functions) - 'write-contents-functions - 'write-contents-hooks))) - (gnus-make-local-hook hook) - (add-hook hook 'nndraft-generate-headers nil t)) - (gnus-make-local-hook 'after-save-hook) + (add-hook 'write-contents-functions 'nndraft-generate-headers nil t) (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t) (message-add-action '(nndraft-update-unread-articles) 'exit 'postpone 'kill) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index e60a4920626..28561c05946 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -284,7 +284,7 @@ included.") (defun nneething-encode-file-name (file &optional coding-system) "Encode the name of the FILE in CODING-SYSTEM." (let ((pos 0) buf) - (setq file (mm-encode-coding-string + (setq file (encode-coding-string file (or coding-system nnmail-pathname-coding-system))) (while (string-match "[^-0-9a-zA-Z_:/.]" file pos) (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) @@ -300,7 +300,7 @@ included.") (setq buf (cons (string (string-to-number (match-string 1 file) 16)) (cons (substring file pos (match-beginning 0)) buf)) pos (match-end 0))) - (mm-decode-coding-string + (decode-coding-string (apply (function concat) (nreverse (cons (substring file pos) buf))) (or coding-system nnmail-pathname-coding-system)))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index ee60e3e18f2..402ffba8c6e 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -884,9 +884,7 @@ deleted. Point is left where the deleted region was." (active (or (cadr (assoc group nnfolder-group-alist)) (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) - (minid (or (and (boundp 'most-positive-fixnum) - most-positive-fixnum) - (lsh -1 -1))) + (minid most-positive-fixnum) maxid start end newscantime novbuf articles newnum buffer-read-only) @@ -1061,7 +1059,7 @@ This command does not work if you use short group names." (defun nnfolder-group-pathname (group) "Make file name for GROUP." (setq group - (mm-encode-coding-string group nnmail-pathname-coding-system)) + (encode-coding-string group nnmail-pathname-coding-system)) (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. (if (or nnmail-use-long-file-names diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index cd43016014e..6782229ad24 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -40,6 +40,7 @@ (require 'mail-utils) (require 'mm-util) (require 'gnus-util) +(require 'subr-x) (autoload 'gnus-range-add "gnus-range") (autoload 'gnus-remove-from-range "gnus-range") ;; FIXME none of these are used explicitly in this file. @@ -62,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" @@ -98,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" @@ -110,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") @@ -621,8 +631,8 @@ the line could be found." (< beg nnheader-max-head-length)))) ;; Finally decode the contents. (when (mm-coding-system-p nnheader-file-coding-system) - (mm-decode-coding-region start (point-max) - nnheader-file-coding-system)))) + (decode-coding-region start (point-max) + nnheader-file-coding-system)))) t)) (defun nnheader-article-p () @@ -726,9 +736,7 @@ the line could be found." (string-match nnheader-numerical-short-files file) (string-to-number (match-string 0 file)))) -(defvar nnheader-directory-files-is-safe - (or (eq system-type 'windows-nt) - (not (featurep 'xemacs))) +(defvar nnheader-directory-files-is-safe (not (eq system-type 'windows-nt)) "If non-nil, Gnus believes `directory-files' is safe. It has been reported numerous times that `directory-files' fails with an alarming frequency on NFS mounted file systems. If it is nil, @@ -780,28 +788,8 @@ If FULL, translate everything." 2 0)) ;; We translate -- but only the file name. We leave the directory ;; alone. - (if (and (featurep 'xemacs) - (memq system-type '(windows-nt cygwin))) - ;; This is needed on NT and stuff, because - ;; file-name-nondirectory is not enough to split - ;; file names, containing ':', e.g. - ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE" - ;; - ;; we are trying to correctly split such names: - ;; "d:file.name" -> "a:" "file.name" - ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc" - ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc" - ;; etc. - ;; to translate then only the file name part. - (progn - (setq leaf file - path "") - (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file) - (setq leaf (substring file (match-beginning 2)) - path (substring file 0 (match-beginning 2))))) - ;; Emacs DTRT, says andrewi. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file)))) + (setq leaf (file-name-nondirectory file) + path (file-name-directory file))) (setq len (length leaf)) (while (< i len) (when (setq trans (cdr (assq (aref leaf i) @@ -842,7 +830,7 @@ without formatting." t)) (defsubst nnheader-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) + (subst-char-in-string from to string)) (defun nnheader-replace-duplicate-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." @@ -886,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." @@ -898,7 +888,7 @@ without formatting." (if (file-directory-p (concat dir group)) (expand-file-name group dir) ;; If not, we translate dots into slashes. - (expand-file-name (mm-encode-coding-string + (expand-file-name (encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) dir)))) @@ -1002,14 +992,8 @@ See `find-file-noselect' for the arguments." (enable-local-eval nil) (coding-system-for-read nnheader-file-coding-system) (version-control 'never) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) - (set ffh nil) - (unwind-protect - (apply 'find-file-noselect args) - (set ffh val)))) + (find-file-hook nil)) + (apply 'find-file-noselect args))) (defun nnheader-directory-regular-files (dir) "Return a list of all regular files in DIR." @@ -1098,16 +1082,14 @@ See `find-file-noselect' for the arguments." (defmacro nnheader-insert-buffer-substring (buffer &optional start end) "Copy string from unibyte buffer to multibyte current buffer." - (if (featurep 'xemacs) - `(insert-buffer-substring ,buffer ,start ,end) - `(if enable-multibyte-characters - (insert (with-current-buffer ,buffer - (mm-string-to-multibyte - ,(if (or start end) - `(buffer-substring (or ,start (point-min)) - (or ,end (point-max))) - '(buffer-string))))) - (insert-buffer-substring ,buffer ,start ,end)))) + `(if enable-multibyte-characters + (insert (with-current-buffer ,buffer + (string-to-multibyte + ,(if (or start end) + `(buffer-substring (or ,start (point-min)) + (or ,end (point-max))) + '(buffer-string))))) + (insert-buffer-substring ,buffer ,start ,end))) (defvar nnheader-last-message-time '(0 0)) (defun nnheader-message-maybe (&rest args) @@ -1116,9 +1098,6 @@ See `find-file-noselect' for the arguments." (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) -(when (featurep 'xemacs) - (require 'nnheaderxm)) - (run-hooks 'nnheader-load-hook) (provide 'nnheader) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c285befc760..2e2ec59aa5d 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -26,13 +26,6 @@ ;;; Code: -(eval-and-compile - (require 'nnheader) - ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for - ;; `make-network-stream'. - (unless (fboundp 'open-protocol-stream) - (require 'proto-stream))) - (eval-when-compile (require 'cl)) @@ -164,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) @@ -234,7 +228,7 @@ textual parts.") (delete-region (+ (match-beginning 0) 2) (point)) (setq string (buffer-substring (point) (+ (point) size))) (delete-region (point) (+ (point) size)) - (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))) + (insert (format "%S" (subst-char-in-string ?\n ?\s string)))) (beginning-of-line) (setq article (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position) @@ -365,7 +359,7 @@ textual parts.") (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) - (> (gnus-float-time + (> (float-time (time-subtract now (nnimap-last-command-time nnimap-object))) @@ -424,7 +418,7 @@ textual parts.") (when nnimap-server-port (push nnimap-server-port ports)) (let* ((stream-list - (open-protocol-stream + (open-network-stream "*nnimap*" (current-buffer) nnimap-address (nnimap-map-port (car ports)) :type nnimap-stream @@ -437,7 +431,7 @@ textual parts.") :success " OK " :starttls-function (lambda (capabilities) - (when (gnus-string-match-p "STARTTLS" capabilities) + (when (string-match-p "STARTTLS" capabilities) "1 STARTTLS\r\n")))) (stream (car stream-list)) (props (cdr stream-list)) @@ -447,9 +441,7 @@ textual parts.") (when (and stream (not (memq (process-status stream) '(open run)))) (setq stream nil)) - (when (and (fboundp 'set-network-process-option) ;; Not in XEmacs. - (fboundp 'process-type) ;; Emacs 22 doesn't provide it. - (eq (process-type stream) 'network)) + (when (eq (process-type stream) 'network) ;; Use TCP-keepalive so that connections that pass through a NAT ;; router don't hang when left idle. (set-network-process-option stream :keepalive t)) @@ -461,15 +453,15 @@ textual parts.") (nnheader-report 'nnimap "Unable to contact %s:%s via %s" nnimap-address (car ports) nnimap-stream) 'no-connect) - (gnus-set-process-query-on-exit-flag stream nil) - (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting)) + (set-process-query-on-exit-flag stream nil) + (if (not (string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting)) (nnheader-report 'nnimap "%s" greeting) ;; Store the greeting (for debugging purposes). (setf (nnimap-greeting nnimap-object) greeting) (setf (nnimap-capabilities nnimap-object) (mapcar #'upcase (split-string capabilities))) - (unless (gnus-string-match-p "[*.] PREAUTH" greeting) + (unless (string-match-p "[*.] PREAUTH" greeting) (if (not (setq credentials (if (eq nnimap-authenticator 'anonymous) (list "anonymous" @@ -922,7 +914,8 @@ textual parts.") t) (deffoo nnimap-request-move-article (article group server accept-form - &optional _last internal-move-group) + &optional _last + internal-move-group) (setq group (nnimap-decode-gnus-group group)) (when internal-move-group (setq internal-move-group (nnimap-decode-gnus-group internal-move-group))) @@ -932,17 +925,19 @@ textual parts.") 'nnimap-request-head 'nnimap-request-article) article group server (current-buffer)) - ;; If the move is internal (on the same server), just do it the easy - ;; way. + ;; If the move is internal (on the same server), just do it the + ;; easy way. (let ((message-id (message-field-value "message-id"))) (if internal-move-group (with-current-buffer (nnimap-buffer) - (let* ((can-move (nnimap-capability "MOVE")) - (command (if can-move - "UID MOVE %d %S" - "UID COPY %d %S")) - (result (nnimap-command command article - (utf7-encode internal-move-group t)))) + (let* ((can-move (and (nnimap-capability "MOVE") + (equal (nnimap-quirk "MOVE") "MOVE"))) + (command (if can-move + "UID MOVE %d %S" + "UID COPY %d %S")) + (result (nnimap-command + command article + (utf7-encode internal-move-group t)))) (when (and (car result) (not can-move)) (nnimap-delete-article article)) (cons internal-move-group @@ -951,11 +946,10 @@ textual parts.") internal-move-group server message-id nnimap-request-articles-find-limit))))) ;; Move the article to a different method. - (let ((result (eval accept-form))) - (when result - (nnimap-change-group group server) - (nnimap-delete-article article) - result))))))) + (when-let ((result (eval accept-form))) + (nnimap-change-group group server) + (nnimap-delete-article article) + result)))))) (deffoo nnimap-request-expire-articles (articles group &optional server force) (setq group (nnimap-decode-gnus-group group)) @@ -1003,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" @@ -1887,9 +1882,7 @@ Return the server's response to the SELECT or EXAMINE command." (let ((name "*imap log*")) (or (get-buffer name) (with-current-buffer (get-buffer-create name) - (when (boundp 'window-point-insertion-type) - (make-local-variable 'window-point-insertion-type) - (setq window-point-insertion-type t)) + (setq-local window-point-insertion-type t) (current-buffer))))) (defun nnimap-log-command (command) @@ -2076,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 560ba8ad2e5..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) @@ -928,9 +928,10 @@ ready to be added to the list of search results." ;; Set group to dirnam without any leading dots or slashes, ;; and with all subsequent slashes replaced by dots - (let ((group (gnus-replace-in-string - (gnus-replace-in-string dirnam "^[./\\]" "" t) - "[/\\]" "." t))) + (let ((group (replace-regexp-in-string + "[/\\]" "." + (replace-regexp-in-string "^[./\\]" "" dirnam nil t) + nil t))) (vector (gnus-group-full-name group server) (if (string-match "\\`nnmaildir:" (gnus-group-server server)) @@ -1340,9 +1341,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; eliminate all ".", "/", "\" from beginning. Always matches. (string-match "^[./\\]*\\(.*\\)$" dirnam) ;; "/" -> "." - (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" ".")) + (setq group (replace-regexp-in-string + "/" "." (match-string 1 dirnam))) ;; Windows "\\" -> "." - (setq group (gnus-replace-in-string group "\\\\" ".")) + (setq group (replace-regexp-in-string "\\\\" "." group)) (push (vector (gnus-group-full-name group server) (string-to-number artno) @@ -1414,7 +1416,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (when (string-match prefix dirnam) (setq dirnam (replace-match "" t t dirnam))) (push (vector (gnus-group-full-name - (gnus-replace-in-string dirnam "/" ".") server) + (replace-regexp-in-string "/" "." dirnam) server) (string-to-number artno) (string-to-number score)) artlist)) @@ -1612,9 +1614,9 @@ actually)." group (if (file-directory-p (setq group - (gnus-replace-in-string - group - "\\." "/" t))) + (replace-regexp-in-string + "\\." "/" + group nil t))) group)))))) (unless group (error "Cannot locate directory for group")) @@ -1667,7 +1669,7 @@ actually)." (server (cadr (gnus-server-to-method srv))) (groupspec (mapconcat (lambda (x) - (if (gnus-string-match-p "gmane" x) + (if (string-match-p "gmane" x) (format "group:%s" (gnus-group-short-name x)) (error "Can't search non-gmane groups: %s" x))) groups " ")) @@ -1688,8 +1690,8 @@ actually)." (mm-url-encode-www-form-urlencoded `(("query" . ,search) ("HITSPERPAGE" . "999"))))) - (unless (featurep 'xemacs) (set-buffer-multibyte t)) - (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (set-buffer-multibyte t) + (decode-coding-region (point-min) (point-max) 'utf-8) (goto-char (point-min)) (forward-line 1) (while (not (eobp)) @@ -1705,7 +1707,7 @@ actually)." (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (apply 'vector (nreverse (mm-delete-duplicates artlist))))) + (apply 'vector (nreverse (delete-dups artlist))))) ;;; Util Code: @@ -1787,7 +1789,7 @@ article came from is also searched." (list (list (gnus-method-to-server (gnus-find-method-for-group gnus-newsgroup-name))))) (registry-group (and - (gnus-bound-and-true-p 'gnus-registry-enabled) + (bound-and-true-p gnus-registry-enabled) (car (gnus-registry-get-id-key (mail-header-id header) 'group)))) (registry-server @@ -1814,18 +1816,19 @@ article came from is also searched." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (mm-string-as-unibyte + (push (string-as-unibyte (gnus-group-full-name (buffer-substring (point) (progn (skip-chars-forward "^ \t") - (point))) method)) + (point))) + method)) groups)) (forward-line)) (while (not (eobp)) (ignore-errors - (push (mm-string-as-unibyte + (push (string-as-unibyte (if (eq (char-after) ?\") (gnus-group-full-name (read cur) method) (let ((p (point)) (name "")) @@ -1859,7 +1862,7 @@ article came from is also searched." (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir) (setq gnus-summary-line-format (or nnir-summary-line-format gnus-summary-line-format)) - (when (gnus-bound-and-true-p 'gnus-registry-enabled) + (when (bound-and-true-p gnus-registry-enabled) (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 3d4178d1022..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,47 +355,20 @@ 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 :type '(choice (const :tag "infinite" nil) (number :tag "count"))) -(define-widget 'nnmail-lazy 'default - "Base widget for recursive data structures. - -This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." - :format "%{%t%}: %v" - :convert-widget 'widget-value-convert-widget - :value-create (lambda (widget) - (let ((value (widget-get widget :value)) - (type (widget-get widget :type))) - (widget-put widget :children - (list (widget-create-child-value - widget (widget-convert type) value))))) - :value-delete 'widget-children-value-delete - :value-get (lambda (widget) - (widget-value (car (widget-get widget :children)))) - :value-inline (lambda (widget) - (widget-apply (car (widget-get widget :children)) - :value-inline)) - :default-get (lambda (widget) - (widget-default-get - (widget-convert (widget-get widget :type)))) - :match (lambda (widget value) - (widget-apply (widget-convert (widget-get widget :type)) - :match value)) - :validate (lambda (widget) - (widget-apply (car (widget-get widget :children)) :validate))) - -(define-widget 'nnmail-split-fancy 'nnmail-lazy +(define-widget 'nnmail-split-fancy 'lazy "Widget for customizing splits in the variable of the same name." :tag "Split" :type '(menu-choice :value (any ".*value.*" "misc") @@ -516,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 @@ -536,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); @@ -628,15 +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 - ;; This causes Emacs 22.2 and 22.3 to issue a useless warning. - ;;(if (and (featurep 'xemacs) (featurep 'file-coding)) - (if (featurep 'xemacs) - (if (featurep 'file-coding) - ;; Work around a bug in many XEmacs 21.5 betas. - ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134 - (setq file-name-coding-system (coding-system-aliasee 'file-name)))) - "*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." @@ -697,15 +665,17 @@ nn*-request-list should have been called before calling this function." (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list (mm-string-as-unibyte group) (cons min max)) + (push (list (string-as-unibyte group) (cons min max)) group-assoc))) (error nil)) (widen) (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." @@ -1173,7 +1143,7 @@ FUNC will be called with the group name to determine the article number." 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info) (sit-for 1) '("bogus"))))) - (setq split (mm-delete-duplicates split)) + (setq split (delete-dups split)) ;; The article may be "cross-posted" to `junk'. What ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... @@ -1279,9 +1249,9 @@ Return the number of characters in the body." (insert (format "Xref: %s" (system-name))) (while group-alist (insert (if (mm-multibyte-p) - (mm-string-as-multibyte + (string-as-multibyte (format " %s:%d" (caar group-alist) (cdar group-alist))) - (mm-string-as-unibyte + (string-as-unibyte (format " %s:%d" (caar group-alist) (cdar group-alist))))) (setq group-alist (cdr group-alist))) (insert "\n"))) @@ -1402,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) '|) @@ -1957,10 +1927,8 @@ If TIME is nil, then return the cutoff time for oldness instead." ((and (equal header 'to-from) (or (string-match (cadr regexp-target-pair) from) (and (string-match (cadr regexp-target-pair) to) - (let* ((mail-dont-reply-to-names - (message-dont-reply-to-names)) - (rmail-dont-reply-to-names ; obsolete since 24.1 - mail-dont-reply-to-names)) + (let ((mail-dont-reply-to-names + (message-dont-reply-to-names))) (equal (if (fboundp 'rmail-dont-reply-to) (rmail-dont-reply-to from) (mail-dont-reply-to from)) ""))))) @@ -2054,13 +2022,13 @@ If TIME is nil, then return the cutoff time for oldness instead." (error "No current split history")) (with-output-to-temp-buffer "*nnmail split history*" (with-current-buffer standard-output - (fundamental-mode)) ; for Emacs 20.4+ - (dolist (elem nnmail-split-history) - (princ (mapconcat (lambda (ga) - (concat (car ga) ":" (int-to-string (cdr ga)))) - elem - ", ")) - (princ "\n")))) + (fundamental-mode)) + (dolist (elem nnmail-split-history) + (princ (mapconcat (lambda (ga) + (concat (car ga) ":" (int-to-string (cdr ga)))) + elem + ", ")) + (princ "\n")))) (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'." diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 3d8926b6925..03cb445675c 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -97,14 +97,14 @@ See `nnmaildir-flag-mark-mapping'." (defun nnmaildir--ensure-suffix (filename) "Ensure that FILENAME contains the suffix \":2,\"." - (if (gnus-string-match-p ":2," filename) + (if (string-match-p ":2," filename) filename (concat filename ":2,"))) (defun nnmaildir--add-flag (flag suffix) "Return a copy of SUFFIX where FLAG is set. SUFFIX should start with \":2,\"." - (unless (gnus-string-match-p "^:2," suffix) + (unless (string-match-p "^:2," suffix) (error "Invalid suffix `%s'" suffix)) (let* ((flags (substring suffix 3)) (flags-as-list (append flags nil)) @@ -117,7 +117,7 @@ SUFFIX should start with \":2,\"." (defun nnmaildir--remove-flag (flag suffix) "Return a copy of SUFFIX where FLAG is cleared. SUFFIX should start with \":2,\"." - (unless (gnus-string-match-p "^:2," suffix) + (unless (string-match-p "^:2," suffix) (error "Invalid suffix `%s'" suffix)) (let* ((flags (substring suffix 3)) (flags-as-list (append flags nil)) @@ -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)) @@ -537,8 +536,8 @@ by nnmaildir-request-article.") (prin1 (vector storage-version num msgid nov) (current-buffer)) (setq file (concat novfile ":")) (nnmaildir--unlink file) - (gmm-write-region (point-min) (point-max) file nil 'no-message nil - 'excl)) + (write-region (point-min) (point-max) file nil 'no-message nil + 'excl)) (rename-file file novfile 'replace) (setf (nnmaildir--art-msgid article) msgid) nov))) @@ -656,13 +655,13 @@ by nnmaildir-request-article.") (if (zerop n) 1 (1- (lsh 1 (1+ (logb n)))))) (defun nnmaildir--system-name () - (gnus-replace-in-string - (gnus-replace-in-string - (gnus-replace-in-string - (system-name) - "\\\\" "\\134" 'literal) - "/" "\\057" 'literal) - ":" "\\072" 'literal)) + (replace-regexp-in-string + ":" "\\072" + (replace-regexp-in-string + "/" "\\057" + (replace-regexp-in-string "\\\\" "\\134" (system-name) nil 'literal) + nil 'literal) + nil 'literal)) (defun nnmaildir-request-type (_group &optional _article) 'mail) @@ -848,11 +847,11 @@ by nnmaildir-request-article.") (when (or ;; first look for marks in suffix, if it's valid... (when (and (stringp suffix) - (gnus-string-prefix-p ":2," suffix)) + (string-prefix-p ":2," suffix)) (or - (not (gnus-string-match-p + (not (string-match-p (string (nnmaildir--mark-to-flag 'read)) suffix)) - (gnus-string-match-p + (string-match-p (string (nnmaildir--mark-to-flag 'tick)) suffix))) ;; then look in marks directories (not (file-exists-p (concat cdir prefix))) @@ -955,8 +954,9 @@ by nnmaildir-request-article.") pgname (nnmaildir--pgname nnmaildir--cur-server pgname) group (symbol-value group) ro (nnmaildir--param pgname 'read-only)) - (insert (gnus-replace-in-string - (nnmaildir--grp-name group) " " "\\ " t) + (insert (replace-regexp-in-string + " " "\\ " + (nnmaildir--grp-name group) nil t) " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) @@ -985,7 +985,7 @@ by nnmaildir-request-article.") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) (insert " " - (gnus-replace-in-string gname " " "\\ " t) + (replace-regexp-in-string " " "\\ " gname nil t) "\n"))))) 'group) @@ -1116,7 +1116,7 @@ by nnmaildir-request-article.") (insert " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) - (insert " " (gnus-replace-in-string gname " " "\\ " t) "\n") + (insert " " (replace-regexp-in-string " " "\\ " gname nil t) "\n") t)))) (defun nnmaildir-request-create-group (gname &optional server _args) @@ -1278,7 +1278,7 @@ by nnmaildir-request-article.") (insert "\t" (nnmaildir--nov-get-beg nov) "\t" (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " - (gnus-replace-in-string gname " " "\\ " t) ":") + (replace-regexp-in-string " " "\\ " gname nil t) ":") (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-end nov) "\n")))) (catch 'return @@ -1396,8 +1396,8 @@ by nnmaildir-request-article.") (concat "File exists: " tmpfile)) (throw 'return nil)) (with-current-buffer buffer - (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil - 'excl)) + (write-region (point-min) (point-max) tmpfile nil 'no-message nil + 'excl)) (unix-sync) ;; no fsync :( (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace) t))) @@ -1490,8 +1490,8 @@ by nnmaildir-request-article.") (throw 'return nil)))) (condition-case nil (add-name-to-file nnmaildir--file tmpfile) (error - (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil - 'excl) + (write-region (point-min) (point-max) tmpfile nil 'no-message nil + 'excl) (when (fboundp 'unix-sync) (unix-sync)))) ;; no fsync :( (nnheader-cancel-timer 24h) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index d5fa4fa74b4..128f912327c 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -147,11 +147,6 @@ ;;; === Keymaps -(eval-when-compile - (when (featurep 'xemacs) - ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. - (require 'edmacro))) - ;; Group mode (defun nnmairix-group-mode-hook () "Nnmairix group mode keymap." @@ -1635,7 +1630,7 @@ search in raw mode." (defun nnmairix-determine-original-group-from-registry (mid) "Try to determine original group for message-id MID from the registry." - (when (gnus-bound-and-true-p 'gnus-registry-enabled) + (when (bound-and-true-p gnus-registry-enabled) (unless (string-match "^<" mid) (set mid (concat "<" mid))) (unless (string-match ">$" mid) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index c60e84567f7..51048bb2998 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -242,8 +242,8 @@ as unread by Gnus.") (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? - (mm-encode-coding-string + (string-to-multibyte ;Why? Isn't it multibyte already? + (encode-coding-string (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 3350933f949..4976f25795e 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -128,13 +128,13 @@ non-nil.") "Return a decoded group name of GROUP on SERVER-OR-METHOD." (if nnmail-group-names-not-encoded-p group - (mm-decode-coding-string + (decode-coding-string group (nnml-group-name-charset group server-or-method)))) (defun nnml-encoded-group-name (group &optional server-or-method) "Return an encoded group name of GROUP on SERVER-OR-METHOD." - (mm-encode-coding-string + (encode-coding-string group (nnml-group-name-charset group server-or-method))) @@ -1077,8 +1077,7 @@ Use the nov database for the current group if available." ;; 1/ Move the article to a new file: (let* ((oldfile (nnml-article-to-file old-number)) (newfile - (gnus-replace-in-string - oldfile + (replace-regexp-in-string ;; nnml-use-compressed-files might be any string, but ;; probably it's sufficient to take into account only ;; "\\.[a-z0-9]+". Note that we can't only use the @@ -1087,7 +1086,8 @@ Use the nov database for the current group if available." ;; value. (concat "\\(" old-number-string "\\)\\(\\(\\.[a-z0-9]+\\)?\\)$") - (concat new-number-string "\\2")))) + (concat new-number-string "\\2") + oldfile))) (with-current-buffer nntp-server-buffer (nnmail-find-file oldfile) ;; Update the Xref header in the article itself: diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index c17a13c54c3..68dabcb142e 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -37,10 +37,11 @@ (require 'mm-url) (require 'rfc2047) (require 'mml) -(eval-when-compile - (ignore-errors - (require 'xml))) -(eval '(require 'xml)) +(require 'xml) + +(defgroup nnrss nil + "RSS access for Gnus." + :group 'gnus) (nnoo-declare nnrss) @@ -89,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) @@ -114,11 +117,11 @@ for decoding when the cdr that the data specify is not available.") ;;; Interface functions (defsubst nnrss-format-string (string) - (gnus-replace-in-string string " *\n *" " ")) + (replace-regexp-in-string " *\n *" " " string)) (defun nnrss-decode-group-name (group) (if (and group (mm-coding-system-p 'utf-8)) - (setq group (mm-decode-coding-string group 'utf-8)) + (setq group (decode-coding-string group 'utf-8)) group)) (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) @@ -243,7 +246,6 @@ for decoding when the cdr that the data specify is not available.") (max 1 (/ (* (window-width window) 7) 8)))) (fill-region (point) (point-max)) (goto-char (point-max)) - ;; XEmacs version of `fill-region' inserts newline. (unless (bolp) (insert "\n")))) (when (or link enclosure) @@ -295,7 +297,7 @@ for decoding when the cdr that the data specify is not available.") (let ((rfc2047-encoding-type 'mime) rfc2047-encode-max-chars) (rfc2047-encode-string - (gnus-replace-in-string group "[\t\n ]+" "_"))))) + (replace-regexp-in-string "[\t\n ]+" "_" group))))) (when nnrss-content-function (funcall nnrss-content-function e group article)))) (cond @@ -372,8 +374,6 @@ for decoding when the cdr that the data specify is not available.") (nnoo-define-skeleton nnrss) ;;; Internal functions -(eval-when-compile (defun xml-rpc-method-call (&rest args))) - (defun nnrss-get-encoding () "Return an encoding attribute specified in the current xml contents. If `nnrss-compatible-encoding-alist' specifies the compatible encoding, @@ -417,7 +417,7 @@ otherwise return nil." ;; Decode text according to the encoding attribute. (when (setq cs (nnrss-get-encoding)) (insert (prog1 - (mm-decode-coding-string (buffer-string) cs) + (decode-coding-string (buffer-string) cs) (erase-buffer) (mm-enable-multibyte)))) (goto-char (point-min)) @@ -588,12 +588,11 @@ which RSS 2.0 allows." "") (defun nnrss-insert (url) - (mm-with-unibyte-current-buffer - (condition-case err - (mm-url-insert url) - (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) - (message "nnrss: Failed to fetch %s" url)))))) + (condition-case err + (mm-url-insert url) + (error (if (or debug-on-quit debug-on-error) + (signal (car err) (cdr err)) + (message "nnrss: Failed to fetch %s" url))))) (defun nnrss-decode-entities-string (string) (if string @@ -763,7 +762,7 @@ Read the file and attempt to subscribe to each Feed in the file." Export subscriptions to a buffer in OPML Format." (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") - (mm-set-buffer-file-coding-system 'utf-8) + (set-buffer-file-coding-system 'utf-8) (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n" "<opml version=\"1.1\">\n" @@ -810,10 +809,11 @@ It is useful when `(setq nnrss-use-local t)'." (nnrss-node-just-text node) node)) (cleaned-text (if text - (gnus-replace-in-string - (gnus-replace-in-string - text "^[\000-\037\177]+\\|^ +\\| +$" "") - "\r\n" "\n")))) + (replace-regexp-in-string + "\r\n" "\n" + (replace-regexp-in-string + "^[\000-\037\177]+\\|^ +\\| +$" "" + text))))) (if (string-equal "" cleaned-text) nil cleaned-text))) @@ -959,6 +959,9 @@ Use Mark Pilgrim's `ultra-liberal rss locator'." ;; 4. check syndic8 (nnrss-find-rss-via-syndic8 url)))))))) +(declare-function xml-rpc-method-call "ext:xml-rpc" + (server-url method &rest params)) + (defun nnrss-find-rss-via-syndic8 (url) "Query syndic8 for the rss feeds it has for URL." (if (not (locate-library "xml-rpc")) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 620b8acae0b..9db68b15df2 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -306,7 +306,7 @@ there.") "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) ;; We require nnheader which requires gnus-util. - (let ((seconds (gnus-float-time (date-to-time date))) + (let ((seconds (float-time (date-to-time date))) groups) ;; Go through lines and add the latest groups to a list. (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") @@ -335,6 +335,7 @@ there.") (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) + (buf (current-buffer)) (proc (condition-case err (apply 'start-process "*nnspool inews*" inews-buffer @@ -346,7 +347,11 @@ there.") () (nnheader-report 'nnspool "") (set-process-sentinel proc 'nnspool-inews-sentinel) - (mm-with-unibyte-current-buffer + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring buf) + (encode-coding-region (point-min) (point-max) + nnspool-file-coding-system) (process-send-region proc (point-min) (point-max))) ;; We slap a condition-case around this, because the process may ;; have exited already... diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index f56b04568c8..38e7c6ecbbe 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -25,12 +25,6 @@ ;;; Code: -(eval-and-compile - ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for - ;; `make-network-stream'. - (unless (fboundp 'open-protocol-stream) - (require 'proto-stream))) - (require 'nnheader) (require 'nnoo) (require 'gnus-util) @@ -244,8 +238,7 @@ server there that you can connect to. See also (defvoo nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set. -NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") +If this variable is nil, which is the default, no timers are set.") (defvoo nntp-prepare-post-hook nil "*Hook run just before posting an article. It is supposed to be used @@ -259,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) @@ -344,16 +339,14 @@ retried once before actually displaying the error report." (defmacro nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." - (if (featurep 'xemacs) - `(copy-to-buffer ,buffer ,start ,end) - `(let ((string (buffer-substring ,start ,end))) - (with-current-buffer ,buffer - (erase-buffer) - (insert (if enable-multibyte-characters - (mm-string-to-multibyte string) - string)) - (goto-char (point-min)) - nil)))) + `(let ((string (buffer-substring ,start ,end))) + (with-current-buffer ,buffer + (erase-buffer) + (insert (if enable-multibyte-characters + (string-to-multibyte string) + string)) + (goto-char (point-min)) + nil))) (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." @@ -1269,7 +1262,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-open-ssl-stream tls) (nntp-open-tls-stream tls)))) (if (assoc nntp-open-connection-function map) - (open-protocol-stream + (open-network-stream "nntpd" pbuffer nntp-address nntp-port-number :type (cadr (assoc nntp-open-connection-function map)) :end-of-command "^\\([2345]\\|[.]\\).*\n" @@ -1301,13 +1294,11 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-kill-buffer pbuffer)) (when (and (buffer-name pbuffer) process) - (when (and (fboundp 'set-network-process-option) ;; Unavailable in XEmacs. - (fboundp 'process-type) ;; Emacs 22 doesn't provide it. - (eq (process-type process) 'network)) + (when (eq (process-type process) 'network) ;; Use TCP-keepalive so that connections that pass through a NAT router ;; don't hang when left idle. (set-network-process-option process :keepalive t)) - (gnus-set-process-query-on-exit-flag process nil) + (set-process-query-on-exit-flag process nil) (if (and (nntp-wait-for process "^2.*\n" buffer nil t) (memq (process-status process) '(open run))) (prog1 diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 925f65f8dda..7fc4464a06a 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -103,10 +103,9 @@ Valid types include `google', `dejanews', and `gmane'.") (with-current-buffer nntp-server-buffer (erase-buffer) (let (article header) - (mm-with-unibyte-current-buffer - (while (setq article (pop articles)) - (when (setq header (cadr (assq article nnweb-articles))) - (nnheader-insert-nov header)))) + (while (setq article (pop articles)) + (when (setq header (cadr (assq article nnweb-articles))) + (nnheader-insert-nov header))) 'nov))) (deffoo nnweb-request-scan (&optional group server) @@ -153,8 +152,7 @@ Valid types include `google', `dejanews', and `gmane'.") (let* ((header (cadr (assq article nnweb-articles))) (url (and header (mail-header-xref header)))) (when (or (and url - (mm-with-unibyte-current-buffer - (mm-url-insert url))) + (mm-url-insert url)) (and (stringp article) (nnweb-definition 'id t) (let ((fetch (nnweb-definition 'id)) @@ -164,8 +162,7 @@ Valid types include `google', `dejanews', and `gmane'.") (when (and fetch art) (setq url (format fetch (mm-url-form-encode-xwfu art))) - (mm-with-unibyte-current-buffer - (mm-url-insert url)) + (mm-url-insert url) (if (nnweb-definition 'reference t) (setq article (funcall (nnweb-definition @@ -215,17 +212,16 @@ Valid types include `google', `dejanews', and `gmane'.") (defun nnweb-read-overview (group) "Read the overview of GROUP and build the map." (when (file-exists-p (nnweb-overview-file group)) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents (nnweb-overview-file group)) - (goto-char (point-min)) - (let (header) - (while (not (eobp)) - (setq header (nnheader-parse-nov)) - (forward-line 1) - (push (list (mail-header-number header) - header (mail-header-xref header)) - nnweb-articles) - (nnweb-set-hashtb header (car nnweb-articles))))))) + (nnheader-insert-file-contents (nnweb-overview-file group)) + (goto-char (point-min)) + (let (header) + (while (not (eobp)) + (setq header (nnheader-parse-nov)) + (forward-line 1) + (push (list (mail-header-number header) + header (mail-header-xref header)) + nnweb-articles) + (nnweb-set-hashtb header (car nnweb-articles)))))) (defun nnweb-write-overview (group) "Write the overview file for GROUP." @@ -386,8 +382,7 @@ Valid types include `google', `dejanews', and `gmane'.") (setq nnweb-articles (nconc nnweb-articles map)) (when (setq header (cadar map)) - (mm-with-unibyte-current-buffer - (mm-url-insert (mail-header-xref header))) + (mm-url-insert (mail-header-xref header)) (caar map)))) (defun nnweb-google-create-mapping () @@ -513,8 +508,8 @@ Valid types include `google', `dejanews', and `gmane'.") ;;("TOPDOC" . "1000") )))) (setq buffer-file-name nil) - (unless (featurep 'xemacs) (set-buffer-multibyte t)) - (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (set-buffer-multibyte t) + (decode-coding-region (point-min) (point-max) 'utf-8) t) (defun nnweb-gmane-identity (url) 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 403447f3963..1ea4c1e51de 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -58,19 +58,17 @@ (defvar smiley-data-directory) (defcustom smiley-style - (if (or (and (fboundp 'face-attribute) - ;; In batch mode, attributes can be unspecified. - (condition-case nil - (>= (face-attribute 'default :height) 160) - (error nil))) - (and (fboundp 'face-height) - (>= (face-height 'default) 14))) + (if (and (fboundp 'face-attribute) + ;; In batch mode, attributes can be unspecified. + (condition-case nil + (>= (face-attribute 'default :height) 160) + (error nil))) 'medium 'low-color) "Smiley style." - :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 - (const :tag "medium, ~10 colors" medium) ;; 16x16 - (const :tag "dull, grayscale" grayscale));; 14x14 + :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 + (const :tag "medium, ~10 colors" medium) ;; 16x16 + (const :tag "dull, grayscale" grayscale)) ;; 14x14 :set (lambda (symbol value) (set-default symbol value) (setq smiley-data-directory (smiley-directory)) @@ -94,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)) @@ -118,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'." @@ -139,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) @@ -179,7 +177,7 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in "Replace in the region `smiley-regexp-alist' matches with corresponding images. A list of images is returned." (interactive "r") - (when (gnus-graphic-display-p) + (when (display-graphic-p) (unless smiley-cached-regexp-alist (smiley-update-cache)) (save-excursion diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index d1077a96fc9..888974e1401 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -120,31 +120,16 @@ (require 'dig) -(if (locate-library "password-cache") - (require 'password-cache) - (require 'password)) +(require 'password-cache) (eval-when-compile (require 'cl)) -(eval-and-compile - (cond - ((fboundp 'replace-in-string) - (defalias 'smime-replace-in-string 'replace-in-string)) - ((fboundp 'replace-regexp-in-string) - (defun smime-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))))) - (defgroup smime nil "S/MIME configuration." :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") @@ -154,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: @@ -167,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) @@ -175,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 @@ -189,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") @@ -206,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). @@ -227,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") @@ -244,21 +229,6 @@ must be set in `ldap-host-parameters-alist'." (defvar smime-details-buffer "*OpenSSL output*") -;; Use mm-util? -(eval-and-compile - (defalias 'smime-make-temp-file - (if (fboundp 'make-temp-file) - 'make-temp-file - (lambda (prefix &optional dir-flag) ;; Simple implementation - (expand-file-name - (make-temp-name prefix) - (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory)))))) - -;; 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 @@ -301,7 +271,7 @@ key and certificate itself." (keyfile (or (car-safe keyfile) keyfile)) (buffer (generate-new-buffer " *smime*")) (passphrase (smime-ask-passphrase (expand-file-name keyfile))) - (tmpfile (smime-make-temp-file "smime"))) + (tmpfile (make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (prog1 @@ -335,7 +305,7 @@ have proper MIME tags. CERTFILES is a list of filenames, each file is expected to contain of a PEM encoded certificate." (smime-new-details-buffer) (let ((buffer (generate-new-buffer " *smime*")) - (tmpfile (smime-make-temp-file "smime"))) + (tmpfile (make-temp-file "smime"))) (prog1 (when (prog1 (apply 'smime-call-openssl-region b e (list buffer tmpfile) @@ -431,7 +401,7 @@ in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer " *smime*")) CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) - (tmpfile (smime-make-temp-file "smime"))) + (tmpfile (make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (if (prog1 @@ -588,13 +558,9 @@ A string or a list of strings is returned." "Get certificate for MAIL from the ldap server at HOST." (let ((ldapresult (funcall - (if (featurep 'xemacs) - (progn - (require 'smime-ldap) - 'smime-ldap-search) - (progn - (require 'ldap) - 'ldap-search)) + (progn + (require 'ldap) + 'ldap-search) (concat "mail=" mail) host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) @@ -611,11 +577,11 @@ A string or a list of strings is returned." (string= (substring (cadaar ldapresult) 0 3) "MII")) (setq cert - (smime-replace-in-string - (cadaar ldapresult) + (replace-regexp-in-string (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" "-----END CERTIFICATE-----\\)") - "" t)) + "" + (cadaar ldapresult) nil t)) (setq cert (base64-encode-string (cadaar ldapresult) t))) (insert "-----BEGIN CERTIFICATE-----\n") (let ((i 0) (len (length cert))) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 0086dd14792..88854e04253 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -162,13 +162,13 @@ submitted at once. Internal variable.") rpt-host (concat "/" - (gnus-replace-in-string - (gnus-replace-in-string - (gnus-replace-in-string - (mail-header-xref (gnus-summary-article-header article)) - "/raw" ":silent") - "^.*article.gmane.org/" "") - "/" ":")))) + (replace-regexp-in-string + "/" ":" + (replace-regexp-in-string + "^.*article.gmane.org/" "" + (replace-regexp-in-string + "/raw" ":silent" + (mail-header-xref (gnus-summary-article-header article)))))))) (spam-report-gmane-use-article-number (spam-report-url-ping rpt-host @@ -207,8 +207,8 @@ submitted at once. Internal variable.") (when host (when (string-equal "permalink.gmane.org" host) (setq host rpt-host) - (setq report (gnus-replace-in-string - report "/\\([0-9]+\\)$" ":\\1"))) + (setq report (replace-regexp-in-string "/\\([0-9]+\\)$" ":\\1" + report))) (setq url (format "http://%s%s" host report))) (if (not (and host report url)) (gnus-message @@ -227,7 +227,7 @@ the function specified by `spam-report-url-ping-function'." (defcustom spam-report-user-mail-address (and (stringp user-mail-address) - (gnus-replace-in-string user-mail-address "@" "<at>")) + (replace-regexp-in-string "@" "<at>" user-mail-address)) "Mail address of this user used for spam reports to Gmane. This is initialized based on `user-mail-address'." :type '(choice string @@ -255,7 +255,7 @@ This is initialized based on `user-mail-address'." 80)) (error "Could not open connection to %s" host)) (set-marker (process-mark tcp-connection) (point-min)) - (gnus-set-process-query-on-exit-flag tcp-connection nil) + (set-process-query-on-exit-flag tcp-connection nil) (process-send-string tcp-connection (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n" @@ -297,8 +297,7 @@ symbol `ask', query before flushing the queue file." (re-search-forward "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) (let ((spam-report-gmane-wait - (zerop (% (mm-line-number-at-pos) - spam-report-gmane-max-requests)))) + (zerop (% (line-number-at-pos) spam-report-gmane-max-requests)))) (gnus-message 6 "Reporting %s%s..." (match-string 1) (match-string 2)) (funcall spam-report-url-ping-function @@ -307,7 +306,7 @@ symbol `ask', query before flushing the queue file." (if (or (eq keep nil) (and (eq keep 'ask) (y-or-n-p - (gnus-format-message + (format-message "Flush requests from `%s'? " (current-buffer))))) (progn (gnus-message 7 "Flushing request file `%s'" diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index afcc54137d8..23b4556c759 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -493,18 +493,6 @@ where DIFF is the difference between SCORE and 0.5." (setcdr (nthcdr 14 result) nil) result)) -(eval-when-compile - (defmacro spam-stat-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p))))) - (defun spam-stat-score-buffer () "Return a score describing the spam-probability for this buffer. Add user supplied modifications if supplied." @@ -522,7 +510,7 @@ Add user supplied modifications if supplied." (error nil))) (ans (if score1s (+ score0 score1s) score0))) - (when (spam-stat-called-interactively-p 'any) + (when (called-interactively-p 'any) (message "%S" ans)) ans)) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index ab0584fdcf6..d3224004f15 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1199,19 +1199,19 @@ Note this has to be fast." (if header-content (cond ((eq header 'X-Spam-Status) - (string-to-number (gnus-replace-in-string - header-content + (string-to-number (replace-regexp-in-string spam-spamassassin-score-regexp - "\\1"))) + "\\1" + header-content))) ;; for CRM checking, it's probably faster to just do the string match ((string-match "( pR: \\([0-9.-]+\\)" header-content) (- (string-to-number (match-string 1 header-content)))) ((eq header 'X-Bogosity) - (string-to-number (gnus-replace-in-string - (gnus-replace-in-string - header-content - ".*spamicity=" "") - ",.*" ""))) + (string-to-number (replace-regexp-in-string + ",.*" "" + (replace-regexp-in-string + ".*spamicity=" "" + header-content)))) (t nil)) nil))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 7dfa6700b29..6402f770927 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 @@ -59,7 +115,7 @@ When called from lisp, FUNCTION may also be a function object." (if fn (format "Describe function (default %s): " fn) "Describe function: ") - obarray 'fboundp t nil nil + #'help--symbol-completion-table #'fboundp t nil nil (and fn (symbol-name fn))))) (unless (equal val "") (setq fn (intern val))) @@ -68,6 +124,7 @@ When called from lisp, FUNCTION may also be a function object." (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' ;; expects (current-buffer) to be a help buffer when processing @@ -516,13 +573,17 @@ FILE is the file where FUNCTION was probably defined." (aliased (or (symbolp def) ;; Advised & aliased function. (and advised (symbolp real-function) - (not (eq 'autoload (car-safe def)))))) + (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) @@ -544,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") @@ -702,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) @@ -761,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)) @@ -772,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))) @@ -797,8 +863,6 @@ it is displayed along with the global value." ((bufferp locus) (princ (format "Local in buffer %s; " (buffer-name buffer)))) - ((framep locus) - (princ (format "It is a frame-local variable; "))) ((terminal-live-p locus) (princ (format "It is a terminal-local variable; "))) (t @@ -852,6 +916,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 @@ -901,6 +966,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)) @@ -913,29 +984,35 @@ if it is given a local binding.\n")))) (buffer-file-name buffer))) (dir-locals-find-file (buffer-file-name buffer)))) - (dir-file t)) + (is-directory nil)) (princ (substitute-command-keys " This variable's value is directory-local")) - (if (null file) - (princ ".\n") - (princ ", set ") - (if (consp file) ; result from cache - ;; If the cache element has an mtime, we - ;; assume it came from a file. - (if (nth 2 file) - (setq file (expand-file-name - dir-locals-file (car file))) - ;; Otherwise, assume it was set directly. - (setq file (car file) - dir-file nil))) - (princ (substitute-command-keys - (if dir-file - "by the file\n `" - "for the directory\n `"))) + (when (consp file) ; result from cache + ;; If the cache element has an mtime, we + ;; assume it came from a file. + (if (nth 2 file) + ;; (car file) is a directory. + (setq file (dir-locals--all-files (car file))) + ;; Otherwise, assume it was set directly. + (setq file (car file) + is-directory t))) + (if (null file) + (princ ".\n") + (princ ", set ") + (princ (substitute-command-keys + (cond + (is-directory "for the directory\n `") + ;; Many files matched. + ((and (consp file) (cdr file)) + (setq file (file-name-directory (car file))) + (format "by one of the\n %s files in the directory\n `" + dir-locals-file)) + (t (setq file (car file)) + "by the file\n `")))) (with-current-buffer standard-output (insert-text-button file 'type 'help-dir-local-var-def - 'help-args (list variable file))) + 'help-args (list variable file))) (princ (substitute-command-keys "'.\n")))) (princ (substitute-command-keys " This variable's value is file-local.\n")))) @@ -1101,7 +1178,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)))) @@ -1128,6 +1211,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.el b/lisp/help.el index 57f358b9a72..b8485667ae0 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -613,7 +613,15 @@ temporarily enables it to allow getting help on disabled items and buttons." (when (null (cdr yank-menu)) (setq saved-yank-menu (copy-sequence yank-menu)) (menu-bar-update-yank-menu "(any string)" nil)) - (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (while + (progn + (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: ")) + (and (vectorp key) + (consp (aref key 0)) + (symbolp (car (aref key 0))) + (string-match "\\(mouse\\|down\\|click\\|drag\\)" + (symbol-name (car (aref key 0)))) + (not (sit-for (/ double-click-time 1000.0) t))))) ;; Clear the echo area message (Bug#7014). (message nil) ;; If KEY is a down-event, read and discard the @@ -750,7 +758,15 @@ temporarily enables it to allow getting help on disabled items and buttons." (when (null (cdr yank-menu)) (setq saved-yank-menu (copy-sequence yank-menu)) (menu-bar-update-yank-menu "(any string)" nil)) - (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (while + (progn + (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: ")) + (and (vectorp key) + (consp (aref key 0)) + (symbolp (car (aref key 0))) + (string-match "\\(mouse\\|down\\|click\\|drag\\)" + (symbol-name (car (aref key 0)))) + (not (sit-for (/ double-click-time 1000.0) t))))) (list key (prefix-numeric-value current-prefix-arg) @@ -930,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" 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/hfy-cmap.el b/lisp/hfy-cmap.el index cf54ea54d0b..e12ec8aa646 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -845,7 +845,7 @@ Loads the variable `hfy-rgb-txt-colour-map', which is used by (provide 'hfy-cmap) ;; Local Variables: -;; generated-autoload-file: "htmlfontify.el" +;; generated-autoload-file: "htmlfontify-loaddefs.el" ;; End: ;;; hfy-cmap.el ends here 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 82f3a74919f..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) @@ -90,6 +90,8 @@ ;; (`font-lock-fontify-region') (require 'cus-edit) +(require 'htmlfontify-loaddefs) + (defconst htmlfontify-version 0.21) (defconst hfy-meta-tags @@ -816,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))) @@ -829,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" )))))) @@ -848,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"))))) @@ -1001,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)) @@ -1285,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 @@ -1302,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'. ;; @@ -1405,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 @@ -1419,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) @@ -1760,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))) @@ -1803,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) @@ -1847,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 @@ -1960,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) @@ -2417,26 +2419,6 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." (let ((file (hfy-initfile))) (load file 'NOERROR nil nil) )) - -;;;### (autoloads nil "hfy-cmap" "hfy-cmap.el" "e644ddae915ddb98c9b2f16ffa5a74b2") -;;; Generated autoloads from hfy-cmap.el - -(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ -Load an X11 style rgb.txt FILE. -Search `hfy-rgb-load-path' if FILE is not specified. -Loads the variable `hfy-rgb-txt-colour-map', which is used by -`hfy-fallback-colour-values'. - -\(fn &optional FILE)" t nil) - -(autoload 'hfy-fallback-colour-values "hfy-cmap" "\ -Use a fallback method for obtaining the rgb values for a color. - -\(fn COLOUR-STRING)" nil nil) - -;;;*** - - (provide 'htmlfontify) ;;; htmlfontify.el ends here diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index f5375612c34..7ebfecd3749 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -28,6 +28,13 @@ ;; These functions should be automatically loaded when called, but you ;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them ;; preloaded. +;; +;; For details on the structure of ibuffer filters and filter groups, +;; see the documentation for variables `ibuffer-filtering-qualifiers', +;; `ibuffer-filter-groups', and `ibuffer-saved-filters' in that order. +;; The variable `ibuffer-filtering-alist' contains names and +;; descriptions of the currently defined filters; also see the macro +;; `define-ibuffer-filter'. ;;; Code: @@ -35,15 +42,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 +92,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,35 +126,157 @@ 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. - -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) +(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)))) + +(defcustom ibuffer-saved-filters '(("programming" + (or (derived-mode . prog-mode) + (mode . ess-mode) + (mode . compilation-mode))) + ("text document" + (and (derived-mode . text-mode) + (not (starred-name)))) + ("TeX" + (or (derived-mode . tex-mode) + (mode . latex-mode) + (mode . context-mode) + (mode . ams-tex-mode) + (mode . bibtex-mode))) + ("web" + (or (derived-mode . sgml-mode) + (derived-mode . css-mode) + (mode . javascript-mode) + (mode . js2-mode) + (mode . scss-mode) + (derived-mode . haml-mode) + (mode . sass-mode))) + ("gnus" + (or (mode . message-mode) + (mode . mail-mode) + (mode . gnus-group-mode) + (mode . gnus-summary-mode) + (mode . gnus-article-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'.") + "A list specifying the filters currently acting on the buffer list. + +If this list is nil, then no filters are currently in +effect. Otherwise, each element of this list specifies a single +filter, and all of the specified filters in the list are applied +successively to the buffer list. + +Each filter specification can be of two types: simple or compound. + +A simple filter specification has the form (SYMBOL . QUALIFIER), +where SYMBOL is a key in the alist `ibuffer-filtering-alist' that +determines the filter function to use and QUALIFIER is the data +passed to that function (along with the buffer being considered). + +A compound filter specification can have one of four forms: + +-- (not FILTER-SPEC) + + Represents the logical complement of FILTER-SPEC, which + is any single filter specification, simple or compound. + The form (not . FILTER-SPEC) is also accepted here. + +-- (and FILTER-SPECS...) + + Represents the logical-and of the filters defined by one or + more filter specifications FILTER-SPECS..., where each + specification can be simple or compound. Note that and is + implicitly applied to the filters in the top-level list. + +-- (or FILTER-SPECS...) + + Represents the logical-or of the filters defined by one or + more filter specifications FILTER-SPECS..., where each + specification can be simple or compound. + +-- (saved . \"NAME\") + + Represents the filter saved under the string NAME + in the alist `ibuffer-saved-filters'. It is an + error to name a filter that has not been saved. + +This variable is local to each ibuffer buffer.") ;; This is now frobbed by `define-ibuffer-filter'. (defvar ibuffer-filtering-alist nil @@ -153,10 +308,18 @@ to this variable." (defvar ibuffer-compiled-filter-formats nil) (defvar ibuffer-filter-groups nil - "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers. -The SYMBOL should be one from `ibuffer-filtering-alist'. -The QUALIFIER should be the same as QUALIFIER in -`ibuffer-filtering-qualifiers'.") + "An alist giving this buffer's active filter groups, or nil if none. + +This alist maps filter group labels to filter specification +lists. Each element has the form (\"LABEL\" FILTER-SPECS...), +where FILTER-SPECS... represents one or more filter +specifications of the same form as allowed as elements of +`ibuffer-filtering-qualifiers'. + +Each filter group is displayed as a separate section in the +ibuffer list, headed by LABEL and displaying only the buffers +that pass through all the filters associated with NAME in this +list.") (defcustom ibuffer-show-empty-filter-groups t "If non-nil, then show the names of filter groups which are empty." @@ -166,20 +329,21 @@ The QUALIFIER should be the same as QUALIFIER in (defcustom ibuffer-saved-filter-groups nil "An alist of filtering groups to switch between. -This variable should look like ((\"STRING\" QUALIFIERS) - (\"STRING\" QUALIFIERS) ...), where -QUALIFIERS is a list of the same form as -`ibuffer-filtering-qualifiers'. +Each element is of the form (\"NAME\" . FILTER-GROUP-LIST), +where NAME is a unique but arbitrary name and FILTER-GROUP-LIST +is a list of filter groups with the same structure as +allowed for `ibuffer-filter-groups'. -See also the variables `ibuffer-filter-groups', -`ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the -functions `ibuffer-switch-to-saved-filter-groups', -`ibuffer-save-filter-groups'." +See also the functions `ibuffer-save-filter-groups' and +`ibuffer-switch-to-saved-filter-groups' for saving and switching +between sets of filter groups, and the variable +`ibuffer-save-with-custom' that affects how this information is +saved." :type '(repeat sexp) :group 'ibuffer) (defvar ibuffer-hidden-filter-groups nil - "A list of filtering groups which are currently hidden.") + "The list of filter groups that are currently hidden.") (defvar ibuffer-filter-group-kill-ring nil) @@ -198,6 +362,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 +410,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 +441,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 +513,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 +535,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) @@ -480,18 +672,38 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." ;;;###autoload (defun ibuffer-included-in-filters-p (buf filters) + "Return non-nil if BUF passes all FILTERS. + +BUF is a lisp buffer object, and FILTERS is a list of filter +specifications with the same structure as +`ibuffer-filtering-qualifiers'." (not (memq nil ;; a filter will return nil if it failed - (mapcar - ;; filter should be like (TYPE . QUALIFIER), or - ;; (or (TYPE . QUALIFIER) (TYPE . QUALIFIER) ...) - #'(lambda (qual) - (ibuffer-included-in-filter-p buf qual)) - filters)))) + (mapcar #'(lambda (filter) + (ibuffer-included-in-filter-p buf filter)) + filters)))) + +(defun ibuffer-unary-operand (filter) + "Extracts operand from a unary compound FILTER specification. + +FILTER should be a cons cell of either form (f . d) or (f d), +where operand d is itself a cons cell, or nil. Returns d." + (let* ((tail (cdr filter)) + (maybe-q (car-safe tail))) + (if (consp maybe-q) maybe-q tail))) (defun ibuffer-included-in-filter-p (buf filter) + "Return non-nil if BUF pass FILTER. + +BUF is a lisp buffer object, and FILTER is a filter +specification, with the same structure as an element of the list +`ibuffer-filtering-qualifiers'." (if (eq (car filter) 'not) - (not (ibuffer-included-in-filter-p-1 buf (cdr filter))) + (let ((inner (ibuffer-unary-operand filter))) + ;; Allows (not (not ...)) etc, which may be overkill + (if (eq (car inner) 'not) + (ibuffer-included-in-filter-p buf (ibuffer-unary-operand inner)) + (not (ibuffer-included-in-filter-p-1 buf inner)))) (ibuffer-included-in-filter-p-1 buf filter))) (defun ibuffer-included-in-filter-p-1 (buf filter) @@ -499,17 +711,25 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (not (pcase (car filter) (`or + ;;; ATTN: Short-circuiting alternative with parallel structure w/`and + ;;(catch 'has-match + ;; (dolist (filter-spec (cdr filter) nil) + ;; (when (ibuffer-included-in-filter-p buf filter-spec) + ;; (throw 'has-match t)))) (memq t (mapcar #'(lambda (x) - (ibuffer-included-in-filter-p buf x)) - (cdr filter)))) + (ibuffer-included-in-filter-p buf x)) + (cdr filter)))) + (`and + (catch 'no-match + (dolist (filter-spec (cdr filter) t) + (unless (ibuffer-included-in-filter-p buf filter-spec) + (throw 'no-match nil))))) (`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 +744,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 +828,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 +876,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 +966,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)) @@ -796,55 +1016,47 @@ group definitions by setting `ibuffer-filter-groups' to nil." (when buf (ibuffer-jump-to-buffer (buffer-name buf))))) -(defun ibuffer-push-filter (qualifier) - "Add QUALIFIER to `ibuffer-filtering-qualifiers'." - (push qualifier ibuffer-filtering-qualifiers)) +(defun ibuffer-push-filter (filter-specification) + "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'." + (push filter-specification ibuffer-filtering-qualifiers)) ;;;###autoload (defun ibuffer-decompose-filter () - "Separate the top compound filter (OR, NOT, or SAVED) in this buffer. + "Separate this buffer's top compound filter (AND, OR, NOT, or SAVED). 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]." +turned into separate filters, like [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 `or 'and) (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 (ibuffer-unary-operand (car filters)) 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 () @@ -859,31 +1071,36 @@ turned into two separate filters [name: foo] and [mode: bar-mode]." ibuffer-filtering-qualifiers)) (ibuffer-update nil t)) +(defun ibuffer--or-and-filter (op decompose) + (if decompose + (if (eq op (caar ibuffer-filtering-qualifiers)) + (ibuffer-decompose-filter) + (error "Top filter is not an %s" (upcase (symbol-name op)))) + (when (< (length ibuffer-filtering-qualifiers) 2) + (error "Need two filters to %s" (upcase (symbol-name op)))) + ;; If either filter is an op, eliminate unnecessary nesting. + (let ((first (pop ibuffer-filtering-qualifiers)) + (second (pop ibuffer-filtering-qualifiers))) + (push (nconc (if (eq op (car first)) first (list op first)) + (if (eq op (car second)) (cdr second) (list second))) + ibuffer-filtering-qualifiers))) + (ibuffer-update nil t)) + ;;;###autoload -(defun ibuffer-or-filter (&optional reverse) +(defun ibuffer-or-filter (&optional decompose) "Replace the top two filters in this buffer with their logical OR. -If optional argument REVERSE is non-nil, instead break the top OR +If optional argument DECOMPOSE is non-nil, instead break the top OR filter into parts." (interactive "P") - (if reverse - (progn - (when (or (null ibuffer-filtering-qualifiers) - (not (eq 'or (caar ibuffer-filtering-qualifiers)))) - (error "Top filter is not an OR")) - (let ((lim (pop ibuffer-filtering-qualifiers))) - (setq ibuffer-filtering-qualifiers - (nconc (cdr lim) ibuffer-filtering-qualifiers)))) - (when (< (length ibuffer-filtering-qualifiers) 2) - (error "Need two filters to OR")) - ;; If the second filter is an OR, just add to it. - (let ((first (pop ibuffer-filtering-qualifiers)) - (second (pop ibuffer-filtering-qualifiers))) - (if (eq 'or (car second)) - (push (nconc (list 'or first) (cdr second)) - ibuffer-filtering-qualifiers) - (push (list 'or first second) - ibuffer-filtering-qualifiers)))) - (ibuffer-update nil t)) + (ibuffer--or-and-filter 'or decompose)) + +;;;###autoload +(defun ibuffer-and-filter (&optional decompose) + "Replace the top two filters in this buffer with their logical AND. +If optional argument DECOMPOSE is non-nil, instead break the top AND +filter into parts." + (interactive "P") + (ibuffer--or-and-filter 'and decompose)) (defun ibuffer-maybe-save-stuff () (when ibuffer-save-with-custom @@ -907,7 +1124,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 +1137,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)) @@ -957,7 +1174,9 @@ Interactively, prompt for NAME, and use the current filters." (defun ibuffer-format-qualifier (qualifier) (if (eq (car-safe qualifier) 'not) - (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]") + (concat " [NOT" + (ibuffer-format-qualifier-1 (ibuffer-unary-operand qualifier)) + "]") (ibuffer-format-qualifier-1 qualifier))) (defun ibuffer-format-qualifier-1 (qualifier) @@ -966,14 +1185,16 @@ Interactively, prompt for NAME, and use the current filters." (concat " [filter: " (cdr qualifier) "]")) (`or (concat " [OR" (mapconcat #'ibuffer-format-qualifier - (cdr qualifier) "") "]")) + (cdr qualifier) "") "]")) + (`and + (concat " [AND" (mapconcat #'ibuffer-format-qualifier + (cdr qualifier) "") "]")) (_ (let ((type (assq (car qualifier) ibuffer-filtering-alist))) (unless qualifier - (error "Ibuffer: bad qualifier %s" qualifier)) + (error "Ibuffer: bad qualifier %s" qualifier)) (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier))))))) - (defun ibuffer-list-buffer-modes (&optional include-parents) "Create a completion table of buffer modes currently in use. If INCLUDE-PARENTS is non-nil then include parent modes." @@ -991,7 +1212,7 @@ If INCLUDE-PARENTS is non-nil then include parent modes." ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext") (define-ibuffer-filter mode - "Toggle current view to buffers with major mode QUALIFIER." + "Limit current view to buffers with major mode QUALIFIER." (:description "major mode" :reader (let* ((buf (ibuffer-current-buffer)) @@ -1011,7 +1232,7 @@ If INCLUDE-PARENTS is non-nil then include parent modes." ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext") (define-ibuffer-filter used-mode - "Toggle current view to buffers with major mode QUALIFIER. + "Limit current view to buffers with major mode QUALIFIER. Called interactively, this function allows selection of modes currently used by buffers." (:description "major mode in use" @@ -1030,7 +1251,7 @@ currently used by buffers." ;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext") (define-ibuffer-filter derived-mode - "Toggle current view to buffers whose major mode inherits from QUALIFIER." + "Limit current view to buffers whose major mode inherits from QUALIFIER." (:description "derived mode" :reader (intern @@ -1041,22 +1262,73 @@ currently used by buffers." ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext") (define-ibuffer-filter name - "Toggle current view to buffers with name matching QUALIFIER." + "Limit current view to buffers with name matching QUALIFIER." (:description "buffer name" :reader (read-from-minibuffer "Filter by name (regexp): ")) (string-match qualifier (buffer-name buf))) +;;;###autoload (autoload 'ibuffer-filter-by-starred-name "ibuf-ext") +(define-ibuffer-filter starred-name + "Limit current view to buffers with name beginning and ending +with *, along with an optional suffix of the form digits or +<digits>." + (:description "starred buffer name" + :reader nil) + (string-match "\\`\\*[^*]+\\*\\(?:<[[:digit:]]+>\\)?\\'" (buffer-name buf))) + ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext") (define-ibuffer-filter filename - "Toggle current view to buffers with filename matching QUALIFIER." - (:description "filename" - :reader (read-from-minibuffer "Filter by filename (regexp): ")) + "Limit current view to buffers with full file name matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against '/a/b/c.d'." + (:description "full file name" + :reader (read-from-minibuffer "Filter by full file name (regexp): ")) (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) (string-match qualifier it))) +;;;###autoload (autoload 'ibuffer-filter-by-basename "ibuf-ext") +(define-ibuffer-filter basename + "Limit current view to buffers with file basename matching QUALIFIER. + +For example, for a buffer associated with file '/a/b/c.d', this +matches against 'c.d'." + (:description "file basename" + :reader (read-from-minibuffer + "Filter by file name, without directory part (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (string-match qualifier (file-name-nondirectory it)))) + +;;;###autoload (autoload 'ibuffer-filter-by-file-extension "ibuf-ext") +(define-ibuffer-filter file-extension + "Limit current view to buffers with filename extension matching QUALIFIER. + +The separator character (typically `.') is not part of the +pattern. For example, for a buffer associated with file +'/a/b/c.d', this matches against 'd'." + (:description "filename extension" + :reader (read-from-minibuffer + "Filter by filename extension without separator (regex): ")) + (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name)) + (string-match qualifier (or (file-name-extension it) "")))) + +;;;###autoload (autoload 'ibuffer-filter-by-directory "ibuf-ext") +(define-ibuffer-filter directory + "Limit current view to buffers with directory matching QUALIFIER. + +For a buffer associated with file '/a/b/c.d', this matches +against '/a/b'. For a buffer not associated with a file, this +matches against the value of `default-directory' in that buffer." + (:description "directory name" + :reader (read-from-minibuffer "Filter by directory name (regex): ")) + (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name)) + (let ((dirname (file-name-directory it))) + (when dirname (string-match qualifier dirname))) + (when default-directory (string-match qualifier default-directory)))) + ;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext") (define-ibuffer-filter size-gt - "Toggle current view to buffers with size greater than QUALIFIER." + "Limit current view to buffers with size greater than QUALIFIER." (:description "size greater than" :reader (string-to-number (read-from-minibuffer "Filter by size greater than: "))) @@ -1065,16 +1337,30 @@ currently used by buffers." ;;;###autoload (autoload 'ibuffer-filter-by-size-lt "ibuf-ext") (define-ibuffer-filter size-lt - "Toggle current view to buffers with size less than QUALIFIER." + "Limit current view to buffers with size less than QUALIFIER." (:description "size less than" :reader (string-to-number (read-from-minibuffer "Filter by size less than: "))) (< (with-current-buffer buf (buffer-size)) qualifier)) +;;;###autoload (autoload 'ibuffer-filter-by-modified "ibuf-ext") +(define-ibuffer-filter modified + "Limit current view to buffers that are marked as modified." + (:description "modified" + :reader nil) + (buffer-modified-p buf)) + +;;;###autoload (autoload 'ibuffer-filter-by-visiting-file "ibuf-ext") +(define-ibuffer-filter visiting-file + "Limit current view to buffers that are visiting a file." + (:description "visiting a file" + :reader nil) + (with-current-buffer buf (buffer-file-name))) + ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext") (define-ibuffer-filter content - "Toggle current view to buffers whose contents match QUALIFIER." + "Limit current view to buffers whose contents match QUALIFIER." (:description "content" :reader (read-from-minibuffer "Filter by content (regexp): ")) (with-current-buffer buf @@ -1084,12 +1370,33 @@ currently used by buffers." ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext") (define-ibuffer-filter predicate - "Toggle current view to buffers for which QUALIFIER returns non-nil." + "Limit current view to buffers for which QUALIFIER returns non-nil." (:description "predicate" :reader (read-minibuffer "Filter by predicate (form): ")) (with-current-buffer buf (eval qualifier))) +;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext") +(defun ibuffer-filter-chosen-by-completion () + "Select and apply filter chosen by completion against available filters. +Indicates corresponding key sequences in echo area after filtering. + +The completion matches against the filter description text of +each filter in `ibuffer-filtering-alist'." + (interactive) + (let* ((filters (mapcar (lambda (x) (cons (cadr x) (car x))) + ibuffer-filtering-alist)) + (match (completing-read "Filter by: " filters nil t)) + (filter (cdr (assoc match filters))) + (command (intern (concat "ibuffer-filter-by-" (symbol-name filter))))) + (call-interactively command) + (message "%s can be run with key sequences: %s" + command + (mapconcat #'key-description + (where-is-internal command ibuffer-mode-map nil t) + "or ")))) + + ;;; Sorting ;;;###autoload @@ -1388,7 +1695,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,34 +1706,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 ((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))) - (if name - (pcase type - (`full - name) - (`relative - (file-relative-name - name (or ibuffer-default-directory - default-directory))) - (_ - (file-name-nondirectory name))) - "")) - " ")))) - (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 @@ -1450,6 +1774,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." @@ -1475,6 +1816,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 @@ -1598,7 +1964,7 @@ defaults to one." (provide 'ibuf-ext) ;; Local Variables: -;; generated-autoload-file: "ibuffer.el" +;; generated-autoload-file: "ibuffer-loaddefs.el" ;; End: ;;; ibuf-ext.el ends here diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 2f4d50d9a3e..fc8c127c1c3 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 + (progn ,@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 9d23e64cd81..5a740845bdf 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -36,7 +36,9 @@ (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 ;; because it has a recursive dependency on ibuffer.el (defvar ibuffer-auto-mode) @@ -69,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)) @@ -88,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. @@ -135,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) @@ -156,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 @@ -278,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 @@ -469,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) @@ -505,26 +518,37 @@ directory, like `default-directory'." (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process) (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) + (define-key map (kbd "/ RET") 'ibuffer-filter-by-mode) (define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode) (define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode) (define-key map (kbd "/ n") 'ibuffer-filter-by-name) - (define-key map (kbd "/ c") 'ibuffer-filter-by-content) - (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ *") 'ibuffer-filter-by-starred-name) (define-key map (kbd "/ f") 'ibuffer-filter-by-filename) - (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ b") 'ibuffer-filter-by-basename) + (define-key map (kbd "/ .") 'ibuffer-filter-by-file-extension) (define-key map (kbd "/ <") 'ibuffer-filter-by-size-lt) + (define-key map (kbd "/ >") 'ibuffer-filter-by-size-gt) + (define-key map (kbd "/ i") 'ibuffer-filter-by-modified) + (define-key map (kbd "/ v") 'ibuffer-filter-by-visiting-file) + (define-key map (kbd "/ c") 'ibuffer-filter-by-content) + (define-key map (kbd "/ e") 'ibuffer-filter-by-predicate) + (define-key map (kbd "/ r") 'ibuffer-switch-to-saved-filters) (define-key map (kbd "/ a") 'ibuffer-add-saved-filters) (define-key map (kbd "/ x") 'ibuffer-delete-saved-filters) (define-key map (kbd "/ d") 'ibuffer-decompose-filter) (define-key map (kbd "/ s") 'ibuffer-save-filters) (define-key map (kbd "/ p") 'ibuffer-pop-filter) + (define-key map (kbd "/ <up>") 'ibuffer-pop-filter) (define-key map (kbd "/ !") 'ibuffer-negate-filter) (define-key map (kbd "/ t") 'ibuffer-exchange-filters) (define-key map (kbd "/ TAB") 'ibuffer-exchange-filters) (define-key map (kbd "/ o") 'ibuffer-or-filter) + (define-key map (kbd "/ |") 'ibuffer-or-filter) + (define-key map (kbd "/ &") 'ibuffer-and-filter) (define-key map (kbd "/ g") 'ibuffer-filters-to-filter-group) (define-key map (kbd "/ P") 'ibuffer-pop-filter-group) + (define-key map (kbd "/ S-<up>") 'ibuffer-pop-filter-group) (define-key map (kbd "/ D") 'ibuffer-decompose-filter-group) (define-key map (kbd "/ /") 'ibuffer-filter-disable) @@ -543,6 +567,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) @@ -564,13 +590,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) @@ -641,13 +668,43 @@ directory, like `default-directory'." ibuffer-filter-by-derived-mode)) (define-key-after map [menu-bar view filter filter-by-name] '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name)) + (define-key-after map [menu-bar view filter filter-by-starred-name] + '(menu-item "Add filter by starred buffer name..." + ibuffer-filter-by-starred-name + :help "List buffers whose names begin with a star")) (define-key-after map [menu-bar view filter filter-by-filename] - '(menu-item "Add filter by filename..." ibuffer-filter-by-filename)) + '(menu-item "Add filter by full filename..." ibuffer-filter-by-filename + :help + (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches '/a/b/c.d'"))) + (define-key-after map [menu-bar view filter filter-by-basename] + '(menu-item "Add filter by file basename..." + ibuffer-filter-by-basename + :help (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches 'c.d'"))) + (define-key-after map [menu-bar view filter filter-by-file-extension] + '(menu-item "Add filter by file name extension..." + ibuffer-filter-by-file-extension + :help (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches 'd'"))) + (define-key-after map [menu-bar view filter filter-by-directory] + '(menu-item "Add filter by filename's directory..." + ibuffer-filter-by-directory + :help + (concat "For a buffer associated with file '/a/b/c.d', " + "list buffer if a given pattern matches '/a/b'"))) (define-key-after map [menu-bar view filter filter-by-size-lt] '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt)) (define-key-after map [menu-bar view filter filter-by-size-gt] '(menu-item "Add filter by size greater than..." ibuffer-filter-by-size-gt)) + (define-key-after map [menu-bar view filter filter-by-modified] + '(menu-item "Add filter by modified buffer" ibuffer-filter-by-modified + :help "List buffers that are marked as modified")) + (define-key-after map [menu-bar view filter filter-by-visiting-file] + '(menu-item "Add filter by buffer visiting a file" + ibuffer-filter-by-visiting-file + :help "List buffers that are visiting files")) (define-key-after map [menu-bar view filter filter-by-content] '(menu-item "Add filter by content (regexp)..." ibuffer-filter-by-content)) @@ -657,6 +714,12 @@ directory, like `default-directory'." (define-key-after map [menu-bar view filter pop-filter] '(menu-item "Remove top filter" ibuffer-pop-filter :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + (define-key-after map [menu-bar view filter and-filter] + '(menu-item "AND top two filters" ibuffer-and-filter + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)) + :help + "Create a new filter which is the logical AND of the top two filters")) (define-key-after map [menu-bar view filter or-filter] '(menu-item "OR top two filters" ibuffer-or-filter :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers @@ -699,16 +762,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"))) @@ -716,6 +773,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")) @@ -755,6 +815,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] '("--")) @@ -769,6 +831,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)) @@ -819,6 +888,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)) @@ -968,8 +1040,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)) @@ -1119,17 +1190,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))))) @@ -1173,7 +1244,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) @@ -1212,7 +1287,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)) @@ -1227,15 +1302,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)) @@ -1275,13 +1350,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'." @@ -1311,25 +1388,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 @@ -1354,6 +1426,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) @@ -1371,11 +1461,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) @@ -1397,15 +1487,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) @@ -1501,20 +1590,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)) @@ -1583,7 +1675,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))))) @@ -1641,7 +1733,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 @@ -1714,6 +1806,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)) @@ -1722,6 +1823,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) @@ -1742,7 +1849,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 @@ -1829,9 +1942,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) @@ -1875,7 +1988,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)))) @@ -1946,6 +2059,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 @@ -2092,8 +2215,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))) @@ -2336,7 +2459,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 @@ -2411,10 +2535,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. @@ -2432,6 +2558,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: @@ -2611,382 +2739,6 @@ will be inserted before the group at point." (setq default-directory ibuffer-default-directory)) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)) - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "9521139d5f2ba7c870e3101fd73bb3ce") -;;; Generated autoloads from ibuf-ext.el - -(autoload 'ibuffer-auto-mode "ibuf-ext" "\ -Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode). -With a prefix argument ARG, enable Ibuffer Auto mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -\(fn &optional ARG)" t nil) - -(autoload 'ibuffer-mouse-filter-by-mode "ibuf-ext" "\ -Enable or disable filtering by the major mode chosen via mouse. - -\(fn EVENT)" t nil) - -(autoload 'ibuffer-interactive-filter-by-mode "ibuf-ext" "\ -Enable or disable filtering by the major mode at point. - -\(fn EVENT-OR-POINT)" t nil) - -(autoload 'ibuffer-mouse-toggle-filter-group "ibuf-ext" "\ -Toggle the display status of the filter group chosen with the mouse. - -\(fn EVENT)" t nil) - -(autoload 'ibuffer-toggle-filter-group "ibuf-ext" "\ -Toggle the display status of the filter group on this line. - -\(fn)" t nil) - -(autoload 'ibuffer-forward-filter-group "ibuf-ext" "\ -Move point forwards by COUNT filtering groups. - -\(fn &optional COUNT)" t nil) - -(autoload 'ibuffer-backward-filter-group "ibuf-ext" "\ -Move point backwards by COUNT filtering groups. - -\(fn &optional COUNT)" t nil) - (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext") - (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext") - (autoload 'ibuffer-do-shell-command-file "ibuf-ext") - (autoload 'ibuffer-do-eval "ibuf-ext") - (autoload 'ibuffer-do-view-and-eval "ibuf-ext") - (autoload 'ibuffer-do-rename-uniquely "ibuf-ext") - (autoload 'ibuffer-do-revert "ibuf-ext") - (autoload 'ibuffer-do-isearch "ibuf-ext") - (autoload 'ibuffer-do-isearch-regexp "ibuf-ext") - (autoload 'ibuffer-do-replace-regexp "ibuf-ext") - (autoload 'ibuffer-do-query-replace "ibuf-ext") - (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext") - (autoload 'ibuffer-do-print "ibuf-ext") - -(autoload 'ibuffer-included-in-filters-p "ibuf-ext" "\ - - -\(fn BUF FILTERS)" nil nil) - -(autoload 'ibuffer-filters-to-filter-group "ibuf-ext" "\ -Make the current filters into a filtering group. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-set-filter-groups-by-mode "ibuf-ext" "\ -Set the current filter groups to filter by mode. - -\(fn)" t nil) - -(autoload 'ibuffer-pop-filter-group "ibuf-ext" "\ -Remove the first filter group. - -\(fn)" t nil) - -(autoload 'ibuffer-decompose-filter-group "ibuf-ext" "\ -Decompose the filter group GROUP into active filters. - -\(fn GROUP)" t nil) - -(autoload 'ibuffer-clear-filter-groups "ibuf-ext" "\ -Remove all filter groups. - -\(fn)" t nil) - -(autoload 'ibuffer-jump-to-filter-group "ibuf-ext" "\ -Move point to the filter group whose name is NAME. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-kill-filter-group "ibuf-ext" "\ -Kill the filter group named NAME. -The group will be added to `ibuffer-filter-group-kill-ring'. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-kill-line "ibuf-ext" "\ -Kill the filter group at point. -See also `ibuffer-kill-filter-group'. - -\(fn &optional ARG INTERACTIVE-P)" t nil) - -(autoload 'ibuffer-yank "ibuf-ext" "\ -Yank the last killed filter group before group at point. - -\(fn)" t nil) - -(autoload 'ibuffer-yank-filter-group "ibuf-ext" "\ -Yank the last killed filter group before group named NAME. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-save-filter-groups "ibuf-ext" "\ -Save all active filter groups GROUPS as NAME. -They are added to `ibuffer-saved-filter-groups'. Interactively, -prompt for NAME, and use the current filters. - -\(fn NAME GROUPS)" t nil) - -(autoload 'ibuffer-delete-saved-filter-groups "ibuf-ext" "\ -Delete saved filter groups with NAME. -They are removed from `ibuffer-saved-filter-groups'. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-switch-to-saved-filter-groups "ibuf-ext" "\ -Set this buffer's filter groups to saved version with NAME. -The value from `ibuffer-saved-filter-groups' is used. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-filter-disable "ibuf-ext" "\ -Disable all filters currently in effect in this buffer. -With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter -group definitions by setting `ibuffer-filter-groups' to nil. - -\(fn &optional DELETE-FILTER-GROUPS)" t nil) - -(autoload 'ibuffer-pop-filter "ibuf-ext" "\ -Remove the top filter in this buffer. - -\(fn)" t nil) - -(autoload 'ibuffer-decompose-filter "ibuf-ext" "\ -Separate the top compound filter (OR, NOT, or SAVED) in this buffer. - -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]. - -\(fn)" t nil) - -(autoload 'ibuffer-exchange-filters "ibuf-ext" "\ -Exchange the top two filters on the stack in this buffer. - -\(fn)" t nil) - -(autoload 'ibuffer-negate-filter "ibuf-ext" "\ -Negate the sense of the top filter in the current buffer. - -\(fn)" t nil) - -(autoload 'ibuffer-or-filter "ibuf-ext" "\ -Replace the top two filters in this buffer with their logical OR. -If optional argument REVERSE is non-nil, instead break the top OR -filter into parts. - -\(fn &optional REVERSE)" t nil) - -(autoload 'ibuffer-save-filters "ibuf-ext" "\ -Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'. -Interactively, prompt for NAME, and use the current filters. - -\(fn NAME FILTERS)" t nil) - -(autoload 'ibuffer-delete-saved-filters "ibuf-ext" "\ -Delete saved filters with NAME from `ibuffer-saved-filters'. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-add-saved-filters "ibuf-ext" "\ -Add saved filters from `ibuffer-saved-filters' to this buffer's filters. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-switch-to-saved-filters "ibuf-ext" "\ -Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'. - -\(fn NAME)" t nil) - (autoload 'ibuffer-filter-by-mode "ibuf-ext") - (autoload 'ibuffer-filter-by-used-mode "ibuf-ext") - (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext") - (autoload 'ibuffer-filter-by-name "ibuf-ext") - (autoload 'ibuffer-filter-by-filename "ibuf-ext") - (autoload 'ibuffer-filter-by-size-gt "ibuf-ext") - (autoload 'ibuffer-filter-by-size-lt "ibuf-ext") - (autoload 'ibuffer-filter-by-content "ibuf-ext") - (autoload 'ibuffer-filter-by-predicate "ibuf-ext") - -(autoload 'ibuffer-toggle-sorting-mode "ibuf-ext" "\ -Toggle the current sorting mode. -Default sorting modes are: - Recency - the last time the buffer was viewed - Name - the name of the buffer - Major Mode - the name of the major mode of the buffer - Size - the size of the buffer - -\(fn)" t nil) - -(autoload 'ibuffer-invert-sorting "ibuf-ext" "\ -Toggle whether or not sorting is in reverse order. - -\(fn)" t nil) - (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext") - (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext") - (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext") - (autoload 'ibuffer-do-sort-by-size "ibuf-ext") - (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext") - -(autoload 'ibuffer-bs-show "ibuf-ext" "\ -Emulate `bs-show' from the bs.el package. - -\(fn)" t nil) - -(autoload 'ibuffer-add-to-tmp-hide "ibuf-ext" "\ -Add REGEXP to `ibuffer-tmp-hide-regexps'. -This means that buffers whose name matches REGEXP will not be shown -for this Ibuffer session. - -\(fn REGEXP)" t nil) - -(autoload 'ibuffer-add-to-tmp-show "ibuf-ext" "\ -Add REGEXP to `ibuffer-tmp-show-regexps'. -This means that buffers whose name matches REGEXP will always be shown -for this Ibuffer session. - -\(fn REGEXP)" t nil) - -(autoload 'ibuffer-forward-next-marked "ibuf-ext" "\ -Move forward by COUNT marked buffers (default 1). - -If MARK is non-nil, it should be a character denoting the type of mark -to move by. The default is `ibuffer-marked-char'. - -If DIRECTION is non-nil, it should be an integer; negative integers -mean move backwards, non-negative integers mean move forwards. - -\(fn &optional COUNT MARK DIRECTION)" t nil) - -(autoload 'ibuffer-backwards-next-marked "ibuf-ext" "\ -Move backwards by COUNT marked buffers (default 1). - -If MARK is non-nil, it should be a character denoting the type of mark -to move by. The default is `ibuffer-marked-char'. - -\(fn &optional COUNT MARK)" t nil) - -(autoload 'ibuffer-do-kill-lines "ibuf-ext" "\ -Hide all of the currently marked lines. - -\(fn)" t nil) - -(autoload 'ibuffer-jump-to-buffer "ibuf-ext" "\ -Move point to the buffer whose name is NAME. - -If called interactively, prompt for a buffer name and go to the -corresponding line in the Ibuffer buffer. If said buffer is in a -hidden group filter, open it. - -If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer -visible buffers in the completion list. Calling the command with -a prefix argument reverses the meaning of that variable. - -\(fn NAME)" t nil) - -(autoload 'ibuffer-diff-with-file "ibuf-ext" "\ -View the differences between marked buffers and their associated files. -If no buffers are marked, use buffer at point. -This requires the external program \"diff\" to be in your `exec-path'. - -\(fn)" t nil) - -(autoload 'ibuffer-copy-filename-as-kill "ibuf-ext" "\ -Copy filenames of marked buffers into the kill ring. - -The names are separated by a space. -If a buffer has no filename, it is ignored. - -With no prefix arg, use the filename sans its directory of each marked file. -With a zero prefix arg, use the complete filename of each marked file. -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]. - -\(fn &optional ARG)" t nil) - -(autoload 'ibuffer-mark-by-name-regexp "ibuf-ext" "\ -Mark all buffers whose name matches REGEXP. - -\(fn REGEXP)" t nil) - -(autoload 'ibuffer-mark-by-mode-regexp "ibuf-ext" "\ -Mark all buffers whose major mode matches REGEXP. - -\(fn REGEXP)" t nil) - -(autoload 'ibuffer-mark-by-file-name-regexp "ibuf-ext" "\ -Mark all buffers whose file name matches REGEXP. - -\(fn REGEXP)" t nil) - -(autoload 'ibuffer-mark-by-mode "ibuf-ext" "\ -Mark all buffers whose major mode equals MODE. - -\(fn MODE)" t nil) - -(autoload 'ibuffer-mark-modified-buffers "ibuf-ext" "\ -Mark all modified buffers. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-unsaved-buffers "ibuf-ext" "\ -Mark all modified buffers that have an associated file. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-dissociated-buffers "ibuf-ext" "\ -Mark all buffers whose associated file does not exist. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\ -Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-compressed-file-buffers "ibuf-ext" "\ -Mark buffers whose associated file is compressed. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-old-buffers "ibuf-ext" "\ -Mark buffers which have not been viewed in `ibuffer-old-time' hours. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-special-buffers "ibuf-ext" "\ -Mark all buffers whose name begins and ends with `*'. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-read-only-buffers "ibuf-ext" "\ -Mark all read-only buffers. - -\(fn)" t nil) - -(autoload 'ibuffer-mark-dired-buffers "ibuf-ext" "\ -Mark all `dired' buffers. - -\(fn)" t nil) - -(autoload 'ibuffer-do-occur "ibuf-ext" "\ -View lines which match REGEXP in all marked buffers. -Optional argument NLINES says how many lines of context to display: it -defaults to one. - -\(fn REGEXP &optional NLINES)" t nil) - -;;;*** - -;;; End of automatically extracted autoloads. - - (provide 'ibuffer) (run-hooks 'ibuffer-load-hook) 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..7b9cf074c92 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 @@ -3504,7 +3505,7 @@ This is to make them appear as if they were \"virtual buffers\"." (when (equal name "") (setq name head)) (and (not (equal name "")) - (null (get-file-buffer head)) + (null (let (file-name-handler-alist) (get-file-buffer head))) (not (assoc name ido-virtual-buffers)) (not (member name ido-temp-list)) (not (ido-ignore-item-p name ido-ignore-buffers)) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index a8274f52521..2af72fc4527 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1,4 +1,4 @@ -;;; image-dired.el --- use dired to browse and manipulate your images +;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*- ;; ;; Copyright (C) 2005-2016 Free Software Foundation, Inc. ;; @@ -79,7 +79,7 @@ ;; ;; This information has been moved to the manual. Type `C-h r' to open ;; the Emacs manual and go to the node Thumbnails by typing `g -;; Thumbnails RET'. +;; Image-Dired RET'. ;; ;; Quickstart: M-x image-dired RET DIRNAME RET ;; @@ -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. ;; @@ -121,8 +118,6 @@ ;; * From thumbs.el: Add the "modify" commands (emboss, negate, ;; monochrome etc). ;; -;; * Asynchronous creation of thumbnails. -;; ;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find ;; out which is best, saving old batch just before inserting new, or ;; saving the current batch in the ring when inserting it. Adding it @@ -154,21 +149,22 @@ (require 'dired) (require 'format-spec) +(require 'image-mode) (require 'widget) -(require 'cl-lib) - (eval-when-compile + (require 'cl-lib) (require 'wid-edit)) (defgroup image-dired nil "Use dired to browse your images as thumbnails, and more." :prefix "image-dired-" + :link '(info-link "(emacs) Image-Dired") :group 'multimedia) (defcustom image-dired-dir (locate-user-emacs-file "image-dired/") "Directory where thumbnail images are stored." - :type 'string + :type 'directory :group 'image-dired) (defcustom image-dired-thumbnail-storage 'use-image-dired-dir @@ -182,21 +178,22 @@ means that each thumbnail is stored in a subdirectory called stored and generated according to the Thumbnail Managing Standard that allows sharing of thumbnails across different programs." :type '(choice :tag "How to store thumbnail files" - (const :tag "Thumbnail Managing Standard" standard) (const :tag "Use image-dired-dir" use-image-dired-dir) + (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) + (const :tag "Thumbnail Managing Standard (large 256x256)" standard-large) (const :tag "Per-directory" per-directory)) :group 'image-dired) (defcustom image-dired-db-file (expand-file-name ".image-dired_db" image-dired-dir) "Database file where file names and their associated tags are stored." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-temp-image-file (expand-file-name ".image-dired_temp" image-dired-dir) "Name of temporary image file used by various commands." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-gallery-dir @@ -204,7 +201,7 @@ that allows sharing of thumbnails across different programs." "Directory to store generated gallery html pages. This path needs to be \"shared\" to the public so that it can access the index.html page that image-dired creates." - :type 'string + :type 'directory :group 'image-dired) (defcustom image-dired-gallery-image-root-url @@ -227,127 +224,157 @@ expects to find pictures in this directory." "convert" "Executable used to create thumbnail. Used together with `image-dired-cmd-create-thumbnail-options'." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-cmd-create-thumbnail-options - "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\"" - "Format of command used to create thumbnail image. -Available options are %p which is replaced by -`image-dired-cmd-create-thumbnail-program', %w which is replaced by + '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + "Options of command used to create thumbnail image. +Used with `image-dired-cmd-create-thumbnail-program'. +Available format specifiers are: %w which is replaced by `image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', %f which is replaced by the file name of the original image and %t which is replaced by the file name of the thumbnail file." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) -(defcustom image-dired-cmd-create-temp-image-program - "convert" +(defcustom image-dired-cmd-create-temp-image-program "convert" "Executable used to create temporary image. Used together with `image-dired-cmd-create-temp-image-options'." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-cmd-create-temp-image-options - "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\"" - "Format of command used to create temporary image for display window. -Available options are %p which is replaced by -`image-dired-cmd-create-temp-image-program', %w and %h which is replaced by + '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + "Options of command used to create temporary image for display window. +Used together with `image-dired-cmd-create-temp-image-program', +Available format specifiers are: %w and %h which are replaced by the calculated max size for width and height in the image display window, %f which is replaced by the file name of the original image and %t which is replaced by the file name of the temporary file." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) -(defcustom image-dired-cmd-pngnq-program (executable-find "pngnq") +(defcustom image-dired-cmd-pngnq-program + (or (executable-find "pngnq") + (executable-find "pngnq-s9")) "The file name of the `pngnq' program. -It quantizes colors of PNG images down to 256 colors." - :type '(choice (const :tag "Not Set" nil) string) +It quantizes colors of PNG images down to 256 colors or fewer +using the NeuQuant algorithm." + :version "26.1" + :type '(choice (const :tag "Not Set" nil) file) + :group 'image-dired) + +(defcustom image-dired-cmd-pngnq-options + '("-f" "%t") + "Arguments to pass `image-dired-cmd-pngnq-program'. +Available format specifiers are the same as in +`image-dired-cmd-create-thumbnail-options'." + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush") "The file name of the `pngcrush' program. It optimizes the compression of PNG images. Also it adds PNG textual chunks with the information required by the Thumbnail Managing Standard." - :type '(choice (const :tag "Not Set" nil) string) + :type '(choice (const :tag "Not Set" nil) file) :group 'image-dired) -(defcustom image-dired-cmd-create-standard-thumbnail-command - (concat - image-dired-cmd-create-thumbnail-program " " - "-size %wx%h \"%f\" " - (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) - (concat - "-set \"Thumb::MTime\" \"%m\" " - "-set \"Thumb::URI\" \"file://%f\" " - "-set \"Description\" \"Thumbnail of file://%f\" " - "-set \"Software\" \"" (emacs-version) "\" ")) - "-thumbnail \"%wx%h>\" png:\"%t\"" - (if image-dired-cmd-pngnq-program - (concat - " ; " image-dired-cmd-pngnq-program " -f \"%t\"" - (unless image-dired-cmd-pngcrush-program - " ; mv %q %t"))) - (if image-dired-cmd-pngcrush-program - (concat - (unless image-dired-cmd-pngcrush-program - " ; cp %t %q") - " ; " image-dired-cmd-pngcrush-program " -q " - "-text b \"Description\" \"Thumbnail of file://%f\" " - "-text b \"Software\" \"" (emacs-version) "\" " - ;; "-text b \"Thumb::Image::Height\" \"%oh\" " - ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" " - ;; "-text b \"Thumb::Image::Width\" \"%ow\" " - "-text b \"Thumb::MTime\" \"%m\" " - ;; "-text b \"Thumb::Size\" \"%b\" " - "-text b \"Thumb::URI\" \"file://%f\" " - "%q %t" - " ; rm %q"))) - "Command to create thumbnails according to the Thumbnail Managing Standard." - :type 'string +(defcustom image-dired-cmd-pngcrush-options + `("-q" + "-text" "b" "Description" "Thumbnail of file://%f" + "-text" "b" "Software" ,(emacs-version) + ;; "-text b \"Thumb::Image::Height\" \"%oh\" " + ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" " + ;; "-text b \"Thumb::Image::Width\" \"%ow\" " + "-text" "b" "Thumb::MTime" "%m" + ;; "-text b \"Thumb::Size\" \"%b\" " + "-text" "b" "Thumb::URI" "file://%f" + "%q" "%t") + "Arguments for `image-dired-cmd-pngcrush-program'. +Available format specifiers are the same as in +`image-dired-cmd-create-thumbnail-options', with %q for a +temporary file name (typically generated by pnqnq)" + :version "26.1" + :type '(repeat (string :tag "Argument")) + :group 'image-dired) + +(defcustom image-dired-cmd-optipng-program (executable-find "optipng") + "The file name of the `optipng' program." + :type '(choice (const :tag "Not Set" nil) file) + :group 'image-dired) + +(defcustom image-dired-cmd-optipng-options '("-o5" "%t") + "Arguments passed to `image-dired-optipng-program'. +Available format specifiers are described in +`image-dired-cmd-create-thumbnail-options'." + :type '(repeat (string :tag "Argument")) + :link '(url-link "man:optipng(1)") + :group 'image-dired) + +(defcustom image-dired-cmd-create-standard-thumbnail-options + (append '("-size" "%wx%h" "%f") + (unless (or image-dired-cmd-pngcrush-program + image-dired-cmd-pngnq-program) + (list + "-set" "Thumb::MTime" "%m" + "-set" "Thumb::URI" "file://%f" + "-set" "Description" "Thumbnail of file://%f" + "-set" "Software" (emacs-version))) + '("-thumbnail" "%wx%h>" "png:%t")) + "Options for creating thumbnails according to the Thumbnail Managing Standard. +Available format specifiers are the same as in +`image-dired-cmd-create-thumbnail-options', with %m for file modification time." + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-cmd-rotate-thumbnail-program "mogrify" "Executable used to rotate thumbnail. Used together with `image-dired-cmd-rotate-thumbnail-options'." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-cmd-rotate-thumbnail-options - "%p -rotate %d \"%t\"" - "Format of command used to rotate thumbnail image. -Available options are %p which is replaced by -`image-dired-cmd-rotate-thumbnail-program', %d which is replaced by the + '("-rotate" "%d" "%t") + "Arguments of command used to rotate thumbnail image. +Used with `image-dired-cmd-rotate-thumbnail-program'. +Available format specifiers are: %d which is replaced by the number of (positive) degrees to rotate the image, normally 90 or 270 \(for 90 degrees right and left), %t which is replaced by the file name of the thumbnail file." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-cmd-rotate-original-program "jpegtran" "Executable used to rotate original image. Used together with `image-dired-cmd-rotate-original-options'." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-cmd-rotate-original-options - "%p -rotate %d -copy all -outfile %t \"%o\"" - "Format of command used to rotate original image. -Available options are %p which is replaced by -`image-dired-cmd-rotate-original-program', %d which is replaced by the + '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o") + "Arguments of command used to rotate original image. +Used with `image-dired-cmd-rotate-original-program'. +Available format specifiers are: %d which is replaced by the number of (positive) degrees to rotate the image, normally 90 or 270 \(for 90 degrees right and left), %o which is replaced by the original image file name and %t which is replaced by `image-dired-temp-image-file'." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-temp-rotate-image-file (expand-file-name ".image-dired_rotate_temp" image-dired-dir) "Temporary file for rotate operations." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-rotate-original-ask-before-overwrite t @@ -361,33 +388,35 @@ original file with `image-dired-temp-rotate-image-file'." "exiftool" "Program used to write EXIF data to image. Used together with `image-dired-cmd-write-exif-data-options'." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-cmd-write-exif-data-options - "%p -%t=\"%v\" \"%f\"" - "Format of command used to write EXIF data. -Available options are %p which is replaced by -`image-dired-cmd-write-exif-data-program', %f which is replaced by + '("-%t=%v" "%f") + "Arguments of command used to write EXIF data. +Used with `image-dired-cmd-write-exif-data-program'. +Available format specifiers are: %f which is replaced by the image file name, %t which is replaced by the tag name and %v which is replaced by the tag value." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-cmd-read-exif-data-program "exiftool" "Program used to read EXIF data to image. -Used together with `image-dired-cmd-read-exif-data-program-options'." - :type 'string +Used together with `image-dired-cmd-read-exif-data-options'." + :type 'file :group 'image-dired) (defcustom image-dired-cmd-read-exif-data-options - "%p -s -s -s -%t \"%f\"" - "Format of command used to read EXIF data. -Available options are %p which is replaced by -`image-dired-cmd-write-exif-data-program', %f which is replaced + '("-s" "-s" "-s" "-%t" "%f") + "Arguments of command used to read EXIF data. +Used with `image-dired-cmd-read-exif-data-program'. +Available format specifiers are: %f which is replaced by the image file name and %t which is replaced by the tag name." - :type 'string + :version "26.1" + :type '(repeat (string :tag "Argument")) :group 'image-dired) (defcustom image-dired-gallery-hidden-tags @@ -397,7 +426,11 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images." :type '(repeat string) :group 'image-dired) -(defcustom image-dired-thumb-size (if (eq 'standard image-dired-thumbnail-storage) 128 100) +(defcustom image-dired-thumb-size + (cond + ((eq 'standard image-dired-thumbnail-storage) 128) + ((eq 'standard-large image-dired-thumbnail-storage) 256) + (t 100)) "Size of thumbnails, in pixels. This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'." @@ -520,6 +553,7 @@ before warning the user." (defmacro image-dired--with-db-file (&rest body) "Run BODY in a temp buffer containing `image-dired-db-file'. Return the last form in BODY." + (declare (indent 0) (debug t)) `(with-temp-buffer (if (file-exists-p image-dired-db-file) (insert-file-contents image-dired-db-file)) @@ -537,7 +571,6 @@ Create the thumbnails directory if it does not exist." (defun image-dired-insert-image (file type relief margin) "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point." - (let ((i `(image :type ,type :file ,file :relief ,relief @@ -567,7 +600,8 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (setq beg (point)) (image-dired-insert-image file ;; TODO: this should depend on the real file type - (if (eq 'standard image-dired-thumbnail-storage) + (if (memq image-dired-thumbnail-storage + '(standard standard-large)) 'png 'jpeg) image-dired-thumb-relief image-dired-thumb-margin) @@ -589,10 +623,16 @@ MD5-hash of the image file's directory name and add that to make the thumbnail file name unique. For per-directory storage, just add a subdirectory. For standard storage, produce the file name according to the Thumbnail Managing Standard." - (cond ((eq 'standard image-dired-thumbnail-storage) - (expand-file-name - (concat "~/.thumbnails/normal/" - (md5 (concat "file://" (expand-file-name file))) ".png"))) + (cond ((memq image-dired-thumbnail-storage '(standard standard-large)) + (let* ((xdg (getenv "XDG_CACHE_HOME")) + (dir (if (and xdg (file-name-absolute-p xdg)) + xdg "~/.cache")) + (thumbdir (cl-case image-dired-thumbnail-storage + (standard "thumbnails/normal") + (standard-large "thumbnails/large")))) + (expand-file-name + (concat (md5 (concat "file://" (expand-file-name file))) ".png") + (expand-file-name thumbdir dir)))) ((eq 'use-image-dired-dir image-dired-thumbnail-storage) (let* ((f (expand-file-name file)) (md5-hash @@ -613,33 +653,173 @@ according to the Thumbnail Managing Standard." (file-name-base f) (file-name-extension f)))))) -(defun image-dired-create-thumb (original-file thumbnail-file) +(defun image-dired--check-executable-exists (executable) + (unless (executable-find (symbol-value executable)) + (error "Executable %S not found" executable))) + +(defun image-dired-thumb-size (dimension) + "Return thumb size depending on `image-dired-thumbnail-storage'. +DIMENSION should be either the symbol 'width or 'height." + (cond + ((eq 'standard image-dired-thumbnail-storage) 128) + ((eq 'standard-large image-dired-thumbnail-storage) 256) + (t (cl-ecase dimension + (width image-dired-thumb-width) + (height image-dired-thumb-height))))) + +(defvar image-dired-queue nil + "List of items in the queue. +Each item has the form (ORIGINAL-FILE TARGET-FILE).") + +(defvar image-dired-queue-active-jobs 0 + "Number of active jobs in `image-dired-queue'.") + +(defvar image-dired-queue-active-limit 2 + "Maximum number of concurrent jobs permitted for generating images. +Increase at own risk.") + +(defun image-dired-pngnq-thumb (spec) + "Quantize thumbnail described by format SPEC with pngnq(1)." + (let ((process + (apply #'start-process "image-dired-pngnq" nil + image-dired-cmd-pngnq-program + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-pngnq-options)))) + (setf (process-sentinel process) + (lambda (process status) + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + ;; Pass off to pngcrush, or just rename the + ;; THUMB-nq8.png file back to THUMB.png + (if (and image-dired-cmd-pngcrush-program + (executable-find image-dired-cmd-pngcrush-program)) + (image-dired-pngcrush-thumb spec) + (let ((nq8 (cdr (assq ?q spec))) + (thumb (cdr (assq ?t spec)))) + (rename-file nq8 thumb t))) + (message "command %S %s" (process-command process) + (replace-regexp-in-string "\n" "" status))))) + process)) + +(defun image-dired-pngcrush-thumb (spec) + "Optimize thumbnail described by format SPEC with pngcrush(1)." + ;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist. + ;; pngcrush needs an infile and outfile, so we just copy THUMB to + ;; THUMB-nq8.png and use the latter as a temp file. + (when (not image-dired-cmd-pngnq-program) + (let ((temp (cdr (assq ?q spec))) + (thumb (cdr (assq ?t spec)))) + (copy-file thumb temp))) + (let ((process + (apply #'start-process "image-dired-pngcrush" nil + image-dired-cmd-pngcrush-program + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-pngcrush-options)))) + (setf (process-sentinel process) + (lambda (process status) + (unless (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "command %S %s" (process-command process) + (replace-regexp-in-string "\n" "" status))) + (when (memq (process-status process) '(exit signal)) + (let ((temp (cdr (assq ?q spec)))) + (delete-file temp))))) + process)) + +(defun image-dired-optipng-thumb (spec) + "Optimize thumbnail described by format SPEC with optipng(1)." + (let ((process + (apply #'start-process "image-dired-optipng" nil + image-dired-cmd-optipng-program + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-optipng-options)))) + (setf (process-sentinel process) + (lambda (process status) + (unless (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "command %S %s" (process-command process) + (replace-regexp-in-string "\n" "" status))))) + process)) + +(defun image-dired-create-thumb-1 (original-file thumbnail-file) "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE." - (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 - original-file))))) + (image-dired--check-executable-exists + 'image-dired-cmd-create-thumbnail-program) + (let* ((width (int-to-string (image-dired-thumb-size 'width))) + (height (int-to-string (image-dired-thumb-size 'height))) + (modif-time (floor (float-time (nth 5 (file-attributes original-file))))) (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" thumbnail-file)) - (command - (format-spec - (if (eq 'standard image-dired-thumbnail-storage) - image-dired-cmd-create-standard-thumbnail-command - image-dired-cmd-create-thumbnail-options) - (list - (cons ?p image-dired-cmd-create-thumbnail-program) - (cons ?w width) - (cons ?h height) - (cons ?m modif-time) - (cons ?f original-file) - (cons ?q thumbnail-nq8-file) - (cons ?t thumbnail-file)))) - thumbnail-dir) - (when (not (file-exists-p - (setq thumbnail-dir (file-name-directory thumbnail-file)))) - (message "Creating thumbnail directory.") - (make-directory thumbnail-dir)) - (call-process shell-file-name nil nil nil shell-command-switch command))) + (spec + (list + (cons ?w width) + (cons ?h height) + (cons ?m modif-time) + (cons ?f original-file) + (cons ?q thumbnail-nq8-file) + (cons ?t thumbnail-file))) + (thumbnail-dir (file-name-directory thumbnail-file)) + process) + (when (not (file-exists-p thumbnail-dir)) + (message "Creating thumbnail directory") + (make-directory thumbnail-dir t) + (set-file-modes thumbnail-dir #o700)) + + ;; Thumbnail file creation processes begin here and are marshaled + ;; in a queue by `image-dired-create-thumb'. + (setq process + (apply #'start-process "image-dired-create-thumbnail" nil + image-dired-cmd-create-thumbnail-program + (mapcar + (lambda (arg) (format-spec arg spec)) + (if (memq image-dired-thumbnail-storage + '(standard standard-large)) + image-dired-cmd-create-standard-thumbnail-options + image-dired-cmd-create-thumbnail-options)))) + + (setf (process-sentinel process) + (lambda (process status) + ;; Trigger next in queue once a thumbnail has been created + (cl-decf image-dired-queue-active-jobs) + (image-dired-thumb-queue-run) + (if (not (and (eq (process-status process) 'exit) + (zerop (process-exit-status process)))) + (message "Thumb could not be created for %s: %s" + (abbreviate-file-name original-file) + (replace-regexp-in-string "\n" "" status)) + (set-file-modes thumbnail-file #o600) + (clear-image-cache thumbnail-file) + ;; PNG thumbnail has been created since we are + ;; following the XDG thumbnail spec, so try to optimize + (when (memq image-dired-thumbnail-storage + '(standard standard-large)) + (cond + ((and image-dired-cmd-pngnq-program + (executable-find image-dired-cmd-pngnq-program)) + (image-dired-pngnq-thumb spec)) + ((and image-dired-cmd-pngcrush-program + (executable-find image-dired-cmd-pngcrush-program)) + (image-dired-pngcrush-thumb spec)) + ((and image-dired-cmd-optipng-program + (executable-find image-dired-cmd-optipng-program)) + (image-dired-optipng-thumb spec))))))) + process)) + +(defun image-dired-thumb-queue-run () + "Run a queued job if one exists and not too many jobs are running. +Queued items live in `image-dired-queue'." + (while (and image-dired-queue + (< image-dired-queue-active-jobs + image-dired-queue-active-limit)) + (cl-incf image-dired-queue-active-jobs) + (apply #'image-dired-create-thumb-1 (pop image-dired-queue)))) + +(defun image-dired-create-thumb (original-file thumbnail-file) + "Add a job for generating thumbnail to `image-dired-queue'." + (setq image-dired-queue + (nconc image-dired-queue + (list (list original-file thumbnail-file)))) + (run-at-time 0 nil #'image-dired-thumb-queue-run)) ;;;###autoload (defun image-dired-dired-toggle-marked-thumbs (&optional arg) @@ -650,25 +830,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 +970,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 +1017,14 @@ 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)) + (when (not (file-exists-p thumb-name)) + (image-dired-create-thumb curr-file thumb-name)) + (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 +1034,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 +1042,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))) @@ -1023,6 +1197,12 @@ With prefix argument ARG, remove tag from file at point." "Get original file name for thumbnail or display image at point." (get-text-property (point) 'original-file-name)) +(defun image-dired-file-name-at-point () + "Get abbreviated file name for thumbnail or display image at point." + (let ((f (image-dired-original-file-name))) + (when f + (abbreviate-file-name f)))) + (defun image-dired-associated-dired-buffer () "Get associated dired buffer at point." (get-text-property (point) 'associated-dired-buffer)) @@ -1104,7 +1284,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 +1305,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) @@ -1143,7 +1323,9 @@ image." (defun image-dired-next-line () "Move to next line and display properties." (interactive) - (forward-line 1) + (let ((goal-column (current-column))) + (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)) @@ -1155,7 +1337,9 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." (interactive) - (forward-line -1) + (let ((goal-column (current-column))) + (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 @@ -1169,14 +1353,14 @@ image." (defun image-dired-format-properties-string (buf file props comment) "Format display properties. BUF is the associated dired buffer, FILE is the original image file -name, PROPS is a list of tags and COMMENT is the image file's +name, PROPS is a stringified list of tags and COMMENT is the image file's comment." (format-spec image-dired-display-properties-format (list (cons ?b (or buf "")) (cons ?f file) - (cons ?t (or (princ props) "")) + (cons ?t (or props "")) (cons ?c (or comment ""))))) (defun image-dired-display-thumb-properties () @@ -1184,11 +1368,9 @@ comment." (if (not (eobp)) (let ((file-name (file-name-nondirectory (image-dired-original-file-name))) (dired-buf (buffer-name (image-dired-associated-dired-buffer))) - (props (mapconcat - 'princ - (get-text-property (point) 'tags) - ", ")) - (comment (get-text-property (point) 'comment))) + (props (mapconcat #'identity (get-text-property (point) 'tags) ", ")) + (comment (get-text-property (point) 'comment)) + (message-log-max nil)) (if file-name (message "%s" (image-dired-format-properties-string @@ -1274,197 +1456,140 @@ 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"))) - - (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) - "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)) +(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) + + ;; 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" quit-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'.") - ) +(defvar image-dired-display-image-mode-map + (let ((map (make-sparse-keymap))) + ;; `image-mode-map' has bindings that do not make sense in image-dired + ;; (set-keymap-parent map image-mode-map) + (define-key map "f" 'image-dired-display-current-image-full) + (define-key map "s" 'image-dired-display-current-image-sized) + (define-key map "g" nil) + + ;; Useful bindings from `image-mode-map' + (define-key map [remap forward-char] 'image-forward-hscroll) + (define-key map [remap backward-char] 'image-backward-hscroll) + (define-key map [remap right-char] 'image-forward-hscroll) + (define-key map [remap left-char] 'image-backward-hscroll) + (define-key map [remap previous-line] 'image-previous-line) + (define-key map [remap next-line] 'image-next-line) + (define-key map [remap scroll-up] 'image-scroll-up) + (define-key map [remap scroll-down] 'image-scroll-down) + (define-key map [remap scroll-up-command] 'image-scroll-up) + (define-key map [remap scroll-down-command] 'image-scroll-down) + (define-key map [remap scroll-left] 'image-scroll-left) + (define-key map [remap scroll-right] 'image-scroll-right) + (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) + + (easy-menu-define nil map + "Menu for `image-dired-display-image-mode-map'." + '("Image-Dired" + ["Quit" quit-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-display-current-image-full () "Display current image in full size." @@ -1483,116 +1608,85 @@ 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 - fundamental-mode "image-dired-thumbnail" + special-mode "image-dired-thumbnail" "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")) +Use `image-dired-minor-mode' to get a nice setup." + :group 'image-dired + (buffer-disable-undo) + (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) (define-derived-mode image-dired-display-image-mode - fundamental-mode "image-dired-image-display" + special-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")) + :group 'image-dired + (buffer-disable-undo) + (image-mode-setup-winprops) + (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) + +(defvar image-dired-minor-mode-map + (let ((map (make-sparse-keymap))) + ;; (set-keymap-parent map dired-mode-map) + ;; Hijack previous and next line movement. Let C-p and C-b be + ;; though... + (define-key map "p" 'image-dired-dired-previous-line) + (define-key map "n" 'image-dired-dired-next-line) + (define-key map [up] 'image-dired-dired-previous-line) + (define-key map [down] 'image-dired-dired-next-line) + + (define-key map (kbd "C-S-n") 'image-dired-next-line-and-display) + (define-key map (kbd "C-S-p") 'image-dired-previous-line-and-display) + (define-key map (kbd "C-S-m") 'image-dired-mark-and-display-next) + + (define-key map "\C-td" 'image-dired-display-thumbs) + (define-key map [tab] 'image-dired-jump-thumbnail-buffer) + (define-key map "\C-ti" 'image-dired-dired-display-image) + (define-key map "\C-tx" 'image-dired-dired-display-external) + (define-key map "\C-ta" 'image-dired-display-thumbs-append) + (define-key map "\C-t." 'image-dired-display-thumb) + (define-key map "\C-tc" 'image-dired-dired-comment-files) + (define-key map "\C-tf" 'image-dired-mark-tagged-files) + + ;; Menu for dired + (easy-menu-define nil map + "Menu for `image-dired-minor-mode'." + '("Image-dired" + ["Copy with EXIF file name" image-dired-copy-with-exif-file-name] + ["Comment files" image-dired-dired-comment-files] + ["Mark tagged files" image-dired-mark-tagged-files] + ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] + + ["Toggle movement tracking" image-dired-toggle-movement-tracking] + ["Toggle append browsing" image-dired-toggle-append-browsing] + ["Toggle display properties" image-dired-toggle-dired-display-properties] + + ["Display in external viewer" image-dired-dired-display-external] + ["Display image" image-dired-dired-display-image] + ["Display this thumbnail" image-dired-display-thumb] + ["Display thumbnails append" image-dired-display-thumbs-append] + + ["Create thumbnails for marked files" image-dired-create-thumbs] + + ["Mark and display next" image-dired-mark-and-display-next] + ["Display thumb for previous file" image-dired-previous-line-and-display] + ["Display thumb for next file" image-dired-next-line-and-display])) + map) + "Keymap for `image-dired-minor-mode'.") ;;;###autoload -(defun image-dired-setup-dired-keybindings () +(define-minor-mode image-dired-minor-mode "Setup easy-to-use keybindings for the commands to be used in dired mode. Note that n, p and <down> and <up> will be hijacked and bound to `image-dired-dired-x-line'." - (interactive) + :keymap image-dired-minor-mode-map) - ;; Hijack previous and next line movement. Let C-p and C-b be - ;; though... - - (define-key dired-mode-map "p" 'image-dired-dired-previous-line) - (define-key dired-mode-map "n" 'image-dired-dired-next-line) - (define-key dired-mode-map [up] 'image-dired-dired-previous-line) - (define-key dired-mode-map [down] 'image-dired-dired-next-line) - - (define-key dired-mode-map (kbd "C-S-n") 'image-dired-next-line-and-display) - (define-key dired-mode-map (kbd "C-S-p") 'image-dired-previous-line-and-display) - (define-key dired-mode-map (kbd "C-S-m") 'image-dired-mark-and-display-next) - - (define-key dired-mode-map "\C-td" 'image-dired-display-thumbs) - (define-key dired-mode-map "\C-tt" 'image-dired-tag-files) - (define-key dired-mode-map "\C-tr" 'image-dired-delete-tag) - (define-key dired-mode-map [tab] 'image-dired-jump-thumbnail-buffer) - (define-key dired-mode-map "\C-ti" 'image-dired-dired-display-image) - (define-key dired-mode-map "\C-tx" 'image-dired-dired-display-external) - (define-key dired-mode-map "\C-ta" 'image-dired-display-thumbs-append) - (define-key dired-mode-map "\C-t." 'image-dired-display-thumb) - (define-key dired-mode-map "\C-tc" 'image-dired-dired-comment-files) - (define-key dired-mode-map "\C-tf" 'image-dired-mark-tagged-files) - - ;; Menu for dired - (define-key dired-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) - - (define-key dired-mode-map [menu-bar image-dired image-dired-copy-with-exif-file-name] - '("Copy with EXIF file name" . image-dired-copy-with-exif-file-name)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-dired-comment-files] - '("Comment files" . image-dired-dired-comment-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-mark-tagged-files] - '("Mark tagged files" . image-dired-mark-tagged-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-delete-tag] - '("Remove tag from files" . image-dired-delete-tag)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-tag-files] - '("Tag files" . image-dired-tag-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-jump-thumbnail-buffer] - '("Jump to thumbnail buffer" . image-dired-jump-thumbnail-buffer)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-toggle-movement-tracking] - '("Toggle movement tracking" . image-dired-toggle-movement-tracking)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-toggle-append-browsing] - '("Toggle append browsing" . image-dired-toggle-append-browsing)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-toggle-disp-props] - '("Toggle display properties" . image-dired-toggle-dired-display-properties)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-dired-display-external] - '("Display in external viewer" . image-dired-dired-display-external)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-dired-display-image] - '("Display image" . image-dired-dired-display-image)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumb] - '("Display this thumbnail" . image-dired-display-thumb)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumbs-append] - '("Display thumbnails append" . image-dired-display-thumbs-append)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumbs] - '("Display thumbnails" . image-dired-display-thumbs)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-create-thumbs] - '("Create thumbnails for marked files" . image-dired-create-thumbs)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-mark-and-display-next] - '("Mark and display next" . image-dired-mark-and-display-next)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-previous-line-and-display] - '("Display thumb for previous file" . image-dired-previous-line-and-display)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-next-line-and-display] - '("Display thumb for next file" . image-dired-next-line-and-display))) +;;;###autoload +(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode + "26.1") (declare-function clear-image-cache "image.c" (&optional filter)) @@ -1601,22 +1695,17 @@ 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. + (when arg + (clear-image-cache (expand-file-name thumb-name))) + (when (or (not (file-exists-p thumb-name)) + arg) + (image-dired-create-thumb curr-file thumb-name))))) (defvar image-dired-slideshow-timer nil "Slideshow timer.") @@ -1714,7 +1803,8 @@ Calculate how many thumbnails fit." (/ width (+ (* 2 image-dired-thumb-relief) (* 2 image-dired-thumb-margin) - image-dired-thumb-width char-width)))) + (image-dired-thumb-size 'width) + char-width)))) (image-dired-line-up))) (defun image-dired-line-up-interactive () @@ -1735,16 +1825,16 @@ Ask user how many thumbnails should be displayed per row." (message "No thumbnail at point") (if (not file) (message "No original file name found") - (call-process shell-file-name nil nil nil shell-command-switch - (format "%s \"%s\"" image-dired-external-viewer file)))))) + (start-process "image-dired-thumb-external" nil + image-dired-external-viewer file))))) ;;;###autoload (defun image-dired-dired-display-external () "Display file at point using an external viewer." (interactive) (let ((file (dired-get-filename))) - (call-process shell-file-name nil nil nil shell-command-switch - (format "%s \"%s\"" image-dired-external-viewer file)))) + (start-process "image-dired-external" nil + image-dired-external-viewer file))) (defun image-dired-window-width-pixels (window) "Calculate WINDOW width in pixels." @@ -1780,14 +1870,14 @@ Ask user how many thumbnails should be displayed per row." (equal (window-buffer window) buf)))) (error "No thumbnail image at point")))) -(defun image-dired-display-window-width () - "Return width, in pixels, of image-dired's image display window." - (- (image-dired-window-width-pixels (image-dired-display-window)) +(defun image-dired-display-window-width (window) + "Return width, in pixels, of WINDOW." + (- (image-dired-window-width-pixels window) image-dired-display-window-width-correction)) -(defun image-dired-display-window-height () - "Return height, in pixels, of image-dired's image display window." - (- (image-dired-window-height-pixels (image-dired-display-window)) +(defun image-dired-display-window-height (window) + "Return height, in pixels, of WINDOW." + (- (image-dired-window-height-pixels window) image-dired-display-window-height-correction)) (defun image-dired-display-image (file &optional original-size) @@ -1800,27 +1890,28 @@ 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 + (window (image-dired-display-window)) (image-type 'jpeg)) (setq file (expand-file-name file)) (if (not original-size) - (progn - (setq width (image-dired-display-window-width)) - (setq height (image-dired-display-window-height)) - (setq command - (format-spec - image-dired-cmd-create-temp-image-options - (list - (cons ?p image-dired-cmd-create-temp-image-program) - (cons ?w width) - (cons ?h height) - (cons ?f file) - (cons ?t new-file)))) - (setq ret (call-process shell-file-name nil nil nil - shell-command-switch command)) - (if (not (= 0 ret)) - (error "Could not resize image"))) + (let* ((spec + (list + (cons ?p image-dired-cmd-create-temp-image-program) + (cons ?w (image-dired-display-window-width window)) + (cons ?h (image-dired-display-window-height window)) + (cons ?f file) + (cons ?t new-file))) + (ret + (apply #'call-process + image-dired-cmd-create-temp-image-program nil nil nil + (mapcar + (lambda (arg) (format-spec arg spec)) + image-dired-cmd-create-temp-image-options)))) + (when (not (zerop ret)) + (error "Could not resize image"))) (setq image-type (image-type-from-file-name file)) (copy-file file new-file t)) (with-current-buffer (image-dired-create-display-image-buffer) @@ -1829,6 +1920,8 @@ original size." (clear-image-cache) (image-dired-insert-image image-dired-temp-image-file image-type 0 0) (goto-char (point-min)) + (set-window-vscroll window 0) + (set-window-hscroll window 0) (image-dired-update-property 'original-file-name file))))) (defun image-dired-display-thumbnail-original-image (&optional arg) @@ -1864,20 +1957,17 @@ 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))) - command) - (setq command (format-spec - image-dired-cmd-rotate-thumbnail-options - (list - (cons ?p image-dired-cmd-rotate-thumbnail-program) - (cons ?d degrees) - (cons ?t (expand-file-name file))))) - (call-process shell-file-name nil nil nil shell-command-switch command) - ;; Clear the cache to refresh image. I wish I could just refresh - ;; the current file but I do not know how to do that. Yet... - (clear-image-cache)))) + (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) + (thumb (expand-file-name file)) + (spec (list (cons ?d degrees) (cons ?t thumb)))) + (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-rotate-thumbnail-options)) + (clear-image-cache thumb)))) (defun image-dired-rotate-thumbnail-left () "Rotate thumbnail left (counter clockwise) 90 degrees. @@ -1900,27 +1990,29 @@ overwritten. This confirmation can be turned off using (defun image-dired-refresh-thumb () "Force creation of new image for current thumbnail." (interactive) - (let ((file (image-dired-original-file-name))) - (clear-image-cache) - (image-dired-create-thumb file (image-dired-thumb-name file)))) + (let* ((file (image-dired-original-file-name)) + (thumb (expand-file-name (image-dired-thumb-name file)))) + (clear-image-cache (expand-file-name thumb)) + (image-dired-create-thumb file thumb))) (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!")) - (setq command (format-spec - image-dired-cmd-rotate-original-options - (list - (cons ?p image-dired-cmd-rotate-original-program) - (cons ?d degrees) - (cons ?o (expand-file-name file)) - (cons ?t image-dired-temp-rotate-image-file)))) - (if (not (= 0 (call-process shell-file-name nil nil nil - shell-command-switch command))) + (let* ((file (image-dired-original-file-name)) + (spec + (list + (cons ?d degrees) + (cons ?o (expand-file-name file)) + (cons ?t image-dired-temp-rotate-image-file)))) + (unless (eq 'jpeg (image-type file)) + (error "Only JPEG images can be rotated!")) + (if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program + nil nil nil + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-rotate-original-options)))) (error "Could not rotate image") (image-dired-display-image image-dired-temp-rotate-image-file) (if (or (and image-dired-rotate-original-ask-before-overwrite @@ -1950,15 +2042,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 @@ -1985,30 +2076,32 @@ 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." - (let (command) - (setq command (format-spec - image-dired-cmd-write-exif-data-options - (list - (cons ?p image-dired-cmd-write-exif-data-program) - (cons ?f (expand-file-name file)) - (cons ?t tag-name) - (cons ?v tag-value)))) - (call-process shell-file-name nil nil nil shell-command-switch command))) + (image-dired--check-executable-exists + 'image-dired-cmd-write-exif-data-program) + (let ((spec + (list + (cons ?f (expand-file-name file)) + (cons ?t tag-name) + (cons ?v tag-value)))) + (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-write-exif-data-options)))) (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 - image-dired-cmd-read-exif-data-options - (list - (cons ?p image-dired-cmd-read-exif-data-program) - (cons ?f file) - (cons ?t tag-name)))) + (spec (list (cons ?f file) (cons ?t tag-name))) + tag-value) (with-current-buffer buf (delete-region (point-min) (point-max)) - (if (not (eq (call-process shell-file-name nil t nil - shell-command-switch command) 0)) + (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program + nil t nil + (mapcar + (lambda (arg) (format-spec arg spec)) + image-dired-cmd-read-exif-data-options)) + 0)) (error "Could not get EXIF tag") (goto-char (point-min)) ;; Clean buffer from newlines and carriage returns before @@ -2034,7 +2127,7 @@ function. The result is a couple of new files in (interactive) (let (new-name (files (dired-get-marked-files))) - (mapcar + (mapc (lambda (curr-file) (setq new-name (format "%s/%s" @@ -2226,11 +2319,9 @@ non-nil." (let* ((file (dired-get-filename)) (file-name (file-name-nondirectory file)) (dired-buf (buffer-name (current-buffer))) - (props (mapconcat - 'princ - (image-dired-list-tags file) - ", ")) - (comment (image-dired-get-comment file))) + (props (mapconcat #'identity (image-dired-list-tags file) ", ")) + (comment (image-dired-get-comment file)) + (message-log-max nil)) (if file-name (message "%s" (image-dired-format-properties-string @@ -2344,13 +2435,8 @@ image-dired-file-comment-list: (defun image-dired-hidden-p (file) "Return t if image FILE has a \"hidden\" tag." - (let (hidden) - (mapc - (lambda (tag) - (if (member tag image-dired-gallery-hidden-tags) - (setq hidden t))) - (cdr (assoc file image-dired-file-tag-list))) - hidden)) + (cl-loop for tag in (cdr (assoc file image-dired-file-tag-list)) + if (member tag image-dired-gallery-hidden-tags) return t)) (defun image-dired-gallery-generate () "Generate gallery pages. @@ -2442,15 +2528,6 @@ when using per-directory thumbnail file storage")) (insert " </body>\n") (insert "</html>")))) -(defun image-dired-kill-buffer-and-window () - "Kill the current buffer and, if possible, also the window." - (interactive) - (let ((buffer (current-buffer))) - (condition-case nil - (delete-window (selected-window)) - (error nil)) - (kill-buffer buffer))) - (defvar image-dired-widget-list nil "List to keep track of meta data in edit buffer.") @@ -2465,7 +2542,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)) @@ -2500,8 +2577,7 @@ the operation by activating the Cancel button.\n\n") :size 60 :format "%v " :value (or (mapconcat - (lambda (tag) - tag) + #'identity (image-dired-list-tags file) ",") ""))) ;; Save information in all widgets so that we can use it when diff --git a/lisp/image-mode.el b/lisp/image-mode.el index e549b49001e..4a7178d18af 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -24,8 +24,8 @@ ;;; Commentary: ;; Defines a major mode for visiting image files -;; that allows conversion between viewing the text of the file -;; and viewing the file as an image. Viewing the image +;; that allows conversion between viewing the text of the file, +;; hex of the file and viewing the file as an image. Viewing the image ;; works by putting a `display' text-property on the ;; image data, with the image-data still present underneath; if the ;; resulting buffer file is saved to another name it will correctly save @@ -43,7 +43,10 @@ ;;; Image mode window-info management. -(defvar-local image-mode-winprops-alist t) +(defvar-local image-mode-winprops-alist t + "Alist of windows to window properties. +Each element has the form (WINDOW . ALIST). +See `image-mode-winprops'.") (defvar image-mode-new-window-functions nil "Special hook run when image data is requested in a new window. @@ -270,6 +273,48 @@ When calling from a program, supply as argument a number, nil, or `-'." (max 0 (- win-height next-screen-context-lines))))) (t (image-next-line (- (prefix-numeric-value n)))))) +(defun image-scroll-left (&optional n) + "Scroll image in current window leftward by N character widths. +Stop if the right edge of the image is reached. +If ARG is omitted or nil, scroll leftward by a near full screen. +A near full screen is 2 columns less than a full screen. +Negative ARG means scroll rightward. +If ARG is the atom `-', scroll rightward by nearly full screen. +When calling from a program, supply as argument a number, nil, or `-'." + (interactive "P") + (cond ((null n) + (let* ((edges (window-inside-edges)) + (win-width (- (nth 2 edges) (nth 0 edges)))) + (image-forward-hscroll + (max 0 (- win-width 2))))) + ((eq n '-) + (let* ((edges (window-inside-edges)) + (win-width (- (nth 2 edges) (nth 0 edges)))) + (image-forward-hscroll + (min 0 (- 2 win-width))))) + (t (image-forward-hscroll (prefix-numeric-value n))))) + +(defun image-scroll-right (&optional n) + "Scroll image in current window rightward by N character widths. +Stop if the left edge of the image is reached. +If ARG is omitted or nil, scroll downward by a near full screen. +A near full screen is 2 less than a full screen. +Negative ARG means scroll leftward. +If ARG is the atom `-', scroll leftward by nearly full screen. +When calling from a program, supply as argument a number, nil, or `-'." + (interactive "P") + (cond ((null n) + (let* ((edges (window-inside-edges)) + (win-width (- (nth 2 edges) (nth 0 edges)))) + (image-forward-hscroll + (min 0 (- 2 win-width))))) + ((eq n '-) + (let* ((edges (window-inside-edges)) + (win-width (- (nth 2 edges) (nth 0 edges)))) + (image-forward-hscroll + (max 0 (- win-width 2))))) + (t (image-forward-hscroll (- (prefix-numeric-value n)))))) + (defun image-bol (arg) "Scroll horizontally to the left edge of the image in the current window. With argument ARG not nil or 1, move forward ARG - 1 lines first, @@ -372,8 +417,8 @@ call." (defvar image-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map special-mode-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) (define-key map (kbd "S-SPC") 'image-scroll-down) (define-key map (kbd "DEL") 'image-scroll-down) @@ -398,6 +443,8 @@ call." (define-key map [remap scroll-down] 'image-scroll-down) (define-key map [remap scroll-up-command] 'image-scroll-up) (define-key map [remap scroll-down-command] 'image-scroll-down) + (define-key map [remap scroll-left] 'image-scroll-left) + (define-key map [remap scroll-right] 'image-scroll-right) (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) @@ -406,6 +453,8 @@ call." '("Image" ["Show as Text" image-toggle-display :active t :help "Show image as text"] + ["Show as Hex" image-toggle-hex-display :active t + :help "Show image as hex"] "--" ["Fit to Window Height" image-transform-fit-to-height :visible (eq image-type 'imagemagick) @@ -474,12 +523,13 @@ 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 (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'image-toggle-display) + (define-key map "\C-c\C-x" 'image-toggle-hex-display) map) "Mode keymap for `image-minor-mode'.") @@ -490,8 +540,8 @@ call." ;;;###autoload (defun image-mode () "Major mode for image files. -You can use \\<image-mode-map>\\[image-toggle-display] -to toggle between display as an image and display as text. +You can use \\<image-mode-map>\\[image-toggle-display] or \\<image-mode-map>\\[image-toggle-hex-display] +to toggle between display as an image and display as text or hex. Key bindings: \\{image-mode-map}" @@ -530,7 +580,7 @@ Key bindings: (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) (msg1 (substitute-command-keys - "Type \\[image-toggle-display] to view the image as ")) + "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as ")) animated) (cond ((null image) @@ -559,7 +609,7 @@ mouse-3: Previous frame" ;;; (substitute-command-keys ;;; "\\[image-toggle-animation] to animate.")))) (t - (message "%s" (concat msg1 "text.")))))) + (message "%s" (concat msg1 "text or hex.")))))) (error (image-mode-as-text) @@ -585,19 +635,10 @@ actual image." (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t))) ;;;###autoload -(defun image-mode-as-text () +(defun image-mode-to-text () "Set a non-image mode as major mode in combination with image minor mode. -A non-image major mode found from `auto-mode-alist' or Fundamental mode -displays an image file as text. `image-minor-mode' provides the key -\\<image-mode-map>\\[image-toggle-display] to switch back to `image-mode' -to display an image file as the actual image. - -You can use `image-mode-as-text' in `auto-mode-alist' when you want -to display an image file as text initially. - -See commands `image-mode' and `image-minor-mode' for more information -on these modes." - (interactive) +A non-mage major mode found from `auto-mode-alist' or fundamental mode +displays an image file as text." ;; image-mode-as-text = normal-mode + image-minor-mode (let ((previous-image-type image-type)) ; preserve `image-type' (if image-mode-previous-major-mode @@ -625,12 +666,49 @@ on these modes." ;; Enable image minor mode with `C-c C-c'. (image-minor-mode 1) ;; Show the image file as text. - (image-toggle-display-text) - (message "%s" (concat - (substitute-command-keys - "Type \\[image-toggle-display] to view the image as ") - (if (image-get-display-property) - "text" "an image") ".")))) + (image-toggle-display-text))) + +(defun image-mode-as-hex () + "Set a non-image mode as major mode in combination with image minor mode. +A non-mage major mode found from `auto-mode-alist' or fundamental mode +displays an image file as hex. `image-minor-mode' provides the key +\\<image-mode-map>\\[image-toggle-hex-display] to switch back to `image-mode' +to display an image file as the actual image. + +You can use `image-mode-as-hex' in `auto-mode-alist' when you want to +to display an image file as hex initially. + +See commands `image-mode' and `image-minor-mode' for more information +on these modes." + (interactive) + (image-mode-to-text) + ;; Turn on hexl-mode + (hexl-mode) + (message "%s" (concat + (substitute-command-keys + "Type \\[image-toggle-hex-display] or \\[image-toggle-display] to view the image as ") + (if (image-get-display-property) + "hex" "an image or text") "."))) + +(defun image-mode-as-text () + "Set a non-image mode as major mode in combination with image minor mode. +A non-image major mode found from `auto-mode-alist' or Fundamental mode +displays an image file as text. `image-minor-mode' provides the key +\\<image-mode-map>\\[image-toggle-display] to switch back to `image-mode' +to display an image file as the actual image. + +You can use `image-mode-as-text' in `auto-mode-alist' when you want +to display an image file as text initially. + +See commands `image-mode' and `image-minor-mode' for more information +on these modes." + (interactive) + (image-mode-to-text) + (message "%s" (concat + (substitute-command-keys + "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as ") + (if (image-get-display-property) + "text" "an image or hex") "."))) (define-obsolete-function-alias 'image-mode-maybe 'image-mode "23.2") @@ -725,15 +803,27 @@ was inserted." (if (called-interactively-p 'any) (message "Repeat this command to go back to displaying the file as text")))) +(defun image-toggle-hex-display () + "Toggle between image and hex display." + (interactive) + (if (image-get-display-property) + (image-mode-as-hex) + (if (eq major-mode 'fundamental-mode) + (image-mode-as-hex) + (image-mode)))) + (defun image-toggle-display () "Toggle between image and text display. + If the current buffer is displaying an image file as an image, -call `image-mode-as-text' to switch to text. Otherwise, display -the image by calling `image-mode'." +call `image-mode-as-text' to switch to text or hex display. +Otherwise, display the image by calling `image-mode'" (interactive) (if (image-get-display-property) (image-mode-as-text) - (image-mode))) + (if (eq major-mode 'hexl-mode) + (image-mode-as-text) + (image-mode)))) (defun image-kill-buffer () "Kill the current buffer." @@ -741,6 +831,9 @@ 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 663afa7764e..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,8 +123,28 @@ 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. +This is not supported for all image types, and is mostly useful +when you have a high-resolution monitor. +The value is either a floating point number (where numbers higher +than 1 means to increase the size and lower means to shrink the +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)) + :version "26.1") + +;; Map put into text properties on images. +(defvar image-map + (let ((map (make-sparse-keymap))) + (define-key map "-" 'image-decrease-size) + (define-key map "+" 'image-increase-size) + (define-key map "r" 'image-rotate) + (define-key map "o" 'image-save) + map)) (defun image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -324,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) @@ -409,8 +428,48 @@ Image file names that are not absolute are searched for in the (setq type (image-type file-or-data type data-p)) (when (image-type-available-p type) (append (list 'image :type type (if data-p :data :file) file-or-data) + (and (not (plist-get props :scale)) + (list :scale + (image-compute-scaling-factor image-scaling-factor))) props))) +(defun image--set-property (image property value) + "Set PROPERTY in IMAGE to VALUE. +Internal use only." + (if (null value) + (while (cdr image) + ;; IMAGE starts with the symbol `image', and the rest is a + ;; plist. Decouple plist entries where the key matches + ;; the property. + (if (eq (cadr image) property) + (setcdr image (cddr image)) + (setq image (cddr image)))) + ;; Just enter the new value. + (plist-put (cdr image) property value)) + value) + +(defun image-property (image property) + "Return the value of PROPERTY in IMAGE. +Properties can be set with + + (setf (image-property IMAGE PROPERTY) VALUE) +If VALUE is nil, PROPERTY is removed from IMAGE." + (declare (gv-setter image--set-property)) + (plist-get (cdr image) property)) + +(defun image-compute-scaling-factor (scaling) + (cond + ((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 + ;; are. But don't scale images down. + (if (< width 10) + 1 + (/ (float width) 10)))) + (t + (error "Invalid scaling factor %s" scaling)))) ;;;###autoload (defun put-image (image pos &optional string area) @@ -437,6 +496,7 @@ means display it in the right marginal area." (put-text-property 0 (length string) 'display prop string) (overlay-put overlay 'put-image t) (overlay-put overlay 'before-string string) + (overlay-put overlay 'map image-map) overlay))) @@ -476,7 +536,9 @@ height of the image; integer values are taken as pixel values." (add-text-properties start (point) `(display ,(if slice (list (cons 'slice slice) image) - image) rear-nonsticky (display))))) + image) + rear-nonsticky (display) + keymap ,image-map)))) ;;;###autoload @@ -512,7 +574,8 @@ The image is automatically split into ROWS x COLS slices." (insert string) (add-text-properties start (point) `(display ,(list (list 'slice x y dx dy) image) - rear-nonsticky (display))) + rear-nonsticky (display) + keymap ,image-map)) (setq x (+ x dx)))) (setq x 0.0 y (+ y dy)) @@ -663,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." @@ -674,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))) @@ -714,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. @@ -727,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)) @@ -750,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) @@ -837,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 @@ -875,15 +943,99 @@ 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) +(defun image-increase-size (n) + "Increase the image size by a factor of N. +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.0)) + 1.2))) + +(defun image-decrease-size (n) + "Decrease the image size by a factor of N. +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.0)) + 0.8))) + +(defun image--get-image () + (let ((image (get-text-property (point) 'display))) + (unless (eq (car-safe image) 'image) + (error "No image under point")) + image)) + +(defun image--get-imagemagick-and-warn () + (unless (fboundp 'imagemagick-types) + (error "Can't rescale images without ImageMagick support")) + (let ((image (image--get-image))) + (image-flush image) + (plist-put (cdr image) :type 'imagemagick) + image)) + +(defun image--change-size (factor) + (let* ((image (image--get-imagemagick-and-warn)) + (new-image (image--image-without-parameters image)) + (scale (image--current-scaling image new-image))) + (setcdr image (cdr new-image)) + (plist-put (cdr image) :scale (* scale factor)))) + +(defun image--image-without-parameters (image) + (cons (pop image) + (let ((new nil)) + (while image + (let ((key (pop image)) + (val (pop image))) + (unless (memq key '(:scale :width :height :max-width :max-height)) + (setq new (nconc new (list key val)))))) + new))) + +(defun image--current-scaling (image new-image) + ;; The image may be scaled due to many reasons (:scale, :max-width, + ;; etc), so find out what the current scaling is based on the + ;; original image size and the displayed size. + (let ((image-width (car (image-size new-image t))) + (display-width (car (image-size image t)))) + (/ (float display-width) image-width))) + +(defun image-rotate () + "Rotate the image under point by 90 degrees clockwise." + (interactive) + (let ((image (image--get-imagemagick-and-warn))) + (plist-put (cdr image) :rotation + (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." + (interactive) + (let ((image (get-text-property (point) 'display))) + (when (or (not (consp image)) + (not (eq (car image) 'image))) + (error "No image under point")) + (with-temp-buffer + (let ((file (plist-get (cdr image) :file))) + (if file + (if (not (file-exists-p file)) + (error "File %s no longer exists" file) + (insert-file-contents-literally file)) + (insert (plist-get (cdr image) :data)))) + (write-region (point-min) (point-max) + (read-file-name "Write image to file: "))))) + (provide 'image) ;;; image.el ends here diff --git a/lisp/gnus/compface.el b/lisp/image/compface.el index cd70d6c87c9..e2f607b1be3 100644 --- a/lisp/gnus/compface.el +++ b/lisp/image/compface.el @@ -31,7 +31,7 @@ Requires the external programs `uncompface', and `icontopbm'. On a GNU/Linux system these might be in packages with names like `compface' or `faces-xface' and `netpbm' or `libgr-progs', for instance." (with-temp-buffer - (unless (featurep 'xemacs) (set-buffer-multibyte nil)) + (set-buffer-multibyte nil) (insert face) (let ((coding-system-for-read 'raw-text) ;; At least "icontopbm" doesn't work with Windows because @@ -44,17 +44,10 @@ or `faces-xface' and `netpbm' or `libgr-progs', for instance." (goto-char (point-min)) (insert "/* Format_version=1, Width=48, Height=48, Depth=1,\ Valid_bits_per_item=16 */\n") - ;; I just can't get "icontopbm" to work correctly on its - ;; own in XEmacs. And Emacs doesn't understand un-raw pbm - ;; files. - (if (not (featurep 'xemacs)) - (eq 0 (call-process-region (point-min) (point-max) - "icontopbm" - 'delete '(t nil))) - (shell-command-on-region (point-min) (point-max) - "icontopbm | pnmnoraw" - (current-buffer) t) - t)) + ;; Emacs doesn't understand un-raw pbm files. + (eq 0 (call-process-region (point-min) (point-max) + "icontopbm" + 'delete '(t nil)))) (buffer-string))))) (provide 'compface) diff --git a/lisp/gnus/gravatar.el b/lisp/image/gravatar.el index 8e5ea313e4a..4bf5875f08c 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/image/gravatar.el @@ -26,6 +26,7 @@ (require 'url) (require 'url-cache) +(require 'image) (defgroup gravatar nil "Gravatar." @@ -91,22 +92,12 @@ (when (search-forward "\n\n" nil t) (buffer-substring (point) (point-max)))))) -(eval-and-compile - (cond ((featurep 'xemacs) - (require 'gnus-xmas) - (defalias 'gravatar-create-image 'gnus-xmas-create-image)) - ((featurep 'gnus-ems) - (defalias 'gravatar-create-image 'gnus-create-image)) - (t - (require 'image) - (defalias 'gravatar-create-image 'create-image)))) - (defun gravatar-data->image () "Get data of current buffer and return an image. If no image available, return 'error." (let ((data (gravatar-get-data))) (if data - (gravatar-create-image data nil t) + (create-image data nil t) 'error))) (autoload 'help-function-arglist "help-fns") @@ -128,7 +119,7 @@ You can provide a list of argument to pass to CB in CBARGS." (apply #'url-retrieve args)) (apply cb (with-temp-buffer - (mm-disable-multibyte) + (set-buffer-multibyte nil) (url-cache-extract (url-cache-create-filename url)) (gravatar-data->image)) cbargs)))) @@ -145,7 +136,7 @@ You can provide a list of argument to pass to CB in CBARGS." (kill-buffer (current-buffer)) data)) (with-temp-buffer - (mm-disable-multibyte) + (set-buffer-multibyte nil) (url-cache-extract (url-cache-create-filename url)) (gravatar-data->image))))) 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-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 1689af9433e..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) @@ -5013,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 ab058a5df52..5085e637e39 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -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)) @@ -622,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) @@ -1382,10 +1386,10 @@ Setup char-width-table appropriate for non-CJK language environment." (aset char-acronym-table i (car c0-acronyms)) (setq c0-acronyms (cdr c0-acronyms)))) -(let ((c1-acronyms '("XXX" "XXX" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" +(let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1" "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" - "SOS" "XXX" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) + "SOS" "SGCI" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) (dotimes (i 32) (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) (setq c1-acronyms (cdr c1-acronyms)))) 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 1ec7456c9e1..7672edc0443 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -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) @@ -2980,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 @@ -2993,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 @@ -3008,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 08d37b45a3d..0761e688684 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1873,7 +1873,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/gnus/rfc1843.el b/lisp/international/rfc1843.el index 1dbd11debd4..508629fb062 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/international/rfc1843.el @@ -22,21 +22,12 @@ ;;; Commentary: -;; Usage: -;; (require 'rfc1843) -;; (rfc1843-gnus-setup) -;; ;; Test: ;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}") ;;; Code: (eval-when-compile (require 'cl)) -(require 'mm-util) - -(defvar gnus-decode-encoded-word-function) -(defvar gnus-decode-header-function) -(defvar gnus-newsgroup-name) (defvar rfc1843-word-regexp "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") @@ -90,12 +81,11 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (while (re-search-forward (if rfc1843-decode-hzp rfc1843-hzp-word-regexp rfc1843-word-regexp) (point-max) t) - ;;; Text with extents may cause XEmacs crash (setq str (buffer-substring-no-properties (match-beginning 1) (match-end 1))) (setq firstc (aref str 0)) - (insert (mm-decode-coding-string + (insert (decode-coding-string (rfc1843-decode (prog1 (substring str 1) @@ -112,10 +102,10 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (defun rfc1843-decode-string (string) "Decode HZ STRING and return the results." - (let ((m (mm-multibyte-p))) + (let ((m enable-multibyte-characters)) (with-temp-buffer (when m - (mm-enable-multibyte)) + (set-buffer-multibyte 'to)) (insert string) (inline (rfc1843-decode-region (point-min) (point-max))) @@ -136,54 +126,6 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (aset s (incf i) (+ v (if (< v 63) 64 98)))))) s)) -(autoload 'mail-header-parse-content-type "mail-parse") -(autoload 'message-narrow-to-head "message") -(declare-function message-fetch-field "message" (header &optional not-all)) - -(defun rfc1843-decode-article-body () - "Decode HZ encoded text in the article body." - (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") - (or gnus-newsgroup-name "")) - (save-excursion - (save-restriction - (message-narrow-to-head) - (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) - (ct (message-fetch-field "Content-Type" t)) - (ctl (and ct (mail-header-parse-content-type ct)))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max)) - (widen) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (when (or (not ctl) - (equal (car ctl) "text/plain")) - (rfc1843-decode-region (point) (point-max)))))))) - -(defvar gnus-decode-header-methods) -(defvar gnus-decode-encoded-word-methods) - -(defun rfc1843-gnus-setup () - "Setup HZ decoding for Gnus." - (require 'gnus-art) - (require 'gnus-sum) - (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t) - (setq gnus-decode-encoded-word-function - 'gnus-multi-decode-encoded-word-string - gnus-decode-header-function - 'gnus-multi-decode-header - gnus-decode-encoded-word-methods - (nconc gnus-decode-encoded-word-methods - (list - (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") - 'rfc1843-decode-string))) - gnus-decode-header-methods - (nconc gnus-decode-header-methods - (list - (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>") - 'rfc1843-decode-region))))) - (provide 'rfc1843) ;;; rfc1843.el ends here diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index 29cd042eee9..b2bc622858d 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -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,14 +615,9 @@ 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 diff --git a/lisp/gnus/utf7.el b/lisp/international/utf7.el index 9b7191b21e1..bd04eba2fae 100644 --- a/lisp/gnus/utf7.el +++ b/lisp/international/utf7.el @@ -119,11 +119,17 @@ Use IMAP modification if FOR-IMAP is non-nil." "Encode text from START to END in buffer as UTF-7 escape fragment. Use IMAP modification if FOR-IMAP is non-nil." (save-restriction - (narrow-to-region start end) - (funcall (utf7-get-u16char-converter 'to-utf-16)) - (mm-with-unibyte-current-buffer - (base64-encode-region start (point-max))) - (goto-char start) + (let* ((buf (current-buffer)) + (base (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring buf start end) + (funcall (utf7-get-u16char-converter 'to-utf-16)) + (base64-encode-region (point-min) (point-max)) + (buffer-string)))) + (narrow-to-region start end) + (delete-region (point-min) (point-max)) + (insert base)) + (goto-char (point-min)) (let ((pm (point-max))) (when for-imap (while (search-forward "/" nil t) @@ -185,8 +191,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (defun utf7-latin1-u16-char-converter () "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. Characters are converted to raw byte pairs in narrowed buffer." - (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1) - (mm-disable-multibyte) + (encode-coding-region (point-min) (point-max) 'iso-8859-1) (goto-char (point-min)) (while (not (eobp)) (insert 0) @@ -201,7 +206,7 @@ Characters are in raw byte pairs in narrowed buffer." (delete-char 1) (error "Unable to convert from Unicode")) (forward-char)) - (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1) + (decode-coding-region (point-min) (point-max) 'iso-8859-1) (mm-enable-multibyte)) ;;;###autoload diff --git a/lisp/isearch.el b/lisp/isearch.el index ff779308051..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. @@ -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. @@ -1149,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) @@ -1261,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) @@ -1315,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) @@ -3281,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' @@ -3324,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 1eabe0fa33c..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. 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/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-auto.el b/lisp/ldefs-boot-auto.el new file mode 100644 index 00000000000..914fec8e1e1 --- /dev/null +++ b/lisp/ldefs-boot-auto.el @@ -0,0 +1,125 @@ +;; This file is autogenerated by admin/ldefs-clean.el +;; Do not edit +(autoload 'Info-directory "info" nil nil nil) +(autoload 'Info-index "info" nil nil nil) +(autoload 'View-exit-and-edit "view" nil nil nil) +(autoload 'add-change-log-entry "add-log" nil nil nil) +(autoload 'add-log-current-defun "add-log" nil nil nil) +(autoload 'batch-byte-compile "bytecomp" nil nil nil) +(autoload 'browse-url "browse-url" nil nil nil) +(autoload 'buffer-face-mode "face-remap" nil nil nil) +(autoload 'byte-compile "bytecomp" nil nil nil) +(autoload 'byte-compile-disable-warning "bytecomp" nil nil nil) +(autoload 'byte-compile-enable-warning "bytecomp" nil nil nil) +(autoload 'byte-compile-file "bytecomp" nil nil nil) +(autoload 'byte-compile-inline-expand "byte-opt" nil nil nil) +(autoload 'byte-compile-unfold-lambda "byte-opt" nil nil nil) +(autoload 'byte-optimize-form "byte-opt" nil nil nil) +(autoload 'byte-optimize-lapcode "byte-opt" nil nil nil) +(autoload 'byte-recompile-directory "bytecomp" nil nil nil) +(autoload 'char-displayable-p "mule-util" nil nil nil) +(autoload 'color-name-to-rgb "color" nil nil nil) +(autoload 'comint-redirect-results-list-from-process "comint" nil nil nil) +(autoload 'comint-redirect-send-command-to-process "comint" nil nil nil) +(autoload 'compilation-mode "compile" nil nil nil) +(autoload 'compilation-shell-minor-mode "compile" nil nil nil) +(autoload 'compilation-start "compile" nil nil nil) +(autoload 'create-image "image" nil nil nil) +(autoload 'custom-save-all "cus-edit" nil nil nil) +(autoload 'customize-face "cus-edit" nil nil nil) +(autoload 'customize-group "cus-edit" nil nil nil) +(autoload 'customize-option "cus-edit" nil nil nil) +(autoload 'customize-set-variable "cus-edit" nil nil nil) +(autoload 'debug "debug" nil nil nil) +(autoload 'define-ccl-program "ccl" nil nil t) +(autoload 'define-derived-mode "derived" nil nil t) +(autoload 'define-minor-mode "easy-mmode" nil nil t) +(autoload 'delete-extract-rectangle "rect" nil nil nil) +(autoload 'describe-char "descr-text" nil nil nil) +(autoload 'describe-function "help-fns" nil nil nil) +(autoload 'describe-function-1 "help-fns" nil nil nil) +(autoload 'describe-package "package" nil nil nil) +(autoload 'describe-variable "help-fns" nil nil nil) +(autoload 'desktop-save "desktop" nil nil nil) +(autoload 'diff-mode "diff-mode" nil nil nil) +(autoload 'dired "dired" nil nil nil) +(autoload 'dired-mode "dired" nil nil nil) +(autoload 'dired-noselect "dired" nil nil nil) +(autoload 'display-call-tree "bytecomp" nil nil nil) +(autoload 'display-warning "warnings" nil nil nil) +(autoload 'easy-menu-create-menu "easymenu" nil nil nil) +(autoload 'ediff-patch-file "ediff" nil nil nil) +(autoload 'edit-kbd-macro "edmacro" nil nil nil) +(autoload 'extract-rectangle "rect" nil nil nil) +(autoload 'find-definition-noselect "find-func" nil nil nil) +(autoload 'find-function-search-for-symbol "find-func" nil nil nil) +(autoload 'find-lisp-object-file-name "help-fns" nil nil nil) +(autoload 'find-variable-noselect "find-func" nil nil nil) +(autoload 'format-kbd-macro "edmacro" nil nil nil) +(autoload 'goto-address-mode "goto-addr" nil nil nil) +(autoload 'grep-compute-defaults "grep" nil nil nil) +(autoload 'help-C-file-name "help-fns" nil nil nil) +(autoload 'help-buffer "help-mode" nil nil nil) +(autoload 'help-insert-xref-button "help-mode" nil nil nil) +(autoload 'help-make-xrefs "help-mode" nil nil nil) +(autoload 'help-mode "help-mode" nil nil nil) +(autoload 'help-setup-xref "help-mode" nil nil nil) +(autoload 'help-with-tutorial "tutorial" nil nil nil) +(autoload 'help-xref-button "help-mode" nil nil nil) +(autoload 'hi-lock-face-buffer "hi-lock" nil nil nil) +(autoload 'image-type-available-p "image" nil nil nil) +(autoload 'info "info" nil nil nil) +(autoload 'info-emacs-manual "info" nil nil nil) +(autoload 'insert-image "image" nil nil nil) +(autoload 'insert-rectangle "rect" nil nil nil) +(autoload 'isearch-process-search-multibyte-characters "isearch-x" nil nil nil) +(autoload 'jka-compr-uninstall "jka-compr" nil nil nil) +(autoload 'log-edit "log-edit" nil nil nil) +(autoload 'log-view-mode "log-view" nil nil nil) +(autoload 'lookup-nested-alist "mule-util" nil nil nil) +(autoload 'make-display-table "disp-table" nil nil nil) +(autoload 'make-glyph-code "disp-table" nil nil nil) +(autoload 'multi-isearch-buffers "misearch" nil nil nil) +(autoload 'multi-isearch-buffers-regexp "misearch" nil nil nil) +(autoload 'multi-isearch-files "misearch" nil nil nil) +(autoload 'multi-isearch-files-regexp "misearch" nil nil nil) +(autoload 'open-network-stream "network-stream" nil nil nil) +(autoload 'package-initialize "package" nil nil nil) +(autoload 'parse-time-string "parse-time" nil nil nil) +(autoload 'pp "pp" nil nil nil) +(autoload 'pp-buffer "pp" nil nil nil) +(autoload 'read-kbd-macro "edmacro" nil nil nil) +(autoload 'regexp-opt "regexp-opt" nil nil nil) +(autoload 'rx "rx" nil nil t) +(autoload 'seconds-to-string "time-date" nil nil nil) +(autoload 'seconds-to-time "time-date" nil nil nil) +(autoload 'server-start "server" nil nil nil) +(autoload 'set-nested-alist "mule-util" nil nil nil) +(autoload 'smerge-mode "smerge-mode" nil nil nil) +(autoload 'smerge-start-session "smerge-mode" nil nil nil) +(autoload 'standard-display-8bit "disp-table" nil nil nil) +(autoload 'tags-query-replace "etags" nil nil nil) +(autoload 'tags-search "etags" nil nil nil) +(autoload 'text-scale-increase "face-remap" nil nil nil) +(autoload 'thing-at-point "thingatpt" nil nil nil) +(autoload 'time-to-days "time-date" nil nil nil) +(autoload 'timezone-make-date-arpa-standard "timezone" nil nil nil) +(autoload 'tmm-menubar "tmm" nil nil nil) +(autoload 'truncate-string-to-width "mule-util" nil nil nil) +(autoload 'url-handler-mode "url-handlers" nil nil nil) +(autoload 'variable-at-point "help-fns" nil nil nil) +(autoload 'vc-register "vc" nil nil nil) +(autoload 'vc-responsible-backend "vc" nil nil nil) +(autoload 'vc-transfer-file "vc" nil nil nil) +(autoload 'view-buffer "view" nil nil nil) +(autoload 'view-buffer-other-window "view" nil nil nil) +(autoload 'view-file "view" nil nil nil) +(autoload 'view-mode-enter "view" nil nil nil) +(autoload 'visit-tags-table "etags" nil nil nil) +(autoload 'warn "warnings" nil nil nil) +(autoload 'wdired-change-to-wdired-mode "wdired" nil nil nil) +(autoload 'widget-value "wid-edit" nil nil nil) +;; Local Variables: +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: diff --git a/lisp/ldefs-boot-manual.el b/lisp/ldefs-boot-manual.el new file mode 100644 index 00000000000..183703d25e8 --- /dev/null +++ b/lisp/ldefs-boot-manual.el @@ -0,0 +1,19 @@ +;; These appear to be necessary as they are used elsewhere in macro definitions. +(load "emacs-lisp/gv.el") +(load "emacs-lisp/nadvice.el") +(load "emacs-lisp/inline.el") + +;; This variable is used by bytecomp.el +(defvar warning-series nil) + +;; This variable is used by emacs-lisp-mode which is used heavily +;; during the byte-compile phase +(defvar electric-pair-text-pairs '((34 . 34))) + + +(load "ldefs-boot-auto.el") + +;; Local Variables: +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 8a1d65248c6..406f0456662 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,7 +3,7 @@ ;;; Code: -;;;### (autoloads nil "5x5" "play/5x5.el" (22387 39328 255705 281000)) +;;;### (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" (22387 39328 -;;;;;; 275705 210000)) +;;;### (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" (22387 39328 -;;;;;; 277705 202000)) +;;;### (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" (22387 39328 -;;;;;; 278705 199000)) +;;;### (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" (22387 39328 622703 -;;;;;; 971000)) +;;;### (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) @@ -152,7 +163,11 @@ If `change-log-default-name' is nil, behave as though it were \"ChangeLog\" If `change-log-default-name' contains a leading directory component, then simply find it in the current directory. Otherwise, search in the current -directory and its successive parents for a file so named. +directory and its successive parents for a file so named. Stop at the first +such file that exists (or has a buffer visiting it), or the first directory +that contains any of `change-log-directory-files'. If no match is found, +use the current directory. To override the choice of this function, +simply create an empty ChangeLog file first by hand in the desired place. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name. @@ -236,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" (22387 39327 -;;;;;; 270708 798000)) +;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -372,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" (22387 39326 533711 429000)) +;;;### (autoloads nil "align" "align.el" (0 0 0 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -477,9 +495,11 @@ indented. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "align" '("align-"))) + ;;;*** -;;;### (autoloads nil "allout" "allout.el" (22387 39326 536711 418000)) +;;;### (autoloads nil "allout" "allout.el" (0 0 0 0)) ;;; Generated autoloads from allout.el (push (purecopy '(allout 2 3)) package--builtin-versions) @@ -837,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" (22387 -;;;;;; 39326 534711 425000)) +;;;### (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) @@ -896,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" (22578 62356 730212 -;;;;;; 84000)) +;;;### (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) @@ -918,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" (22387 39328 255705 -;;;;;; 281000)) +;;;### (autoloads nil "animate" "play/animate.el" (0 0 0 0)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -951,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" (22387 39326 538711 -;;;;;; 411000)) +;;;### (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) @@ -978,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" (22387 -;;;;;; 39328 279705 195000)) +;;;### (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) @@ -1015,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" (22387 39327 74709 -;;;;;; 497000)) +;;;### (autoloads nil "appt" "calendar/appt.el" (0 0 0 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1037,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" (22387 39326 539711 -;;;;;; 407000)) +;;;### (autoloads nil "apropos" "apropos.el" (0 0 0 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1154,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" (22578 62356 712212 -;;;;;; 180000)) +;;;### (autoloads nil "arc-mode" "arc-mode.el" (0 0 0 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1175,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" (22387 39326 541711 400000)) +;;;### (autoloads nil "array" "array.el" (0 0 0 0)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1246,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" (22387 39328 -;;;;;; 519704 339000)) +;;;### (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) @@ -1453,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" (22387 39328 -;;;;;; 280705 192000)) +;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1481,11 +1515,12 @@ Special commands: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "asm-mode" '("asm-"))) + ;;;*** -;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (22578 -;;;;;; 62356 719212 143000)) -;;; Generated autoloads from gnus/auth-source.el +;;;### (autoloads nil "auth-source" "auth-source.el" (0 0 0 0)) +;;; Generated autoloads from auth-source.el (defvar auth-source-cache-expiry 7200 "\ How many seconds passwords are cached, or nil to disable @@ -1494,10 +1529,11 @@ 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" (22387 39326 542711 -;;;;;; 397000)) +;;;### (autoloads nil "autoarg" "autoarg.el" (0 0 0 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1557,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" (22387 39328 -;;;;;; 280705 192000)) +;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1568,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" (22387 39326 542711 -;;;;;; 397000)) +;;;### (autoloads nil "autoinsert" "autoinsert.el" (0 0 0 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1608,10 +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" (22578 -;;;;;; 62356 716212 159000)) +;;;### (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) @@ -1660,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" (22387 39326 543711 -;;;;;; 393000)) +;;;### (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. @@ -1692,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), @@ -1711,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) @@ -1729,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. @@ -1750,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" (22387 39326 543711 393000)) +;;;### (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 "\ @@ -1788,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" (22387 39328 -;;;;;; 281705 188000)) +;;;### (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)) @@ -1807,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" (22578 62356 712212 -;;;;;; 180000)) +;;;### (autoloads nil "battery" "battery.el" (0 0 0 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1844,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" (22387 -;;;;;; 39327 272708 790000)) +;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1881,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 "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" (22387 39328 -;;;;;; 529704 303000)) +;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1973,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" -;;;;;; (22387 39328 527704 310000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1984,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" (22387 39327 899706 -;;;;;; 552000)) +;;;### (autoloads nil "binhex" "mail/binhex.el" (0 0 0 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -2009,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" (22387 39328 -;;;;;; 256705 277000)) +;;;### (autoloads nil "blackbox" "play/blackbox.el" (0 0 0 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2129,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" (22387 39326 545711 -;;;;;; 386000)) +;;;### (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) @@ -2354,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" (22578 62356 -;;;;;; 730212 84000)) +;;;### (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 "\ @@ -2703,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" (22387 39326 546711 382000)) +;;;### (autoloads nil "bs" "bs.el" (0 0 0 0)) ;;; Generated autoloads from bs.el (push (purecopy '(bs 1 17)) package--builtin-versions) @@ -2744,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" (22387 39328 256705 -;;;;;; 277000)) +;;;### (autoloads nil "bubbles" "play/bubbles.el" (0 0 0 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2766,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" -;;;;;; (22387 39328 281705 188000)) +;;;;;; (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))))) @@ -2787,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" (22387 -;;;;;; 39327 276708 776000)) +;;;### (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) @@ -2908,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" (22387 -;;;;;; 39327 75709 494000)) +;;;### (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" (22387 39327 -;;;;;; 77709 487000)) +;;;### (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) @@ -2928,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-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" (22387 -;;;;;; 39327 78709 483000)) +;;;### (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" "\ @@ -2941,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 "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 "calc" "calc/calc.el" (22387 39327 40709 619000)) +;;;### (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) @@ -3027,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-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-undo" "calc/calc-undo.el" (22387 39327 -;;;;;; 30709 655000)) +;;;### (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" "\ @@ -3038,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 "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 "calculator" "calculator.el" (22387 39326 549711 -;;;;;; 372000)) +;;;### (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" "\ @@ -3050,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" (22490 22723 -;;;;;; 646600 845000)) +;;;### (autoloads nil "calendar" "calendar/calendar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3094,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" (22387 39327 447708 -;;;;;; 166000)) +;;;### (autoloads nil "canlock" "gnus/canlock.el" (0 0 0 0)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3112,10 +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" (22387 -;;;;;; 39328 290705 156000)) +;;;### (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" "\ @@ -3123,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" (22387 39328 -;;;;;; 296705 134000)) +;;;### (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 "\ @@ -3222,10 +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-mode" "progmodes/cc-mode.el" (22387 39328 -;;;;;; 299705 124000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3240,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)) @@ -3264,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 @@ -3381,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" (22387 -;;;;;; 39328 301705 117000)) +;;;### (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" "\ @@ -3433,19 +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" (22387 39328 -;;;;;; 301705 117000)) +;;;### (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" (22387 39327 578707 -;;;;;; 698000)) +;;;### (autoloads nil "ccl" "international/ccl.el" (0 0 0 0)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3736,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" (22387 39327 -;;;;;; 277708 773000)) +;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3756,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" (22387 39327 134709 -;;;;;; 283000)) +;;;### (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 "cfengine" "progmodes/cfengine.el" (22387 39328 -;;;;;; 303705 110000)) +;;;### (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 "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) @@ -3793,10 +4406,11 @@ Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cfengine" '("cfengine"))) + ;;;*** -;;;### (autoloads nil "char-fold" "char-fold.el" (22387 39326 550711 -;;;;;; 368000)) +;;;### (autoloads nil "char-fold" "char-fold.el" (0 0 0 0)) ;;; Generated autoloads from char-fold.el (autoload 'char-fold-to-regexp "char-fold" "\ @@ -3813,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" (22387 39327 -;;;;;; 278708 769000)) +;;;### (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" -;;;;;; (22387 39327 278708 769000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3838,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" (22387 -;;;;;; 39327 279708 766000)) +;;;### (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) @@ -4049,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" (22387 -;;;;;; 39327 648707 448000)) +;;;### (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" "\ @@ -4087,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" (22578 62356 713212 -;;;;;; 175000)) +;;;### (autoloads nil "chistory" "chistory.el" (0 0 0 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4127,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" "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 nil "cl-indent" "emacs-lisp/cl-indent.el" (22387 -;;;;;; 39327 282708 755000)) +;;;### (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" "\ @@ -4211,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" (22387 39327 -;;;;;; 283708 751000)) +;;;### (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) @@ -4230,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 "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" (22387 39328 -;;;;;; 303705 110000)) +;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4251,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" (22387 39326 553711 -;;;;;; 358000)) +;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (0 0 0 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4272,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" (22387 39326 553711 358000)) +;;;### (autoloads nil "color" "color.el" (0 0 0 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4291,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" (22387 39326 555711 350000)) +;;;### (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) "\ @@ -4392,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" (22387 39328 -;;;;;; 648703 878000)) +;;;### (autoloads nil "compare-w" "vc/compare-w.el" (0 0 0 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4429,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" (22387 39328 -;;;;;; 304705 106000)) +;;;### (autoloads nil "compile" "progmodes/compile.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4611,10 +5282,11 @@ 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" (22387 39326 556711 -;;;;;; 347000)) +;;;### (autoloads nil "completion" "completion.el" (0 0 0 0)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4635,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" (22387 -;;;;;; 39328 531704 295000)) +;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4791,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" (22387 39328 257705 -;;;;;; 274000)) +;;;### (autoloads nil "cookie1" "play/cookie1.el" (0 0 0 0)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4820,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" (22387 -;;;;;; 39327 287708 737000)) +;;;### (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) @@ -4859,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" (22387 -;;;;;; 39328 310705 85000)) +;;;### (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) @@ -5058,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" (22387 39328 312705 -;;;;;; 77000)) +;;;### (autoloads nil "cpp" "progmodes/cpp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -5077,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" (22387 39327 288708 -;;;;;; 733000)) +;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5104,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" (22387 39328 -;;;;;; 532704 292000)) +;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5121,10 +5803,11 @@ 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" (22387 39327 -;;;;;; 363708 465000)) +;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (0 0 0 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5168,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" (22387 39327 -;;;;;; 364708 462000)) +;;;### (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" "\ @@ -5180,10 +5871,12 @@ 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" -;;;;;; (22387 39327 288708 733000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cursor-sensor.el (defvar cursor-sensor-inhibit nil) @@ -5203,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-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" (22421 48064 572733 -;;;;;; 228000)) +;;;### (autoloads nil "cus-edit" "cus-edit.el" (0 0 0 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5457,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) @@ -5524,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" (22387 39326 564711 -;;;;;; 318000)) +;;;### (autoloads nil "cus-theme" "cus-theme.el" (0 0 0 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5558,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" (22387 39328 -;;;;;; 649703 874000)) +;;;### (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" "\ @@ -5569,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" (22387 39328 313705 -;;;;;; 74000)) +;;;### (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) @@ -5615,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" (22387 -;;;;;; 39327 648707 448000)) +;;;### (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" "\ @@ -5644,10 +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" (22578 62356 713212 -;;;;;; 175000)) +;;;### (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) @@ -5694,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" (22387 39327 -;;;;;; 134709 283000)) +;;;### (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" "\ @@ -5705,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" (22387 39327 967706 309000)) +;;;### (autoloads nil "dbus" "net/dbus.el" (0 0 0 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5718,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" (22387 39328 -;;;;;; 313705 74000)) +;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5845,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" (22387 39327 -;;;;;; 289708 730000)) +;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5889,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" (22387 39328 -;;;;;; 258705 270000)) +;;;### (autoloads nil "decipher" "play/decipher.el" (0 0 0 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5918,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" (22387 39326 566711 -;;;;;; 311000)) +;;;### (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) @@ -5944,9 +6659,11 @@ 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" (22387 39326 566711 311000)) +;;;### (autoloads nil "delsel" "delsel.el" (0 0 0 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5977,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" (22387 39327 -;;;;;; 289708 730000)) +;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -6008,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: @@ -6044,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" (22387 39326 567711 -;;;;;; 307000)) +;;;### (autoloads nil "descr-text" "descr-text.el" (0 0 0 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6094,10 +6816,11 @@ 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" (22387 39326 567711 -;;;;;; 307000)) +;;;### (autoloads nil "desktop" "desktop.el" (0 0 0 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6133,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.") @@ -6323,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" (22387 39327 -;;;;;; 448708 162000)) +;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (0 0 0 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6356,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 "diary-lib" "calendar/diary-lib.el" (22387 -;;;;;; 39327 108709 376000)) +;;;### (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" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6399,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" (22387 39328 651703 867000)) +;;;### (autoloads nil "diff" "vc/diff.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-u") "\ @@ -6447,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" (22387 39328 -;;;;;; 650703 871000)) +;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6480,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" (22387 39327 967706 309000)) +;;;### (autoloads nil "dig" "net/dig.el" (0 0 0 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6491,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" (22579 9748 130924 321000)) +;;;### (autoloads nil "dired" "dired.el" (0 0 0 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6617,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 nil "dirtrack" "dirtrack.el" (22387 39326 575711 -;;;;;; 279000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6648,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" (22387 39327 -;;;;;; 290708 726000)) +;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6663,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" (22387 39326 576711 -;;;;;; 275000)) +;;;### (autoloads nil "disp-table" "disp-table.el" (0 0 0 0)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6785,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" (22387 39328 -;;;;;; 258705 270000)) +;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6804,7 +7564,7 @@ Default is 2. ;;;*** -;;;### (autoloads nil "dnd" "dnd.el" (22387 39326 576711 275000)) +;;;### (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)) "\ @@ -6822,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" (22387 39328 -;;;;;; 532704 292000)) +;;;### (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" "\ @@ -6846,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" (22387 39326 577711 -;;;;;; 272000)) +;;;### (autoloads nil "doc-view" "doc-view.el" (0 0 0 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6893,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" (22387 39328 259705 -;;;;;; 267000)) +;;;### (autoloads nil "doctor" "play/doctor.el" (0 0 0 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6904,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 "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 "double" "double.el" (22387 39326 589711 229000)) +;;;### (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" "\ @@ -6920,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" (22387 39328 260705 -;;;;;; 263000)) +;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0)) ;;; Generated autoloads from play/dunnet.el (push (purecopy '(dunnet 2 2)) package--builtin-versions) @@ -6932,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" (22387 -;;;;;; 39327 291708 723000)) +;;;### (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) @@ -6964,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. @@ -7075,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" (22387 -;;;;;; 39327 291708 723000)) +;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7214,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 "ebnf2ps" "progmodes/ebnf2ps.el" (22387 39328 -;;;;;; 319705 52000)) +;;;### (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 "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) @@ -7480,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" (22387 39328 -;;;;;; 321705 45000)) +;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7629,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" (22387 39326 590711 -;;;;;; 225000)) +;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (0 0 0 0)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7657,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" (22387 39326 591711 -;;;;;; 222000)) +;;;### (autoloads nil "echistory" "echistory.el" (0 0 0 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7674,20 +8542,23 @@ 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" "gnus/ecomplete.el" (22387 39327 -;;;;;; 448708 162000)) -;;; Generated autoloads from gnus/ecomplete.el +;;;### (autoloads nil "ecomplete" "ecomplete.el" (0 0 0 0)) +;;; Generated autoloads from ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ecomplete" '("ecomplete-"))) + ;;;*** -;;;### (autoloads nil "ede" "cedet/ede.el" (22387 39327 135709 280000)) +;;;### (autoloads nil "ede" "cedet/ede.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede.el (push (purecopy '(ede 1 2)) package--builtin-versions) @@ -7712,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 "edebug" "emacs-lisp/edebug.el" (22387 39327 -;;;;;; 293708 716000)) +;;;### (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 "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 "\ @@ -7777,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" (22387 39328 660703 835000)) +;;;### (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) @@ -8049,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-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" (22387 39328 -;;;;;; 653703 860000)) +;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -8060,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" (22387 39328 -;;;;;; 656703 849000)) +;;;### (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" "\ @@ -8073,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" (22387 39328 -;;;;;; 658703 842000)) +;;;### (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" "\ @@ -8093,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" (22387 39326 591711 -;;;;;; 222000)) +;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0)) ;;; Generated autoloads from edmacro.el (push (purecopy '(edmacro 2 1)) package--builtin-versions) @@ -8143,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" (22578 62356 717212 -;;;;;; 153000)) +;;;### (autoloads nil "edt" "emulation/edt.el" (0 0 0 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8161,9 +9355,42 @@ Turn on EDT Emulation. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt" '("edt-"))) + ;;;*** -;;;### (autoloads nil "ehelp" "ehelp.el" (22387 39326 592711 218000)) +;;;### (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 "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" "\ @@ -8197,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" (22387 39327 -;;;;;; 299708 694000)) +;;;### (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-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 nil "eieio-core" "emacs-lisp/eieio-core.el" (22578 -;;;;;; 62356 716212 159000)) +;;;### (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) @@ -8221,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 "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 nil "elec-pair" "elec-pair.el" (22387 39326 592711 -;;;;;; 218000)) +;;;### (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)) "\ @@ -8264,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" (22387 39326 593711 -;;;;;; 215000)) +;;;### (autoloads nil "elide-head" "elide-head.el" (0 0 0 0)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8280,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" (22387 39327 -;;;;;; 300708 690000)) +;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8316,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" (22387 39327 301708 -;;;;;; 687000)) +;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8351,10 +9633,147 @@ displayed. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elp" '("elp-"))) + ;;;*** -;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (22387 39326 594711 -;;;;;; 211000)) +;;;### (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 "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" "\ @@ -8379,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" (22578 62356 -;;;;;; 725212 110000)) +;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (0 0 0 0)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8393,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" (22387 39328 661703 -;;;;;; 831000)) +;;;### (autoloads nil "emerge" "vc/emerge.el" (0 0 0 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8454,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" (22387 39328 -;;;;;; 533704 288000)) +;;;### (autoloads nil "enriched" "textmodes/enriched.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8490,9 +9912,11 @@ Commands: \(fn FROM TO)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "enriched" '("enriched-"))) + ;;;*** -;;;### (autoloads nil "epa" "epa.el" (22387 39326 603711 179000)) +;;;### (autoloads nil "epa" "epa.el" (0 0 0 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8678,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" (22387 39326 594711 -;;;;;; 211000)) +;;;### (autoloads nil "epa-dired" "epa-dired.el" (0 0 0 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8706,8 +10131,7 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-file" "epa-file.el" (22387 39326 595711 -;;;;;; 208000)) +;;;### (autoloads nil "epa-file" "epa-file.el" (0 0 0 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8725,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" (22387 39326 595711 -;;;;;; 208000)) +;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8804,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" (22387 39326 604711 175000)) +;;;### (autoloads nil "epg" "epg.el" (0 0 0 0)) ;;; Generated autoloads from epg.el (push (purecopy '(epg 1 0 0)) package--builtin-versions) @@ -8815,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" (22387 39326 603711 -;;;;;; 179000)) +;;;### (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'. @@ -8850,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" (22387 39327 421708 258000)) +;;;### (autoloads nil "erc" "erc/erc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 3)) package--builtin-versions) @@ -8899,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" (22387 -;;;;;; 39327 403708 323000)) +;;;### (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-button" "erc/erc-button.el" (22387 39327 -;;;;;; 405708 316000)) +;;;### (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" (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" (22387 39327 -;;;;;; 405708 316000)) +;;;### (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" (22387 39327 -;;;;;; 406708 312000)) +;;;### (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" (22387 39327 406708 -;;;;;; 312000)) +;;;### (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") @@ -8957,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" -;;;;;; (22387 39327 407708 309000)) +;;;;;; (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" (22387 -;;;;;; 39327 407708 309000)) +;;;### (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" "\ @@ -9027,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" (22387 39327 408708 -;;;;;; 305000)) +;;;### (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) @@ -9040,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-identd" "erc/erc-identd.el" (22387 39327 -;;;;;; 409708 301000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -9062,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" (22387 39327 -;;;;;; 410708 298000)) +;;;### (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" "\ @@ -9073,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" (22387 39327 410708 -;;;;;; 298000)) +;;;### (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-list" "erc/erc-list.el" (22387 39327 411708 -;;;;;; 294000)) +;;;### (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" (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" (22387 39327 411708 -;;;;;; 294000)) +;;;### (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) @@ -9117,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" (22387 39327 -;;;;;; 412708 291000)) +;;;### (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") @@ -9164,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" (22387 39327 413708 -;;;;;; 287000)) +;;;### (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" (22387 -;;;;;; 39327 413708 287000)) +;;;### (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") @@ -9183,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" (22387 -;;;;;; 39327 413708 287000)) +;;;### (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" "\ @@ -9201,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" (22387 39327 -;;;;;; 414708 283000)) +;;;### (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) @@ -9220,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" (22387 39327 415708 -;;;;;; 280000)) +;;;### (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" (22387 -;;;;;; 39327 415708 280000)) +;;;### (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" (22387 39327 -;;;;;; 415708 280000)) +;;;### (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" (22387 39327 416708 -;;;;;; 276000)) +;;;### (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" (22387 -;;;;;; 39327 416708 276000)) +;;;### (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) @@ -9266,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" (22387 39327 -;;;;;; 416708 276000)) +;;;### (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" (22387 -;;;;;; 39327 417708 273000)) +;;;### (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" "\ @@ -9285,24 +10777,28 @@ 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" (22387 -;;;;;; 39327 417708 273000)) +;;;### (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" (22387 39327 -;;;;;; 417708 273000)) +;;;### (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" (22387 39327 -;;;;;; 418708 269000)) +;;;### (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 "\ @@ -9326,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" (22387 -;;;;;; 39327 419708 266000)) +;;;### (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) @@ -9346,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" (22387 39327 419708 -;;;;;; 266000)) +;;;### (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") @@ -9358,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" (22387 39327 302708 -;;;;;; 683000)) +;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9428,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" (22387 39327 -;;;;;; 301708 687000)) +;;;### (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) @@ -9441,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-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" (22587 59854 -;;;;;; 958142 856000)) +;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (0 0 0 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9452,10 +10982,47 @@ Emacs shell interactive mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-mode" '("eshell"))) + ;;;*** -;;;### (autoloads nil "eshell" "eshell/eshell.el" (22387 39327 436708 -;;;;;; 205000)) +;;;### (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 "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) @@ -9488,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" (22490 22724 15599 -;;;;;; 212000)) +;;;### (autoloads nil "etags" "progmodes/etags.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9802,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" (22387 -;;;;;; 39327 650707 441000)) +;;;### (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" "\ @@ -9971,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" (22387 39327 971706 295000)) +;;;### (autoloads nil "eudc" "net/eudc.el" (0 0 0 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -10023,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" (22387 39327 968706 -;;;;;; 306000)) +;;;### (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" "\ @@ -10061,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" (22387 39327 -;;;;;; 969706 302000)) +;;;### (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" "\ @@ -10078,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" (22387 -;;;;;; 39327 970706 298000)) +;;;### (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" "\ @@ -10089,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 "ewoc" "emacs-lisp/ewoc.el" (22387 39327 303708 -;;;;;; 680000)) +;;;### (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 "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" "\ @@ -10116,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" (22387 39327 973706 288000)) +;;;### (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) "\ @@ -10163,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" (22387 -;;;;;; 39328 325705 31000)) +;;;### (autoloads nil "executable" "progmodes/executable.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -10199,9 +11808,11 @@ file modes. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "executable" '("executable-"))) + ;;;*** -;;;### (autoloads nil "expand" "expand.el" (22387 39326 605711 172000)) +;;;### (autoloads nil "expand" "expand.el" (0 0 0 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10248,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 "f90" "progmodes/f90.el" (22587 59854 959142 -;;;;;; 850000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10316,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" (22387 39326 606711 -;;;;;; 168000)) +;;;### (autoloads nil "face-remap" "face-remap.el" (0 0 0 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10476,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" (22387 39327 -;;;;;; 901706 545000)) +;;;### (autoloads nil "feedmail" "mail/feedmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/feedmail.el (push (purecopy '(feedmail 11)) package--builtin-versions) @@ -10531,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" (22387 39326 611711 151000)) +;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10594,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" (22387 39326 612711 -;;;;;; 147000)) +;;;### (autoloads nil "filecache" "filecache.el" (0 0 0 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10652,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" (22387 39326 612711 -;;;;;; 147000)) +;;;### (autoloads nil "filenotify" "filenotify.el" (0 0 0 0)) ;;; Generated autoloads from filenotify.el (autoload 'file-notify-handle-event "filenotify" "\ @@ -10668,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" (22387 39326 613711 -;;;;;; 143000)) +;;;### (autoloads nil "files-x" "files-x.el" (0 0 0 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10734,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" (22387 39326 618711 -;;;;;; 125000)) +;;;### (autoloads nil "filesets" "filesets.el" (0 0 0 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10746,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" (22387 39326 618711 -;;;;;; 125000)) +;;;### (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) @@ -10767,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" (22387 39326 619711 -;;;;;; 122000)) +;;;### (autoloads nil "find-dired" "find-dired.el" (0 0 0 0)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10808,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" (22387 39326 619711 -;;;;;; 122000)) +;;;### (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)))) "\ @@ -10899,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" (22578 -;;;;;; 62356 716212 159000)) +;;;### (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. @@ -11070,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" (22387 39326 620711 -;;;;;; 118000)) +;;;### (autoloads nil "find-lisp" "find-lisp.el" (0 0 0 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -11091,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" (22387 39326 621711 115000)) +;;;### (autoloads nil "finder" "finder.el" (0 0 0 0)) ;;; Generated autoloads from finder.el (push (purecopy '(finder 1 0)) package--builtin-versions) @@ -11113,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" (22387 39326 622711 -;;;;;; 111000)) +;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (0 0 0 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -11135,11 +12821,12 @@ 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" "gnus/flow-fill.el" (22387 39327 -;;;;;; 449708 159000)) -;;; Generated autoloads from gnus/flow-fill.el +;;;### (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" "\ @@ -11151,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" (22387 39328 -;;;;;; 328705 20000)) +;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) @@ -11182,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" (22387 39328 -;;;;;; 535704 281000)) +;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11253,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" (22387 39326 622711 -;;;;;; 111000)) +;;;### (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" (22387 39326 623711 108000)) +;;;### (autoloads nil "follow" "follow.el" (0 0 0 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11382,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" (22387 39327 -;;;;;; 923706 466000)) +;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0)) ;;; Generated autoloads from mail/footnote.el (push (purecopy '(footnote 0 19)) package--builtin-versions) @@ -11402,9 +13103,18 @@ play around with the following keys: \(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" (22387 39326 627711 93000)) +;;;### (autoloads nil "forms" "forms.el" (0 0 0 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11438,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" (22387 39328 -;;;;;; 329705 17000)) +;;;### (autoloads nil "fortran" "progmodes/fortran.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11516,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" (22387 39328 261705 -;;;;;; 259000)) +;;;### (autoloads nil "fortune" "play/fortune.el" (0 0 0 0)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11556,6 +13268,13 @@ and choose the directory as the fortune-file. \(fn &optional FILE)" t nil) +(autoload 'fortune-message "fortune" "\ +Display a fortune cookie to the mini-buffer. +If called with a prefix, it has the same behavior as `fortune'. +Optional FILE is a fortune file from which a cookie will be selected. + +\(fn &optional FILE)" t nil) + (autoload 'fortune "fortune" "\ Display a fortune cookie. If called with a prefix asks for the FILE to choose the fortune from, @@ -11565,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" (22387 39326 628711 -;;;;;; 90000)) +;;;### (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)) "\ @@ -11752,17 +13472,33 @@ 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 "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" (22387 39328 -;;;;;; 261705 259000)) +;;;### (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" (22578 62356 -;;;;;; 739212 35000)) +;;;### (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 "\ @@ -11842,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 "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" (22387 39327 -;;;;;; 306708 669000)) +;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11923,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 "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" (22387 39328 -;;;;;; 335704 995000)) +;;;### (autoloads nil "glasses" "progmodes/glasses.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11938,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" (22387 39327 -;;;;;; 449708 159000)) +;;;### (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" "\ @@ -11993,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" (22387 39327 493708 2000)) +;;;### (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) @@ -12043,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" (22387 39327 -;;;;;; 450708 155000)) +;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -12134,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" (22578 62356 -;;;;;; 721212 132000)) +;;;### (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" "\ @@ -12145,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-bookmark" "gnus/gnus-bookmark.el" (22387 -;;;;;; 39327 457708 130000)) +;;;### (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-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" "\ @@ -12169,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" (22387 39327 -;;;;;; 457708 130000)) +;;;### (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" "\ @@ -12211,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" (22387 39327 -;;;;;; 460708 119000)) +;;;### (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" "\ @@ -12247,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" (22387 39327 -;;;;;; 461708 116000)) +;;;### (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" "\ @@ -12263,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" (22387 39327 -;;;;;; 461708 116000)) +;;;### (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" "\ @@ -12274,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" (22387 39327 -;;;;;; 461708 116000)) +;;;### (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" "\ @@ -12285,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-fun" "gnus/gnus-fun.el" (22387 39327 -;;;;;; 463708 109000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus--random-face-with-type "gnus-fun" "\ @@ -12351,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" (22387 -;;;;;; 39327 463708 109000)) +;;;### (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" "\ @@ -12369,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" (22387 39327 -;;;;;; 465708 101000)) +;;;### (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" "\ @@ -12387,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" (22387 39327 -;;;;;; 466708 98000)) +;;;### (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" "\ @@ -12403,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-kill" "gnus/gnus-kill.el" (22387 39327 -;;;;;; 469708 87000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12417,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-ml" "gnus/gnus-ml.el" (22387 39327 470708 -;;;;;; 83000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -12441,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" (22387 39327 -;;;;;; 470708 83000)) +;;;### (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" "\ @@ -12542,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" (22387 39327 -;;;;;; 471708 80000)) +;;;### (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" "\ @@ -12569,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" -;;;;;; (22387 39327 472708 76000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12586,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" (22387 39327 -;;;;;; 472708 76000)) +;;;### (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" "\ @@ -12610,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" (22387 39327 -;;;;;; 473708 73000)) +;;;### (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" "\ @@ -12678,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" (22387 -;;;;;; 39327 473708 73000)) +;;;### (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" "\ @@ -12694,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-sieve" "gnus/gnus-sieve.el" (22387 39327 -;;;;;; 476708 62000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12722,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" (22387 39327 -;;;;;; 476708 62000)) +;;;### (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" "\ @@ -12733,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-start" "gnus/gnus-start.el" (22387 39327 -;;;;;; 479708 51000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12744,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" (22387 39327 -;;;;;; 482708 41000)) +;;;### (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" "\ @@ -12756,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" (22387 39327 -;;;;;; 486708 26000)) -;;; 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-win" "gnus/gnus-win.el" (22387 39327 -;;;;;; 491708 8000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12783,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" (22387 39327 974706 -;;;;;; 284000)) +;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12800,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" (22387 39328 263705 -;;;;;; 252000)) +;;;### (autoloads nil "gomoku" "play/gomoku.el" (0 0 0 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12827,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" (22387 39327 -;;;;;; 974706 284000)) +;;;### (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") @@ -12869,11 +14790,12 @@ 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" "gnus/gravatar.el" (22387 39327 -;;;;;; 494707 998000)) -;;; Generated autoloads from gnus/gravatar.el +;;;### (autoloads nil "gravatar" "image/gravatar.el" (0 0 0 0)) +;;; Generated autoloads from image/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ Retrieve MAIL-ADDRESS gravatar and call CB on retrieval. @@ -12886,10 +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" (22387 39328 336704 -;;;;;; 992000)) +;;;### (autoloads nil "grep" "progmodes/grep.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -13054,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" (22387 39326 630711 83000)) +;;;### (autoloads nil "gs" "gs.el" (0 0 0 0)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -13067,10 +14992,18 @@ 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 "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" (22432 21609 981325 -;;;;;; 89000)) +;;;### (autoloads nil "gud" "progmodes/gud.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -13170,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" (22490 22723 681600 -;;;;;; 690000)) +;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -13273,10 +15207,11 @@ binding mode. \(fn PLACE)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gv" '("gv-"))) + ;;;*** -;;;### (autoloads nil "handwrite" "play/handwrite.el" (22387 39328 -;;;;;; 263705 252000)) +;;;### (autoloads nil "handwrite" "play/handwrite.el" (0 0 0 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -13291,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" (22387 39328 264705 -;;;;;; 249000)) +;;;### (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" "\ @@ -13319,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" (22387 39327 -;;;;;; 924706 463000)) +;;;### (autoloads nil "hashcash" "mail/hashcash.el" (0 0 0 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13362,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" (22387 39326 631711 -;;;;;; 79000)) +;;;### (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" "\ @@ -13490,10 +15436,11 @@ 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" (22578 62356 721212 -;;;;;; 132000)) +;;;### (autoloads nil "help-fns" "help-fns.el" (0 0 0 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13579,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" (22387 39326 632711 -;;;;;; 75000)) +;;;### (autoloads nil "help-macro" "help-macro.el" (0 0 0 0)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13594,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" (22578 62356 721212 -;;;;;; 132000)) +;;;### (autoloads nil "help-mode" "help-mode.el" (0 0 0 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13696,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" (22387 39327 -;;;;;; 307708 665000)) +;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13712,9 +15662,18 @@ Provide help for current mode. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "helper" '("Helper-"))) + +;;;*** + +;;;### (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" (22387 39326 635711 65000)) +;;;### (autoloads nil "hexl" "hexl.el" (0 0 0 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13806,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" (22387 39326 636711 -;;;;;; 61000)) +;;;### (autoloads nil "hi-lock" "hi-lock.el" (0 0 0 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13975,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" (22387 39328 -;;;;;; 338704 984000)) +;;;### (autoloads nil "hideif" "progmodes/hideif.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -14023,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" (22387 39328 -;;;;;; 339704 981000)) +;;;### (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))) "\ @@ -14086,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" (22387 39326 637711 -;;;;;; 58000)) +;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (0 0 0 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -14219,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" (22387 39326 638711 -;;;;;; 54000)) +;;;### (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) @@ -14252,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" (22387 39326 638711 -;;;;;; 54000)) +;;;### (autoloads nil "hl-line" "hl-line.el" (0 0 0 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -14273,7 +16238,7 @@ 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) @@ -14295,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 "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 "holidays" "calendar/holidays.el" (22387 39327 -;;;;;; 110709 369000)) +;;;### (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"))) "\ @@ -14414,21 +16394,23 @@ 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" "gnus/html2text.el" (22387 39327 -;;;;;; 495707 994000)) -;;; Generated autoloads from gnus/html2text.el +;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0)) +;;; Generated autoloads from net/html2text.el (autoload 'html2text "html2text" "\ 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" (22387 39326 -;;;;;; 639711 51000)) +;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -14442,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 @@ -14459,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 nil "ibuf-macs" "ibuf-macs.el" (22387 39326 641711 -;;;;;; 43000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14536,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) @@ -14562,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" (22387 39326 642711 -;;;;;; 40000)) +;;;### (autoloads nil "ibuffer" "ibuffer.el" (0 0 0 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14602,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" (22578 -;;;;;; 62356 713212 175000)) +;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/icalendar.el (push (purecopy '(icalendar 0 19)) package--builtin-versions) @@ -14656,10 +16656,11 @@ 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" (22387 39326 643711 -;;;;;; 36000)) +;;;### (autoloads nil "icomplete" "icomplete.el" (0 0 0 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14697,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" (22387 39328 340704 -;;;;;; 977000)) +;;;### (autoloads nil "icon" "progmodes/icon.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14738,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-shell" "progmodes/idlw-shell.el" (22387 -;;;;;; 39328 342704 970000)) +;;;### (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" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14764,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 "idlwave" "progmodes/idlwave.el" (22578 62356 -;;;;;; 741212 24000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from progmodes/idlwave.el (push (purecopy '(idlwave 6 1 22)) package--builtin-versions) @@ -14894,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" (22387 39326 645711 29000)) +;;;### (autoloads nil "ido" "ido.el" (0 0 0 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -15156,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" (22387 39326 646711 25000)) +;;;### (autoloads nil "ielm" "ielm.el" (0 0 0 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -15168,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 "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" (22387 39326 646711 25000)) +;;;### (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") @@ -15184,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" (22387 39326 650711 11000)) +;;;### (autoloads nil "image" "image.el" (0 0 0 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15377,10 +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" (22387 39326 -;;;;;; 648711 18000)) +;;;### (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) @@ -15515,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" (22387 39326 649711 -;;;;;; 15000)) +;;;### (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")) "\ @@ -15579,16 +17625,17 @@ 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" (22387 39326 649711 -;;;;;; 15000)) +;;;### (autoloads nil "image-mode" "image-mode.el" (0 0 0 0)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ Major mode for image files. -You can use \\<image-mode-map>\\[image-toggle-display] -to toggle between display as an image and display as text. +You can use \\<image-mode-map>\\[image-toggle-display] or \\<image-mode-map>\\[image-toggle-hex-display] +to toggle between display as an image and display as text or hex. Key bindings: \\{image-mode-map} @@ -15607,29 +17654,30 @@ actual image. \(fn &optional ARG)" t nil) -(autoload 'image-mode-as-text "image-mode" "\ +(autoload 'image-mode-to-text "image-mode" "\ Set a non-image mode as major mode in combination with image minor mode. -A non-image major mode found from `auto-mode-alist' or Fundamental mode -displays an image file as text. `image-minor-mode' provides the key -\\<image-mode-map>\\[image-toggle-display] to switch back to `image-mode' -to display an image file as the actual image. - -You can use `image-mode-as-text' in `auto-mode-alist' when you want -to display an image file as text initially. - -See commands `image-mode' and `image-minor-mode' for more information -on these modes. +A non-mage major mode found from `auto-mode-alist' or fundamental mode +displays an image file as text. -\(fn)" t nil) +\(fn)" nil nil) (autoload 'image-bookmark-jump "image-mode" "\ \(fn BMK)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-mode" '("image-"))) + +;;;*** + +;;;### (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" (22387 39326 651711 8000)) +;;;### (autoloads nil "imenu" "imenu.el" (0 0 0 0)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15765,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" (22578 62356 -;;;;;; 725212 110000)) +;;;### (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" "\ @@ -15796,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" (22387 39328 -;;;;;; 351704 938000)) +;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15815,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" (22578 62356 723212 121000)) +;;;### (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 @@ -16027,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" (22387 39326 652711 -;;;;;; 4000)) +;;;### (autoloads nil "info-look" "info-look.el" (0 0 0 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -16075,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" (22387 39326 653711 -;;;;;; 0)) +;;;### (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) @@ -16159,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" (22387 39326 656710 -;;;;;; 990000)) +;;;### (autoloads nil "informat" "informat.el" (0 0 0 0)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -16205,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" (22387 39327 -;;;;;; 307708 665000)) +;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/inline.el (autoload 'define-inline "inline" "\ @@ -16220,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" (22387 39327 -;;;;;; 136709 276000)) +;;;### (autoloads nil "inversion" "cedet/inversion.el" (0 0 0 0)) ;;; Generated autoloads from cedet/inversion.el (push (purecopy '(inversion 1 3)) package--builtin-versions) @@ -16233,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" (22387 -;;;;;; 39327 581707 687000)) +;;;### (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" "\ @@ -16254,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" (22387 39326 658710 -;;;;;; 983000)) +;;;### (autoloads nil "isearchb" "isearchb.el" (0 0 0 0)) ;;; Generated autoloads from isearchb.el (push (purecopy '(isearchb 1 5)) package--builtin-versions) @@ -16269,10 +18329,20 @@ accessed via isearchb. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearchb" '("isearchb"))) + ;;;*** -;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (22387 -;;;;;; 39327 582707 684000)) +;;;### (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" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -16360,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" -;;;;;; (22387 39327 583707 680000)) +;;;;;; (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" (22387 39328 -;;;;;; 536704 278000)) +;;;### (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)))) @@ -16411,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{}. @@ -16591,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: @@ -16602,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 "japan-util" "language/japan-util.el" (22387 -;;;;;; 39327 660707 405000)) +;;;### (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" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -16680,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" (22387 39326 660710 -;;;;;; 976000)) +;;;### (autoloads nil "jka-compr" "jka-compr.el" (0 0 0 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16704,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" (22578 62356 742212 -;;;;;; 19000)) +;;;### (autoloads nil "js" "progmodes/js.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/js.el (push (purecopy '(js 9)) package--builtin-versions) @@ -16732,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" (22387 39326 661710 972000)) +;;;### (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 "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" (22387 39327 -;;;;;; 368708 448000)) +;;;### (autoloads nil "keypad" "emulation/keypad.el" (0 0 0 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16796,8 +18899,8 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** -;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (22387 -;;;;;; 39327 593707 644000)) +;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16816,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" (22387 39327 594707 -;;;;;; 641000)) +;;;### (autoloads nil "kkc" "international/kkc.el" (0 0 0 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16839,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" (22387 39326 662710 968000)) +;;;### (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) @@ -16951,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" (22387 -;;;;;; 39327 661707 402000)) +;;;### (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" "")) "\ @@ -16966,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" (22387 39327 -;;;;;; 662707 398000)) +;;;### (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" "\ @@ -17004,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" (22387 -;;;;;; 39327 594707 641000)) +;;;### (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))) "\ @@ -17036,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" -;;;;;; (22387 39327 607707 594000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -17078,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" (22387 -;;;;;; 39328 365704 888000)) +;;;### (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" "\ @@ -17089,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 "let-alist" "emacs-lisp/let-alist.el" (22387 -;;;;;; 39327 308708 662000)) +;;;### (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" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/let-alist.el (push (purecopy '(let-alist 1 0 4)) package--builtin-versions) @@ -17129,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" (22387 39328 265705 245000)) +;;;### (autoloads nil "life" "play/life.el" (0 0 0 0)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -17142,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" (22387 39326 675710 922000)) +;;;### (autoloads nil "linum" "linum.el" (0 0 0 0)) ;;; Generated autoloads from linum.el (push (purecopy '(linum 0 9 24)) package--builtin-versions) @@ -17180,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" (22387 39326 685710 -;;;;;; 886000)) +;;;### (autoloads nil "loadhist" "loadhist.el" (0 0 0 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -17212,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" (22387 39326 686710 883000)) +;;;### (autoloads nil "locate" "locate.el" (0 0 0 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -17264,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" (22387 39328 663703 -;;;;;; 824000)) +;;;### (autoloads nil "log-edit" "vc/log-edit.el" (0 0 0 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -17296,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" (22387 39328 663703 -;;;;;; 824000)) +;;;### (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" "\ @@ -17307,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" (22387 39326 687710 879000)) +;;;### (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") "\ @@ -17402,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" (22578 62356 725212 -;;;;;; 110000)) +;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (0 0 0 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17414,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" (22387 39327 112709 -;;;;;; 362000)) +;;;### (autoloads nil "lunar" "calendar/lunar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -17427,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" (22387 39328 -;;;;;; 365704 888000)) +;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17438,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" (22387 39326 688710 876000)) +;;;### (autoloads nil "macros" "macros.el" (0 0 0 0)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17529,8 +19685,7 @@ and then select the region of un-tablified names and use ;;;*** -;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (22387 39327 -;;;;;; 924706 463000)) +;;;### (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" "\ @@ -17558,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" (22387 39327 -;;;;;; 925706 459000)) +;;;### (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" "\ @@ -17588,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" (22387 39327 -;;;;;; 925706 459000)) +;;;### (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 "\ @@ -17663,10 +19842,11 @@ 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" (22387 39327 -;;;;;; 926706 456000)) +;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17714,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" (22387 39327 -;;;;;; 926706 456000)) +;;;### (autoloads nil "mailalias" "mail/mailalias.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17768,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 "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" (22387 39327 -;;;;;; 927706 452000)) +;;;### (autoloads nil "mailclient" "mail/mailclient.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17781,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 "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" (22387 -;;;;;; 39328 366704 885000)) +;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17899,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 "makesum" "makesum.el" (22387 39326 688710 -;;;;;; 876000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17911,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" (22578 62356 726212 105000)) +;;;### (autoloads nil "man" "man.el" (0 0 0 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17967,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 "map" "emacs-lisp/map.el" (22387 39327 311708 -;;;;;; 651000)) +;;;### (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" (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" (22387 39326 690710 868000)) +;;;### (autoloads nil "master" "master.el" (0 0 0 0)) ;;; Generated autoloads from master.el (push (purecopy '(master 1 0 2)) package--builtin-versions) @@ -17997,10 +20222,11 @@ 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" (22387 39326 690710 -;;;;;; 868000)) +;;;### (autoloads nil "mb-depth" "mb-depth.el" (0 0 0 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -18026,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" (22387 39326 691710 865000)) +;;;### (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" (22387 39327 500707 -;;;;;; 977000)) +;;;### (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) @@ -18198,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" (22387 -;;;;;; 39328 367704 881000)) +;;;### (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) @@ -18215,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" (22387 39327 -;;;;;; 928706 448000)) +;;;### (autoloads nil "metamail" "mail/metamail.el" (0 0 0 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -18259,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-comp" "mh-e/mh-comp.el" (22387 39327 947706 -;;;;;; 380000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -18350,11 +20604,20 @@ 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" (22387 39327 948706 377000)) +;;;### (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)) package--builtin-versions) +(push (purecopy '(mh-e 8 6 -4)) package--builtin-versions) (put 'mh-progs 'risky-local-variable t) @@ -18367,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" (22387 39327 -;;;;;; 949706 373000)) +;;;### (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" "\ @@ -18449,10 +20713,132 @@ 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 "midnight" "midnight.el" (22387 39326 692710 -;;;;;; 861000)) +;;;### (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 "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 "\ @@ -18491,10 +20877,11 @@ 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" (22387 39326 -;;;;;; 693710 858000)) +;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (0 0 0 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18522,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" (22387 39326 694710 854000)) +;;;### (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 @@ -18550,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" (22387 39326 695710 -;;;;;; 851000)) +;;;### (autoloads nil "misearch" "misearch.el" (0 0 0 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18639,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" (22387 -;;;;;; 39328 368704 877000)) +;;;### (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) @@ -18651,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-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" (22387 39327 -;;;;;; 504707 962000)) +;;;### (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" "\ @@ -18662,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" (22387 39327 -;;;;;; 504707 962000)) +;;;### (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" "\ @@ -18681,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" (22387 39327 -;;;;;; 505707 959000)) +;;;### (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" "\ @@ -18695,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" (22387 39327 505707 -;;;;;; 959000)) +;;;### (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" "\ @@ -18712,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-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" (22387 39327 506707 -;;;;;; 955000)) +;;;### (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" "\ @@ -18732,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 "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" (22387 39327 509707 944000)) +;;;### (autoloads nil "mml" "gnus/mml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18757,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 "mml1991" "gnus/mml1991.el" (22387 39327 509707 -;;;;;; 944000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18773,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" (22387 39327 510707 -;;;;;; 941000)) +;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18814,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" (22387 39327 -;;;;;; 137709 272000)) +;;;### (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" (22387 39328 -;;;;;; 369704 874000)) +;;;### (autoloads nil "modula2" "progmodes/modula2.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18856,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" (22387 39328 265705 -;;;;;; 245000)) +;;;### (autoloads nil "morse" "play/morse.el" (0 0 0 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18882,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" (22387 39326 695710 -;;;;;; 851000)) +;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (0 0 0 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18930,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" (22387 39326 697710 843000)) +;;;### (autoloads nil "mpc" "mpc.el" (0 0 0 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18940,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" (22387 39328 265705 245000)) +;;;### (autoloads nil "mpuz" "play/mpuz.el" (0 0 0 0)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18950,9 +21458,11 @@ Multiplication puzzle with GNU Emacs. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpuz" '("mpuz-"))) + ;;;*** -;;;### (autoloads nil "msb" "msb.el" (22387 39326 698710 840000)) +;;;### (autoloads nil "msb" "msb.el" (0 0 0 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18976,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" (22387 -;;;;;; 39327 612707 577000)) +;;;### (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" "\ @@ -19109,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" (22387 -;;;;;; 39327 613707 573000)) +;;;### (autoloads nil "mule-util" "international/mule-util.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -19269,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 "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" (22387 39327 -;;;;;; 978706 270000)) +;;;### (autoloads nil "net-utils" "net/net-utils.el" (0 0 0 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -19364,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" (22387 39327 979706 -;;;;;; 266000)) +;;;### (autoloads nil "netrc" "net/netrc.el" (0 0 0 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -19377,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" (22387 -;;;;;; 39327 979706 266000)) +;;;### (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" "\ @@ -19396,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: @@ -19467,17 +21999,25 @@ non-nil, is used warn the user if the connection isn't encrypted. :nogreeting is a boolean that can be used to inhibit waiting for a greeting from the server. -:nowait is a boolean that says the connection should be made +:nowait, if non-nil, says the connection should be made asynchronously, if possible. +:tls-parameters is a list that should be supplied if you're +opening a TLS connection. The first element is the TLS +type (either `gnutls-x509pki' or `gnutls-anon'), and the +remaining elements should be a keyword list accepted by +gnutls-boot (as returned by `gnutls-boot-parameters'). + \(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil) (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" (22387 -;;;;;; 39327 980706 263000)) +;;;### (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" "\ @@ -19496,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" -;;;;;; (22387 39327 981706 259000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19507,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" (22387 -;;;;;; 39327 982706 255000)) +;;;### (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" "\ @@ -19518,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" (22387 -;;;;;; 39327 983706 252000)) +;;;### (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" "\ @@ -19539,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" (22387 -;;;;;; 39327 983706 252000)) +;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19550,10 +22098,32 @@ Start newsticker treeview. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-treeview" '("newsticker-"))) + +;;;*** + +;;;### (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" (22387 39327 511707 -;;;;;; 937000)) +;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19561,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" (22387 39327 513707 -;;;;;; 930000)) +;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19576,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" (22387 39327 -;;;;;; 514707 926000)) +;;;### (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" "\ @@ -19588,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 "nnml" "gnus/nnml.el" (22387 39327 523707 894000)) +;;;### (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 "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" "\ @@ -19598,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 "novice" "novice.el" (22387 39326 702710 825000)) +;;;### (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 "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") @@ -19630,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" (22387 -;;;;;; 39328 538704 271000)) +;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19645,29 +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" (22387 39327 985706 245000)) +;;;### (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-glyph" "nxml/nxml-glyph.el" (22387 39328 -;;;;;; 40706 49000)) -;;; Generated autoloads from nxml/nxml-glyph.el +;;;### (autoloads nil "nxml-enc" "nxml/nxml-enc.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-enc.el -(autoload 'nxml-glyph-display-string "nxml-glyph" "\ -Return a string that can display a glyph for Unicode code-point N. -FACE gives the face that will be used for displaying the string. -Return nil if the face cannot display a glyph for N. +(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 -\(fn N FACE)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set"))) ;;;*** -;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (22387 39328 -;;;;;; 41706 45000)) +;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (0 0 0 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19725,23 +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-uchnm" "nxml/nxml-uchnm.el" (22387 39328 -;;;;;; 60705 977000)) -;;; Generated autoloads from nxml/nxml-uchnm.el +;;;### (autoloads nil "nxml-ns" "nxml/nxml-ns.el" (0 0 0 0)) +;;; Generated autoloads from nxml/nxml-ns.el -(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ -Enable the use of Unicode standard names for characters. -The Unicode blocks for which names are enabled is controlled by -the variable `nxml-enabled-unicode-blocks'. +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-ns" '("nxml-ns-"))) -\(fn)" t nil) +;;;*** + +;;;### (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 "octave" "progmodes/octave.el" (22387 39328 -;;;;;; 370704 870000)) +;;;### (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 "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" "\ @@ -19776,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" (22387 39328 -;;;;;; 372704 863000)) +;;;### (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") @@ -19812,9 +22921,11 @@ Coloring: \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "opascal" '("opascal-"))) + ;;;*** -;;;### (autoloads nil "org" "org/org.el" (22578 62356 737212 46000)) +;;;### (autoloads nil "org" "org/org.el" (0 0 0 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -20033,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" (22387 39328 -;;;;;; 198705 484000)) +;;;### (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" "\ @@ -20307,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 "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 nil "org-capture" "org/org-capture.el" (22387 39328 -;;;;;; 202705 470000)) +;;;### (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" "\ @@ -20350,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 nil "org-colview" "org/org-colview.el" (22387 39328 -;;;;;; 205705 459000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from org/org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -20414,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" (22387 39328 -;;;;;; 205705 459000)) +;;;### (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" "\ @@ -20425,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-macs" "org/org-macs.el" (22387 39328 221705 -;;;;;; 402000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from org/org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ @@ -20436,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 nil "org-version" "org/org-version.el" (22387 39328 -;;;;;; 229705 374000)) +;;;### (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 "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" "\ @@ -20456,8 +23830,14 @@ The Git version of org-mode. ;;;*** -;;;### (autoloads nil "outline" "outline.el" (22578 62356 737212 -;;;;;; 46000)) +;;;### (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) @@ -20498,10 +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 nil "package" "emacs-lisp/package.el" (22421 48078 -;;;;;; 37624 440000)) +;;;### (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 "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) @@ -20617,9 +24094,26 @@ 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" (22387 39326 859710 265000)) +;;;### (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 "\ @@ -20644,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" (22387 -;;;;;; 39327 112709 362000)) +;;;### (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" (22387 39328 -;;;;;; 373704 859000)) +;;;### (autoloads nil "pascal" "progmodes/pascal.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20708,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" (22387 -;;;;;; 39326 860710 261000)) +;;;### (autoloads nil "password-cache" "password-cache.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20730,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" (22387 39327 -;;;;;; 315708 637000)) +;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20834,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) @@ -20851,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" (22387 39326 860710 -;;;;;; 261000)) +;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20862,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" (22387 39326 863710 -;;;;;; 251000)) +;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20888,12 +24394,18 @@ Completion for the GNU tar utility. \(fn)" nil nil) +(autoload 'pcomplete/find "pcmpl-gnu" "\ +Completion for the GNU find utility. + +\(fn)" nil nil) + (defalias 'pcomplete/gdb 'pcomplete/xargs) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-"))) + ;;;*** -;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (22387 39326 -;;;;;; 863710 251000)) +;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20911,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" (22387 39326 863710 -;;;;;; 251000)) +;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20922,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" (22387 39326 869710 -;;;;;; 229000)) +;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -20978,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" (22387 39326 870710 -;;;;;; 226000)) +;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-x.el (autoload 'pcomplete/tlmgr "pcmpl-x" "\ @@ -21003,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" (22387 39326 871710 -;;;;;; 222000)) +;;;### (autoloads nil "pcomplete" "pcomplete.el" (0 0 0 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -21061,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" (22578 62356 750211 976000)) +;;;### (autoloads nil "pcvs" "vc/pcvs.el" (0 0 0 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -21136,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" (22387 39328 -;;;;;; 664703 821000)) +;;;### (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 "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" (22387 -;;;;;; 39328 374704 856000)) +;;;### (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) @@ -21207,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" (22387 39328 -;;;;;; 540704 263000)) +;;;### (autoloads nil "picture" "textmodes/picture.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -21288,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" (22387 39327 986706 -;;;;;; 241000)) +;;;### (autoloads nil "pinentry" "net/pinentry.el" (0 0 0 0)) ;;; Generated autoloads from net/pinentry.el (push (purecopy '(pinentry 0 1)) package--builtin-versions) @@ -21306,11 +24850,12 @@ will not be shown. \(fn &optional QUIET)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pinentry" '("pinentry-"))) + ;;;*** -;;;### (autoloads nil "plstore" "gnus/plstore.el" (22387 39327 528707 -;;;;;; 877000)) -;;; Generated autoloads from gnus/plstore.el +;;;### (autoloads nil "plstore" "plstore.el" (0 0 0 0)) +;;; Generated autoloads from plstore.el (autoload 'plstore-open "plstore" "\ Create a plstore instance associated with FILE. @@ -21322,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" (22387 39328 540704 -;;;;;; 263000)) +;;;### (autoloads nil "po" "textmodes/po.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -21334,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" (22387 39328 266705 242000)) +;;;### (autoloads nil "pong" "play/pong.el" (0 0 0 0)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -21350,10 +24898,12 @@ pong-mode keybindings:\\<pong-mode-map> \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pong" '("pong-"))) + ;;;*** -;;;### (autoloads nil "pop3" "gnus/pop3.el" (22387 39327 529707 873000)) -;;; Generated autoloads from gnus/pop3.el +;;;### (autoloads nil "pop3" "net/pop3.el" (0 0 0 0)) +;;; Generated autoloads from net/pop3.el (autoload 'pop3-movemail "pop3" "\ Transfer contents of a maildrop to the specified FILE. @@ -21361,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" (22387 39327 315708 -;;;;;; 637000)) +;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -21412,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" (22578 62356 738212 -;;;;;; 40000)) +;;;### (autoloads nil "printing" "printing.el" (0 0 0 0)) ;;; Generated autoloads from printing.el (push (purecopy '(printing 6 9 3)) package--builtin-versions) @@ -22001,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" (22387 39326 874710 211000)) +;;;### (autoloads nil "proced" "proced.el" (0 0 0 0)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -22019,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" (22432 21609 980325 -;;;;;; 95000)) +;;;### (autoloads nil "profiler" "profiler.el" (0 0 0 0)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -22048,10 +25603,11 @@ Open profile FILENAME. \(fn FILENAME)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "profiler" '("profiler-"))) + ;;;*** -;;;### (autoloads nil "project" "progmodes/project.el" (22387 39328 -;;;;;; 379704 838000)) +;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el (autoload 'project-current "project" "\ @@ -22091,10 +25647,11 @@ recognized. \(fn)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-"))) + ;;;*** -;;;### (autoloads nil "prolog" "progmodes/prolog.el" (22387 39328 -;;;;;; 381704 831000)) +;;;### (autoloads nil "prolog" "progmodes/prolog.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -22125,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" (22387 39326 876710 204000)) +;;;### (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")) "\ @@ -22136,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" (22387 39328 -;;;;;; 381704 831000)) +;;;### (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) @@ -22183,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 "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" (22387 39326 881710 -;;;;;; 186000)) +;;;### (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) @@ -22381,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" (22387 39327 137709 -;;;;;; 272000)) +;;;### (autoloads nil "pulse" "cedet/pulse.el" (0 0 0 0)) ;;; Generated autoloads from cedet/pulse.el (push (purecopy '(pulse 1 0)) package--builtin-versions) @@ -22400,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" (22578 62356 -;;;;;; 743212 14000)) +;;;### (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)) @@ -22438,10 +26023,12 @@ 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" "gnus/qp.el" (22387 39327 530707 869000)) -;;; Generated autoloads from gnus/qp.el +;;;### (autoloads nil "qp" "mail/qp.el" (0 0 0 0)) +;;; Generated autoloads from mail/qp.el (autoload 'quoted-printable-decode-region "qp" "\ Decode quoted-printable in the region between FROM and TO, per RFC 2045. @@ -22457,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" (22387 39327 -;;;;;; 616707 562000)) +;;;### (autoloads nil "quail" "international/quail.el" (0 0 0 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22688,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/hangul" "leim/quail/hangul.el" (22387 -;;;;;; 39327 824706 820000)) +;;;### (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" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from leim/quail/hangul.el (autoload 'hangul-input-method-activate "quail/hangul" "\ @@ -22701,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" -;;;;;; (22387 39327 864706 677000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from leim/quail/uni-input.el (autoload 'ucs-input-activate "quail/uni-input" "\ @@ -22716,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 "quickurl" "net/quickurl.el" (22387 39327 986706 -;;;;;; 241000)) +;;;### (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" (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" "\ @@ -22788,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 "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" (22387 39327 987706 -;;;;;; 238000)) +;;;### (autoloads nil "rcirc" "net/rcirc.el" (0 0 0 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22808,7 +26485,7 @@ If ARG is non-nil, instead prompt for connection parameters. (autoload 'rcirc-connect "rcirc" "\ -\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION)" nil nil) +\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS)" nil nil) (defvar rcirc-track-minor-mode nil "\ Non-nil if Rcirc-Track minor mode is enabled. @@ -22828,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" (22387 -;;;;;; 39327 315708 637000)) +;;;### (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) @@ -22847,10 +26526,11 @@ 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" (22387 39326 883710 -;;;;;; 179000)) +;;;### (autoloads nil "recentf" "recentf.el" (0 0 0 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22875,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" (22578 62356 744212 8000)) +;;;### (autoloads nil "rect" "rect.el" (0 0 0 0)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -23015,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" (22387 39328 -;;;;;; 545704 246000)) +;;;### (autoloads nil "refill" "textmodes/refill.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -23036,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" (22387 39328 -;;;;;; 554704 213000)) +;;;### (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") @@ -23090,20 +26788,96 @@ This enforces rescanning the buffer on next use. \(fn)" nil nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex" '("reftex-"))) + ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (22387 -;;;;;; 39328 552704 220000)) +;;;### (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 "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" (22490 -;;;;;; 22723 775600 274000)) +;;;### (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" "\ @@ -23156,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" (22387 39327 316708 -;;;;;; 633000)) +;;;### (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 "remember" "textmodes/remember.el" (22387 39328 -;;;;;; 554704 213000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from textmodes/remember.el (push (purecopy '(remember 2 0)) package--builtin-versions) @@ -23218,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" (22387 39326 885710 172000)) +;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0)) ;;; Generated autoloads from repeat.el (push (purecopy '(repeat 0 51)) package--builtin-versions) @@ -23241,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" (22387 39327 -;;;;;; 929706 445000)) +;;;### (autoloads nil "reporter" "mail/reporter.el" (0 0 0 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -23273,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" (22387 39326 886710 -;;;;;; 169000)) +;;;### (autoloads nil "reposition" "reposition.el" (0 0 0 0)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -23300,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" (22387 39326 887710 165000)) +;;;### (autoloads nil "reveal" "reveal.el" (0 0 0 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -23336,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" (22387 39327 317708 -;;;;;; 630000)) +;;;### (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" "\ @@ -23352,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" (22387 39327 989706 -;;;;;; 231000)) +;;;### (autoloads nil "rlogin" "net/rlogin.el" (0 0 0 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -23397,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" (22387 39327 932706 -;;;;;; 434000)) +;;;### (autoloads nil "rmail" "mail/rmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -23408,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.") @@ -23595,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" (22387 39327 -;;;;;; 935706 423000)) +;;;### (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) @@ -23660,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 nil "rng-cmpct" "nxml/rng-cmpct.el" (22387 39328 -;;;;;; 61705 974000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23672,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" (22387 39328 -;;;;;; 63705 966000)) +;;;### (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" "\ @@ -23685,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" (22387 39328 -;;;;;; 66705 956000)) +;;;### (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" "\ @@ -23716,22 +27666,23 @@ 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" (22387 39328 67705 -;;;;;; 952000)) +;;;### (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) +(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile #'rng-xsd-compile) (autoload 'rng-xsd-compile "rng-xsd" "\ Provides W3C XML Schema as a RELAX NG datatypes library. NAME is a symbol giving the local name of the datatype. PARAMS is a list of pairs (PARAM-NAME . PARAM-VALUE) where PARAM-NAME is a symbol giving the name of the parameter and PARAM-VALUE is a string giving -its value. If NAME or PARAMS are invalid, it calls rng-dt-error +its value. If NAME or PARAMS are invalid, it calls `rng-dt-error' passing it arguments in the same style as format; the value from -rng-dt-error will be returned. Otherwise, it returns a list. The +`rng-dt-error' will be returned. Otherwise, it returns a list. The first member of the list is t if any string is a legal value for the datatype and nil otherwise. The second argument is a symbol; this symbol will be called as a function passing it a string followed by @@ -23744,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" (22387 39327 -;;;;;; 617707 559000)) +;;;### (autoloads nil "robin" "international/robin.el" (0 0 0 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23777,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" (22387 39326 887710 165000)) +;;;### (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) @@ -23814,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" (22578 62356 749211 -;;;;;; 981000)) +;;;### (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))) @@ -23845,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" (22387 -;;;;;; 39328 385704 817000)) +;;;### (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) @@ -23863,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" (22387 39326 888710 -;;;;;; 161000)) +;;;### (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) @@ -23882,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" (22387 39327 317708 -;;;;;; 630000)) +;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24194,17 +28163,48 @@ enclosed in `(and ...)'. \(fn &rest REGEXPS)" nil t) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rx" '("rx-"))) + +;;;*** + +;;;### (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" (22387 39327 -;;;;;; 990706 227000)) +;;;### (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 "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" (22387 39326 888710 -;;;;;; 161000)) +;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) @@ -24235,10 +28235,11 @@ 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" (22387 39326 889710 -;;;;;; 158000)) +;;;### (autoloads nil "saveplace" "saveplace.el" (0 0 0 0)) ;;; Generated autoloads from saveplace.el (defvar save-place-mode nil "\ @@ -24274,10 +28275,18 @@ file: \(fn &optional ARG)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "saveplace" '("save-place" "load-save-place-alist-from-file"))) + +;;;*** + +;;;### (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" (22387 39328 -;;;;;; 387704 809000)) +;;;### (autoloads nil "scheme" "progmodes/scheme.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24314,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" (22387 39327 -;;;;;; 533707 859000)) +;;;### (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" "\ @@ -24328,10 +28338,11 @@ 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" (22387 39326 890710 -;;;;;; 154000)) +;;;### (autoloads nil "scroll-all" "scroll-all.el" (0 0 0 0)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -24355,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" (22387 39326 -;;;;;; 891710 151000)) +;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (0 0 0 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -24372,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" (22387 39327 991706 -;;;;;; 223000)) +;;;### (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" (22387 39327 -;;;;;; 138709 269000)) +;;;### (autoloads nil "semantic" "cedet/semantic.el" (0 0 0 0)) ;;; Generated autoloads from cedet/semantic.el (push (purecopy '(semantic 2 2)) package--builtin-versions) @@ -24439,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" -;;;;;; (22387 39327 240708 905000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -24450,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" -;;;;;; (22387 39327 249708 873000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -24461,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 "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 "sendmail" "mail/sendmail.el" (22387 39327 -;;;;;; 937706 416000)) +;;;### (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 "\ @@ -24743,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" (22490 22723 987599 -;;;;;; 335000)) +;;;### (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" (22387 39326 892710 147000)) +;;;### (autoloads nil "server" "server.el" (0 0 0 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24761,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 @@ -24818,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" (22458 46685 211272 717000)) +;;;### (autoloads nil "ses" "ses.el" (0 0 0 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24862,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" (22387 -;;;;;; 39328 566704 170000)) +;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24928,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" (22578 -;;;;;; 62356 743212 14000)) +;;;### (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) @@ -24994,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" (22387 39327 -;;;;;; 318708 626000)) +;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -25044,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" (22387 39326 894710 -;;;;;; 140000)) +;;;### (autoloads nil "shadowfile" "shadowfile.el" (0 0 0 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -25083,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" (22387 39326 895710 137000)) +;;;### (autoloads nil "shell" "shell.el" (0 0 0 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25131,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" (22578 62356 730212 84000)) +;;;### (autoloads nil "shr" "net/shr.el" (0 0 0 0)) ;;; Generated autoloads from net/shr.el (autoload 'shr-render-region "shr" "\ @@ -25148,11 +29772,19 @@ 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 "sieve" "gnus/sieve.el" (22387 39327 534707 -;;;;;; 855000)) -;;; Generated autoloads from gnus/sieve.el +;;;### (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" (0 0 0 0)) +;;; Generated autoloads from net/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -25174,11 +29806,20 @@ 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" "gnus/sieve-mode.el" (22387 39327 -;;;;;; 534707 855000)) -;;; Generated autoloads from gnus/sieve-mode.el +;;;### (autoloads nil "sieve-mode" "net/sieve-mode.el" (0 0 0 0)) +;;; Generated autoloads from net/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ Major mode for editing Sieve code. @@ -25190,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" (22387 39328 -;;;;;; 390704 799000)) +;;;### (autoloads nil "simula" "progmodes/simula.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25239,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" (22387 39326 901710 -;;;;;; 115000)) +;;;### (autoloads nil "skeleton" "skeleton.el" (0 0 0 0)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25359,18 +30002,19 @@ 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" (22387 39328 -;;;;;; 668703 806000)) +;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (0 0 0 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ Invoke ediff to resolve the conflicts. -NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the +NAME-UPPER, NAME-LOWER, and NAME-BASE, if non-nil, are used for the buffer names. -\(fn &optional NAME-MINE NAME-OTHER NAME-BASE)" t nil) +\(fn &optional NAME-UPPER NAME-LOWER NAME-BASE)" t nil) (autoload 'smerge-mode "smerge-mode" "\ Minor mode to simplify editing output from the diff3 program. @@ -25387,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 "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" (22387 39327 535707 -;;;;;; 851000)) +;;;### (autoloads nil "smiley" "gnus/smiley.el" (0 0 0 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -25405,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 "smtpmail" "mail/smtpmail.el" (22387 39327 -;;;;;; 938706 413000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -25421,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" (22387 39328 271705 -;;;;;; 224000)) +;;;### (autoloads nil "snake" "play/snake.el" (0 0 0 0)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -25445,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" (22387 39327 -;;;;;; 993706 216000)) +;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (0 0 0 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -25475,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" (22387 39327 -;;;;;; 995706 209000)) +;;;### (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 "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 "solar" "calendar/solar.el" (22387 39327 123709 -;;;;;; 322000)) +;;;### (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" "\ @@ -25498,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" (22387 39328 -;;;;;; 272705 220000)) +;;;### (autoloads nil "solitaire" "play/solitaire.el" (0 0 0 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -25574,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" (22387 39326 901710 115000)) +;;;### (autoloads nil "sort" "sort.el" (0 0 0 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25749,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" (22387 39327 538707 841000)) +;;;### (autoloads nil "spam" "gnus/spam.el" (0 0 0 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25763,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" (22387 -;;;;;; 39327 536707 848000)) +;;;### (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" "\ @@ -25806,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 "speedbar" "speedbar.el" (22387 39326 903710 -;;;;;; 108000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25831,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" (22387 39328 272705 -;;;;;; 220000)) +;;;### (autoloads nil "spook" "play/spook.el" (0 0 0 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25847,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" (22387 39328 393704 -;;;;;; 788000)) +;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/sql.el (push (purecopy '(sql 3 5)) package--builtin-versions) @@ -26314,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" (22387 39327 139709 -;;;;;; 265000)) +;;;### (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" -;;;;;; (22387 39327 265708 816000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -26334,11 +31191,36 @@ 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" "gnus/starttls.el" (22387 39327 -;;;;;; 538707 841000)) -;;; Generated autoloads from gnus/starttls.el +;;;### (autoloads nil "starttls" "net/starttls.el" (0 0 0 0)) +;;; Generated autoloads from net/starttls.el (autoload 'starttls-open-stream "starttls" "\ Open a TLS connection for a port to a host. @@ -26358,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" (22387 39326 907710 -;;;;;; 94000)) +;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -26473,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" (22387 39328 273705 -;;;;;; 217000)) +;;;### (autoloads nil "studly" "play/studly.el" (0 0 0 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -26496,8 +31380,14 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads nil "subword" "progmodes/subword.el" (22387 39328 -;;;;;; 394704 784000)) +;;;### (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") @@ -26589,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" (22387 39327 -;;;;;; 939706 409000)) +;;;### (autoloads nil "supercite" "mail/supercite.el" (0 0 0 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26622,10 +31513,18 @@ 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" (22387 39326 911710 -;;;;;; 79000)) +;;;### (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") @@ -26656,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" (22387 39326 911710 79000)) +;;;### (autoloads nil "tabify" "tabify.el" (0 0 0 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26685,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" (22387 39328 569704 -;;;;;; 160000)) +;;;### (autoloads nil "table" "textmodes/table.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/table.el (autoload 'table-insert "table" "\ @@ -27257,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" (22387 39326 912710 76000)) +;;;### (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" "\ @@ -27272,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" (22387 39326 912710 -;;;;;; 76000)) +;;;### (autoloads nil "tar-mode" "tar-mode.el" (0 0 0 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27296,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" (22387 39328 395704 -;;;;;; 781000)) +;;;### (autoloads nil "tcl" "progmodes/tcl.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27345,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 "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 "telnet" "net/telnet.el" (22387 39327 997706 -;;;;;; 202000)) +;;;### (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" "\ @@ -27371,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" (22578 62356 748211 987000)) +;;;### (autoloads nil "term" "term.el" (0 0 0 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -27413,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" (22387 -;;;;;; 39327 336708 562000)) +;;;### (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" (22387 39328 273705 -;;;;;; 217000)) +;;;### (autoloads nil "tetris" "play/tetris.el" (0 0 0 0)) ;;; Generated autoloads from play/tetris.el (push (purecopy '(tetris 2 1)) package--builtin-versions) @@ -27450,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" (22587 59854 -;;;;;; 962142 834000)) +;;;### (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 "\ @@ -27752,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" (22387 39328 -;;;;;; 575704 138000)) +;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27792,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" (22387 39328 -;;;;;; 577704 131000)) +;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27877,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" (22387 -;;;;;; 39327 664707 391000)) +;;;### (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" "\ @@ -27905,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" (22387 39326 915710 -;;;;;; 65000)) +;;;### (autoloads nil "thingatpt" "thingatpt.el" (0 0 0 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27970,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" (22387 39326 916710 61000)) +;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -28004,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" (22387 39327 -;;;;;; 336708 562000)) +;;;### (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" (22387 -;;;;;; 39327 667707 380000)) +;;;### (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" "\ @@ -28085,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" (22387 39328 -;;;;;; 579704 124000)) +;;;### (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) @@ -28152,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" (22387 39326 918710 54000)) +;;;### (autoloads nil "time" "time.el" (0 0 0 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -28215,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" (22387 -;;;;;; 39327 124709 319000)) +;;;### (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" "\ @@ -28226,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. @@ -28248,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. @@ -28319,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" (22387 39326 917710 -;;;;;; 58000)) +;;;### (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) @@ -28360,10 +33337,12 @@ 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" (22387 -;;;;;; 39327 125709 315000)) +;;;### (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) @@ -28471,10 +33450,33 @@ 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" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from emacs-lisp/timer-list.el + +(autoload 'timer-list "timer-list" "\ +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" -;;;;;; (22387 39327 617707 559000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -28494,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" (22387 39326 919710 51000)) +;;;### (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) @@ -28536,10 +33547,12 @@ 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" (22421 -;;;;;; 47996 796280 817000)) +;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-show "todo-mode" "\ @@ -28602,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" (22387 39326 919710 -;;;;;; 51000)) +;;;### (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" "\ @@ -28673,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" (22387 39327 337708 -;;;;;; 558000)) +;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28687,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" (22387 39327 -;;;;;; 338708 555000)) +;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28733,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" (22578 62356 732212 -;;;;;; 73000)) +;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28745,54 +33769,40 @@ If it is set to nil, all remote file names are used literally.") (custom-autoload 'tramp-mode "tramp" t) -(defvar tramp-syntax (if (featurep 'xemacs) 'sep 'ftp) "\ +(defvar tramp-syntax 'ftp "\ Tramp filename syntax to be used. It can have the following values: - `ftp' -- Ange-FTP respective EFS like syntax (GNU Emacs default) - `sep' -- Syntax as defined for XEmacs.") + `ftp' -- Ange-FTP like syntax + `sep' -- Syntax as defined for XEmacs originally.") (custom-autoload 'tramp-syntax "tramp" t) (defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):" "\\`/[^/|:][^/|]*:") "\ Value for `tramp-file-name-regexp' for unified remoting. -Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and -Tramp. See `tramp-file-name-structure' for more explanations. +See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "\ Value for `tramp-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. 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. -GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate "\\`/\\([[][^]]*\\)?\\'" "\ Value for `tramp-completion-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") (defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\ @@ -28806,23 +33816,15 @@ 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 ((directory-sep-char 47) (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 "/")) (load "tramp" nil t)) (apply operation args)) +Load Tramp file name handler, and perform OPERATION." (let ((default-directory temporary-file-directory)) (load "tramp" nil t)) (apply operation args)) (defun tramp-register-autoload-file-name-handlers nil "\ Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list (quote file-name-handler-alist) (cons tramp-file-name-regexp (quote tramp-autoload-file-name-handler))) (put (quote tramp-autoload-file-name-handler) (quote safe-magic) t) (add-to-list (quote file-name-handler-alist) (cons tramp-completion-file-name-regexp (quote tramp-completion-file-name-handler))) (put (quote tramp-completion-file-name-handler) (quote safe-magic) t)) @@ -28830,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-ftp" "net/tramp-ftp.el" (22387 39328 -;;;;;; 1706 188000)) +;;;### (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" (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 "trampver" "net/trampver.el" (22578 62356 732212 -;;;;;; 73000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 2 13 25 2)) 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" (22387 39326 921710 -;;;;;; 44000)) +;;;### (autoloads nil "tutorial" "tutorial.el" (0 0 0 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28892,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" (22387 39327 -;;;;;; 668707 377000)) +;;;### (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" "\ @@ -28903,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" (22387 -;;;;;; 39328 579704 124000)) +;;;### (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) @@ -28951,10 +34028,11 @@ 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" (22387 39326 921710 -;;;;;; 44000)) +;;;### (autoloads nil "type-break" "type-break.el" (0 0 0 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29085,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" (22387 39327 939706 409000)) +;;;### (autoloads nil "uce" "mail/uce.el" (0 0 0 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -29098,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" -;;;;;; (22578 62356 724212 116000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -29164,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" (22387 -;;;;;; 39328 580704 121000)) +;;;### (autoloads nil "underline" "textmodes/underline.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -29187,8 +34271,15 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "unrmail" "mail/unrmail.el" (22387 39327 940706 -;;;;;; 406000)) +;;;### (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" "\ @@ -29206,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" (22387 39327 -;;;;;; 338708 555000)) +;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29219,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" (22387 39328 621703 974000)) +;;;### (autoloads nil "url" "url/url.el" (0 0 0 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -29263,16 +34357,26 @@ 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. -If SILENT is non-nil, don't display progress reports and similar messages. -If INHIBIT-COOKIES is non-nil, cookies will neither be stored nor sent -to the server. -\(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" (22387 39328 608704 -;;;;;; 20000)) +;;;### (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" "\ @@ -29311,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" (22387 39328 -;;;;;; 608704 20000)) +;;;### (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" "\ @@ -29333,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" (22387 39328 608704 -;;;;;; 20000)) +;;;### (autoloads nil "url-cid" "url/url-cid.el" (0 0 0 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -29344,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" (22387 39328 609704 -;;;;;; 17000)) +;;;### (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" "\ @@ -29379,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-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" (22387 39328 611704 -;;;;;; 10000)) +;;;### (autoloads nil "url-file" "url/url-file.el" (0 0 0 0)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -29390,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" (22387 39328 612704 -;;;;;; 6000)) +;;;### (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" "\ @@ -29412,10 +34563,12 @@ 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" (22387 -;;;;;; 39328 612704 6000)) +;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -29475,10 +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" (22578 62356 750211 -;;;;;; 976000)) +;;;### (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") @@ -29488,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-irc" "url/url-irc.el" (22387 39328 615703 -;;;;;; 996000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -29499,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" (22387 39328 615703 -;;;;;; 996000)) +;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (0 0 0 0)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -29513,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" (22387 39328 -;;;;;; 615703 996000)) +;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (0 0 0 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -29529,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-misc" "url/url-misc.el" (22387 39328 616703 -;;;;;; 992000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -29561,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" (22387 39328 617703 -;;;;;; 988000)) +;;;### (autoloads nil "url-news" "url/url-news.el" (0 0 0 0)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29577,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-ns" "url/url-ns.el" (22387 39328 617703 -;;;;;; 988000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -29618,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" (22387 39328 -;;;;;; 618703 985000)) +;;;### (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" "\ @@ -29670,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" (22387 39328 -;;;;;; 618703 985000)) +;;;### (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" "\ @@ -29681,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-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" (22387 39328 -;;;;;; 619703 981000)) +;;;### (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" "\ @@ -29696,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" (22387 39328 -;;;;;; 619703 981000)) +;;;### (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") "\ @@ -29715,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" (22387 39328 620703 -;;;;;; 978000)) +;;;### (autoloads nil "url-util" "url/url-util.el" (0 0 0 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29884,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 "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" (22387 39326 923710 -;;;;;; 37000)) +;;;### (autoloads nil "userlock" "userlock.el" (0 0 0 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29902,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 @@ -29913,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" (22387 39327 -;;;;;; 646707 455000)) +;;;### (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" "\ @@ -29939,20 +35153,23 @@ 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" "gnus/utf7.el" (22387 39327 539707 837000)) -;;; Generated autoloads from gnus/utf7.el +;;;### (autoloads nil "utf7" "international/utf7.el" (0 0 0 0)) +;;; Generated autoloads from international/utf7.el (autoload 'utf7-encode "utf7" "\ 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" (22387 39327 -;;;;;; 941706 402000)) +;;;### (autoloads nil "uudecode" "mail/uudecode.el" (0 0 0 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29974,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" (22578 62356 751211 971000)) +;;;### (autoloads nil "vc" "vc/vc.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30294,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" (22387 39328 -;;;;;; 669703 803000)) +;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -30334,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" (22387 39328 670703 -;;;;;; 799000)) +;;;### (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" "\ @@ -30351,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" (22578 62356 751211 -;;;;;; 971000)) +;;;### (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." @@ -30363,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-dir" "vc/vc-dir.el" (22387 39328 672703 -;;;;;; 792000)) +;;;### (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" (0 0 0 0)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -30388,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" (22387 -;;;;;; 39328 673703 789000)) +;;;### (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" "\ @@ -30412,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-git" "vc/vc-git.el" (22421 48002 959231 -;;;;;; 24000)) +;;;### (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" (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." @@ -30424,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" (22387 39328 675703 781000)) +;;;### (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." @@ -30435,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" (22387 39328 676703 -;;;;;; 778000)) +;;;### (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" "\ @@ -30452,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" (22387 39328 677703 -;;;;;; 774000)) +;;;### (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")) "\ @@ -30466,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" (22387 39328 678703 -;;;;;; 771000)) +;;;### (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)) "\ @@ -30485,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" (22387 39328 678703 -;;;;;; 771000)) +;;;### (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")) "\ @@ -30499,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" (22387 39328 679703 -;;;;;; 767000)) +;;;### (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) @@ -30513,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 "vera-mode" "progmodes/vera-mode.el" (22387 -;;;;;; 39328 396704 777000)) +;;;### (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" (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)) @@ -30572,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" -;;;;;; (22387 39328 402704 756000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30712,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" (22387 -;;;;;; 39328 414704 713000)) +;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -31267,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" (22387 -;;;;;; 39327 668707 377000)) +;;;### (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" "\ @@ -31312,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" (22387 39326 924710 33000)) +;;;### (autoloads nil "view" "view.el" (0 0 0 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31568,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" (22387 39327 375708 -;;;;;; 423000)) +;;;### (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) @@ -31586,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 "warnings" "emacs-lisp/warnings.el" (22387 -;;;;;; 39327 339708 551000)) +;;;### (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" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31677,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" (22387 39326 926710 26000)) +;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0)) ;;; Generated autoloads from wdired.el (push (purecopy '(wdired 2 0)) package--builtin-versions) @@ -31695,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" (22387 39328 12706 -;;;;;; 148000)) +;;;### (autoloads nil "webjump" "net/webjump.el" (0 0 0 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31712,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" (22387 -;;;;;; 39328 419704 695000)) +;;;### (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) @@ -31744,10 +37099,11 @@ 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" (22578 62356 752211 -;;;;;; 965000)) +;;;### (autoloads nil "whitespace" "whitespace.el" (0 0 0 0)) ;;; Generated autoloads from whitespace.el (push (purecopy '(whitespace 13 2 2)) package--builtin-versions) @@ -31993,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. @@ -32016,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. @@ -32035,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. @@ -32058,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. @@ -32087,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 @@ -32105,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. @@ -32115,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 @@ -32123,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" (22387 39326 928710 -;;;;;; 19000)) +;;;### (autoloads nil "wid-browse" "wid-browse.el" (0 0 0 0)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -32152,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" (22387 39326 929710 -;;;;;; 15000)) +;;;### (autoloads nil "wid-edit" "wid-edit.el" (0 0 0 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32195,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" (22387 39326 931710 -;;;;;; 8000)) +;;;### (autoloads nil "windmove" "windmove.el" (0 0 0 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -32248,9 +37602,11 @@ Default MODIFIER is `shift'. \(fn &optional MODIFIER)" t nil) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "windmove" '("windmove-"))) + ;;;*** -;;;### (autoloads nil "winner" "winner.el" (22387 39326 936709 990000)) +;;;### (autoloads nil "winner" "winner.el" (0 0 0 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -32278,9 +37634,11 @@ 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" (22387 39326 937709 987000)) +;;;### (autoloads nil "woman" "woman.el" (0 0 0 0)) ;;; Generated autoloads from woman.el (push (purecopy '(woman 0 551)) package--builtin-versions) @@ -32327,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" (22387 39326 939709 979000)) +;;;### (autoloads nil "xml" "xml.el" (0 0 0 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -32383,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" (22387 39328 67705 -;;;;;; 952000)) +;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (0 0 0 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32402,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" (22387 39328 420704 -;;;;;; 692000)) +;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/xref.el (autoload 'xref-find-backend "xref" "\ @@ -32470,10 +37839,25 @@ 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" (22581 47658 786375 -;;;;;; 832000)) +;;;### (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 "\ @@ -32501,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" (22387 39326 940709 -;;;;;; 976000)) +;;;### (autoloads nil "xwidget" "xwidget.el" (0 0 0 0)) ;;; Generated autoloads from xwidget.el (autoload 'xwidget-webkit-browse-url "xwidget" "\ @@ -32514,10 +37899,12 @@ 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" "gnus/yenc.el" (22387 39327 539707 837000)) -;;; Generated autoloads from gnus/yenc.el +;;;### (autoloads nil "yenc" "mail/yenc.el" (0 0 0 0)) +;;; Generated autoloads from mail/yenc.el (autoload 'yenc-decode-region "yenc" "\ Yenc decode region between START and END using an internal decoder. @@ -32529,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" (22387 39328 274705 213000)) +;;;### (autoloads nil "zone" "play/zone.el" (0 0 0 0)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -32539,129 +37935,68 @@ 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-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" "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" +;;;### (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/dired.el" "cedet/ede/emacs.el" ;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.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/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-by.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-by.el" -;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.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/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/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/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/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/javat-wy.el" "cedet/semantic/wisent/js-wy.el" -;;;;;; "cedet/semantic/wisent/python-wy.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/map.el" "cedet/srecode/mode.el" "cedet/srecode/semantic.el" -;;;;;; "cedet/srecode/srt-wy.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-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-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" -;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-datadebug.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" +;;;;;; "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-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-arg.el" "eshell/esh-cmd.el" "eshell/esh-ext.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/compface.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-ems.el" "gnus/gnus-icalendar.el" "gnus/gnus-int.el" -;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.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/ietf-drums.el" "gnus/legacy-gnus-agent.el" -;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" -;;;;;; "gnus/mailcap.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/registry.el" "gnus/rfc1843.el" "gnus/rfc2045.el" -;;;;;; "gnus/rfc2047.el" "gnus/rfc2231.el" "gnus/rtree.el" "gnus/sieve-manage.el" -;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el" -;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/charprop.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/uni-bidi.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" @@ -32669,97 +38004,51 @@ Zone out, completely. ;;;;;; "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/ja-dic/ja-dic.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/mailheader.el" "mail/mspools.el" "mail/rfc2368.el" -;;;;;; "mail/rfc822.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/mairix.el" "net/newsticker.el" "net/nsm.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/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" "obarray.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-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" "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-samp.el" -;;;;;; "sb-image.el" "scroll-bar.el" "soundex.el" "subdirs.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" "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" -;;;;;; "textmodes/reftex-index.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") (22588 27933 487024 747000)) +;;;;;; "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" "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/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/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/linum.el b/lisp/linum.el index d49ccb356ff..122f8e31d57 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -120,7 +120,15 @@ Linum mode is a buffer-local minor mode." (mapc #'delete-overlay linum-overlays) (setq linum-overlays nil) (dolist (w (get-buffer-window-list (current-buffer) nil t)) - (set-window-margins w 0 (cdr (window-margins w))))) + ;; restore margins if needed FIXME: This still fails if the + ;; "other" mode has incidentally set margins to exactly what linum + ;; had: see bug#20674 for a similar workaround in nlinum.el + (let ((set-margins (window-parameter w 'linum--set-margins)) + (current-margins (window-margins w))) + (when (and set-margins + (equal set-margins current-margins)) + (set-window-margins w 0 (cdr current-margins)) + (set-window-parameter w 'linum--set-margins nil))))) (defun linum-update-current () "Update line numbers for the current buffer." @@ -143,10 +151,10 @@ Linum mode is a buffer-local minor mode." (defun linum--face-width (face) (let ((info (font-info (face-font face))) - width) + width) (setq width (aref info 11)) (if (<= width 0) - (setq width (aref info 10))) + (setq width (aref info 10))) width)) (defun linum-update-window (win) @@ -170,7 +178,7 @@ Linum mode is a buffer-local minor mode." (visited (catch 'visited (dolist (o (overlays-in (point) (point))) (when (equal-including-properties - (overlay-get o 'linum-str) str) + (overlay-get o 'linum-str) str) (unless (memq o linum-overlays) (push o linum-overlays)) (setq linum-available (delq o linum-available)) @@ -193,7 +201,12 @@ Linum mode is a buffer-local minor mode." (setq width (ceiling (/ (* width 1.0 (linum--face-width 'linum)) (frame-char-width))))) - (set-window-margins win width (cdr (window-margins win))))) + ;; open up space in the left margin, if needed, and record that + ;; fact as the window-parameter `linum--set-margins' + (let ((existing-margins (window-margins win))) + (when (> width (or (car existing-margins) 0)) + (set-window-margins win width (cdr existing-margins)) + (set-window-parameter win 'linum--set-margins (window-margins win)))))) (defun linum-after-change (beg end _len) ;; update overlays on deletions, and after newlines are inserted diff --git a/lisp/loadup.el b/lisp/loadup.el index 21c64a8c3b4..53500240319 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -67,6 +67,10 @@ (let ((dir (car load-path))) ;; We'll probably overflow the pure space. (setq purify-flag nil) + ;; Value of max-lisp-eval-depth when compiling initially. + ;; During bootstrapping the byte-compiler is run interpreted when + ;; compiling itself, which uses a lot more stack than usual. + (setq max-lisp-eval-depth 2200) (setq load-path (list (expand-file-name "." dir) (expand-file-name "emacs-lisp" dir) (expand-file-name "language" dir) @@ -74,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))) @@ -143,23 +143,32 @@ (load "button") ;; We don't want to store loaddefs.el in the repository because it is -;; a generated file; but it is required in order to compile the lisp files. -;; When bootstrapping, we cannot generate loaddefs.el until an -;; emacs binary has been built. We therefore compromise and keep -;; ldefs-boot.el in the repository. This does not need to be updated -;; as often as the real loaddefs.el would. Bootstrap should always -;; work with ldefs-boot.el. Therefore, Whenever a new autoload cookie -;; gets added that is necessary during bootstrapping, ldefs-boot.el -;; should be updated by overwriting it with an up-to-date copy of -;; loaddefs.el that is uncorrupted by local changes. -;; autogen/update_autogen can be used to periodically update ldefs-boot. +;; a generated file; but it is required in order to compile the lisp +;; files. When bootstrapping, we cannot generate loaddefs.el until an +;; emacs binary has been built. We therefore support the build with +;; two files, ldefs-boot-manual.el and ldefs-boot-auto.el, which +;; contain the autoloads that are actually called during bootstrap. +;; These do not need to be updated as often as the real loaddefs.el +;; would. Bootstrap should always work with ldefs-boot-manual.el. +;; Therefore, Whenever a new autoload cookie gets added that is +;; necessary during bootstrapping, ldefs-boot-auto.el should be +;; updated using the "generate-ldefs-boot" make target. +;; autogen/update_autogen can be used to periodically update +;; ldefs-boot. (condition-case nil (load "loaddefs.el") ;; In case loaddefs hasn't been generated yet. - (file-error (load "ldefs-boot.el"))) + (file-error (load "ldefs-boot-manual.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. +(load "obarray") ;abbrev.el is implemented in terms of obarrays. (load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table. (load "simple") @@ -292,6 +301,7 @@ ;; already produced, because it needs uni-*.el files that might ;; not be built early enough during bootstrap. (when (load-history-filename-element "charprop\\.el") + (load "international/mule-util") (load "international/ucs-normalize") (load "term/ns-win")))) (if (fboundp 'x-create-frame) @@ -420,6 +430,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) diff --git a/lisp/lpr.el b/lisp/lpr.el index 04e3b38ab17..d09f7791a93 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -36,13 +36,13 @@ ;;;###autoload (defvar lpr-lp-system - (memq system-type '(usg-unix-v hpux irix)) + (memq system-type '(usg-unix-v hpux)) "Non-nil if running on a system type that uses the \"lp\" command.") (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 41587bfe144..8395622546d 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -72,7 +72,7 @@ (defcustom ls-lisp-emulation (cond ;; ((eq system-type 'windows-nt) 'MS-Windows) - ((memq system-type '(hpux usg-unix-v irix berkeley-unix)) + ((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. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 86aefe4a6dd..650fbfa13d2 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -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/gnus/flow-fill.el b/lisp/mail/flow-fill.el index 904f031d0e4..d2881422475 100644 --- a/lisp/gnus/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -157,7 +157,6 @@ RFC 2646 suggests 66 characters for readability." (condition-case nil (let ((fill-prefix (when quote (concat quote " "))) (fill-column (eval fill-flowed-display-column)) - filladapt-mode adaptive-fill-mode) (fill-region (point-at-bol) (min (1+ (point-at-eol)) diff --git a/lisp/gnus/ietf-drums.el b/lisp/mail/ietf-drums.el index 8008e327592..03349d12055 100644 --- a/lisp/gnus/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -38,7 +38,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'mm-util) (defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" "US-ASCII control characters excluding CR, LF and white space.") @@ -74,11 +73,6 @@ backslash and doublequote.") (modify-syntax-entry ?* "_" table) (modify-syntax-entry ?\; "_" table) (modify-syntax-entry ?\' "_" table) - (if (featurep 'xemacs) - (let ((i 128)) - (while (< i 256) - (modify-syntax-entry i "w" table) - (setq i (1+ i))))) table)) (defun ietf-drums-token-to-list (token) @@ -86,10 +80,10 @@ backslash and doublequote.") (let ((i 0) b e c out range) (while (< i (length token)) - (setq c (mm-char-int (aref token i))) + (setq c (aref token i)) (incf i) (cond - ((eq c (mm-char-int ?-)) + ((eq c ?-) (if b (setq range t) (push c out))) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 44a082c330d..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 @@ -1406,25 +1406,26 @@ consing a string.)" (insert (upcase mi) ". "))) ;; Nuke name if it is the same as mailbox name. - (let ((buffer-length (- (point-max) (point-min))) - (i 0) - (names-match-flag t)) - (when (and (> buffer-length 0) - (eq buffer-length (- mbox-end mbox-beg))) - (goto-char (point-max)) - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (while (and names-match-flag - (< i buffer-length)) - (or (eq (downcase (char-after (+ i (point-min)))) - (downcase - (char-after (+ i buffer-length (point-min))))) - (setq names-match-flag nil)) - (setq i (1+ i))) - (delete-region (+ (point-min) buffer-length) (point-max)) - (and names-match-flag - mail-extr-ignore-realname-equals-mailbox-name - (narrow-to-region (point) (point))))) + (when mail-extr-ignore-single-names + (let ((buffer-length (- (point-max) (point-min))) + (i 0) + (names-match-flag t)) + (when (and (> buffer-length 0) + (eq buffer-length (- mbox-end mbox-beg))) + (goto-char (point-max)) + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (while (and names-match-flag + (< i buffer-length)) + (or (eq (downcase (char-after (+ i (point-min)))) + (downcase + (char-after (+ i buffer-length (point-min))))) + (setq names-match-flag nil)) + (setq i (1+ i))) + (delete-region (+ (point-min) buffer-length) (point-max)) + (and names-match-flag + mail-extr-ignore-realname-equals-mailbox-name + (narrow-to-region (point) (point)))))) ;; Nuke name if it's just one word. (goto-char (point-min)) diff --git a/lisp/gnus/mail-parse.el b/lisp/mail/mail-parse.el index 4fc7e463595..4fc7e463595 100644 --- a/lisp/gnus/mail-parse.el +++ b/lisp/mail/mail-parse.el diff --git a/lisp/gnus/mail-prsvr.el b/lisp/mail/mail-prsvr.el index 789c0028f64..789c0028f64 100644 --- a/lisp/gnus/mail-prsvr.el +++ b/lisp/mail/mail-prsvr.el diff --git a/lisp/gnus/qp.el b/lisp/mail/qp.el index d179cbb2cbd..a295e0c2d8e 100644 --- a/lisp/gnus/qp.el +++ b/lisp/mail/qp.el @@ -27,9 +27,6 @@ ;;; Code: -(require 'mm-util) -(defvar mm-use-ultra-safe-encoding) - ;;;###autoload (defun quoted-printable-decode-region (from to &optional coding-system) "Decode quoted-printable in the region between FROM and TO, per RFC 2045. @@ -45,7 +42,8 @@ them into characters should be done separately." (interactive ;; Let the user determine the coding system with "C-x RET c". (list (region-beginning) (region-end) coding-system-for-read)) - (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus + (when (and coding-system + (not (coding-system-p coding-system))) ; e.g. `ascii' from Gnus (setq coding-system nil)) (save-excursion (save-restriction @@ -59,7 +57,7 @@ them into characters should be done separately." ;; which already contains non-ASCII characters which would ;; then get doubly-decoded below. (if coding-system - (mm-encode-coding-region (point-min) (point-max) coding-system)) + (encode-coding-region (point-min) (point-max) coding-system)) (goto-char (point-min)) (while (and (skip-chars-forward "^=") (not (eobp))) @@ -87,14 +85,15 @@ them into characters should be done separately." (message "Malformed quoted-printable text") (forward-char))))) (if coding-system - (mm-decode-coding-region (point-min) (point-max) coding-system))))) + (decode-coding-region (point-min) (point-max) coding-system))))) (defun quoted-printable-decode-string (string &optional coding-system) "Decode the quoted-printable encoded STRING and return the result. If CODING-SYSTEM is non-nil, decode the string with coding-system. Use of CODING-SYSTEM is deprecated; this function should deal with raw bytes, and coding conversion should be done separately." - (mm-with-unibyte-buffer + (with-temp-buffer + (set-buffer-multibyte nil) (insert string) (quoted-printable-decode-region (point-min) (point-max) coding-system) (buffer-string))) @@ -116,7 +115,7 @@ encode lines starting with \"From\"." (setq class "\010-\012\014\040-\074\076-\177")) (save-excursion (goto-char from) - (if (re-search-forward (mm-string-to-multibyte "[^\x0-\x7f\x80-\xff]") + (if (re-search-forward (string-to-multibyte "[^\x0-\x7f\x80-\xff]") to t) (error "Multibyte character in QP encoding region")) (save-restriction @@ -127,8 +126,7 @@ encode lines starting with \"From\"." (not (eobp))) (insert (prog1 - ;; To unibyte in case of Emacs 23 (unicode) eight-bit. - (format "=%02X" (mm-multibyte-char-to-unibyte (char-after))) + (format "=%02X" (char-after)) (delete-char 1)))) ;; Encode white space at the end of lines. (goto-char (point-min)) @@ -139,17 +137,17 @@ encode lines starting with \"From\"." (prog1 (format "=%02X" (char-after)) (delete-char 1))))) - (let ((mm-use-ultra-safe-encoding + (let ((ultra (and (boundp 'mm-use-ultra-safe-encoding) mm-use-ultra-safe-encoding))) - (when (or fold mm-use-ultra-safe-encoding) + (when (or fold ultra) (let ((tab-width 1) ; HTAB is one character. (case-fold-search nil)) (goto-char (point-min)) (while (not (eobp)) ;; In ultra-safe mode, encode "From " at the beginning ;; of a line. - (when mm-use-ultra-safe-encoding + (when ultra (if (looking-at "From ") (replace-match "From=20" nil t) (if (looking-at "-") @@ -167,9 +165,9 @@ encode lines starting with \"From\"." (defun quoted-printable-encode-string (string) "Encode the STRING as quoted-printable and return the result." (with-temp-buffer - (if (mm-multibyte-string-p string) - (mm-enable-multibyte) - (mm-disable-multibyte)) + (if (multibyte-string-p string) + (set-buffer-multibyte 'to) + (set-buffer-multibyte nil)) (insert string) (quoted-printable-encode-region (point-min) (point-max)) (buffer-string))) diff --git a/lisp/gnus/rfc2045.el b/lisp/mail/rfc2045.el index c2ddf906d06..c2ddf906d06 100644 --- a/lisp/gnus/rfc2045.el +++ b/lisp/mail/rfc2045.el diff --git a/lisp/gnus/rfc2047.el b/lisp/mail/rfc2047.el index 6647d10b0b2..e636d619c03 100644 --- a/lisp/gnus/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 @@ -267,7 +278,7 @@ Should be called narrowed to the head of the message." (mm-coding-system-p (car message-posting-charset))) ;; 8 bit must be decoded. - (mm-encode-coding-region + (encode-coding-region (point-min) (point-max) (mm-charset-to-coding-system (car message-posting-charset)))) @@ -290,12 +301,10 @@ Should be called narrowed to the head of the message." (let ((rfc2047-encoding-type 'mime)) (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) - (if (and (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (default-value 'enable-multibyte-characters)) + (if (and (default-value 'enable-multibyte-characters) mail-parse-charset) - (mm-encode-coding-region (point) (point-max) - mail-parse-charset))) + (encode-coding-region (point) (point-max) + mail-parse-charset))) ;; We get this when CC'ing messages to newsgroups with ;; 8-bit names. The group name mail copy just got ;; unconditionally encoded. Previously, it would ask @@ -317,11 +326,8 @@ Should be called narrowed to the head of the message." ;;; (rfc2047-encode-region (point-min) (point-max)) ;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) - (if (or (and (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (default-value 'enable-multibyte-characters))) - (featurep 'file-coding)) - (mm-encode-coding-region (point) (point-max) method))) + (when (default-value 'enable-multibyte-characters) + (encode-coding-region (point) (point-max) method))) ;; Hm. (t))) (goto-char (point-max)))))))) @@ -356,9 +362,7 @@ The buffer may be narrowed." ;; it appears to be the cleanest way. ;; Play safe and don't assume the form of the word syntax entry -- ;; copy it from ?a. - (if (featurep 'xemacs) - (put-char-table t (get-char-table ?a (standard-syntax-table)) table) - (set-char-table-range table t (aref (standard-syntax-table) ?a))) + (set-char-table-range table t (aref (standard-syntax-table) ?a)) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\( "(" table) @@ -556,7 +560,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (if (or debug-on-quit debug-on-error) (signal (car err) (cdr err)) (error "Invalid data for rfc2047 encoding: %s" - (mm-replace-in-string orig-text "[ \t\n]+" " ")))))))) + (replace-regexp-in-string "[ \t\n]+" " " orig-text)))))))) (unless dont-fold (rfc2047-fold-region b (point))) (goto-char (point-max)))) @@ -592,7 +596,7 @@ should not change this value.") ((not rfc2047-encode-max-chars) (concat start (funcall encoder (if cs - (mm-encode-coding-string string cs) + (encode-coding-string string cs) string)) "?=")) ((>= column rfc2047-encode-max-chars) @@ -616,7 +620,7 @@ should not change this value.") (setq next (concat start (funcall encoder (if cs - (mm-encode-coding-string + (encode-coding-string (substring string 0 (1+ index)) cs) (substring string 0 (1+ index)))) @@ -700,9 +704,9 @@ Point moves to the end of the region." (setq crest (buffer-substring-no-properties (point) b))) (setq eword (rfc2047-encode-1 (- b (point-at-bol)) - (mm-replace-in-string - (buffer-substring-no-properties b e) - "\n\\([ \t]?\\)" "\\1") + (replace-regexp-in-string + "\n\\([ \t]?\\)" "\\1" + (buffer-substring-no-properties b e)) cs (or (cdr (assq encoding rfc2047-encode-function-alist)) @@ -871,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." @@ -947,7 +952,7 @@ ENCODED-WORD)." (rfc2047-pad-base64 (nth 2 word))))) ((char-equal ?Q (nth 1 word)) (setq text (quoted-printable-decode-string - (mm-subst-char-in-string + (subst-char-in-string ?_ ? (nth 2 word) t))))) (error (message "%s" (error-message-string code)) @@ -963,7 +968,7 @@ ENCODED-WORD)." (setq words (concat (or (and (setq cs (caar rest)) (condition-case code - (mm-decode-coding-string (cdar rest) cs) + (decode-coding-string (cdar rest) cs) (error (message "%s" (error-message-string code)) nil))) @@ -1087,13 +1092,13 @@ other than `\"' and `\\' in quoted strings." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b e mail-parse-charset)) + (decode-coding-region b e mail-parse-charset)) (setq b (point))) (when (and (mm-multibyte-p) mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b (point-max) mail-parse-charset)))))) + (decode-coding-region b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-address-region (start end) "Decode MIME-encoded words in region between START and END. @@ -1105,49 +1110,47 @@ strings are stripped." "Decode MIME-encoded STRING and return the result. If ADDRESS-MIME is non-nil, strip backslashes which precede characters other than `\"' and `\\' in quoted strings." - ;; (let ((m (mm-multibyte-p))) - (if (string-match "=\\?" string) - (with-temp-buffer - ;; We used to only call mm-enable-multibyte if `m' is non-nil, - ;; but this can't be the right criterion. Don't just revert this - ;; change if it encounters a bug. Please help me fix it - ;; right instead. --Stef - ;; The string returned should always be multibyte in a multibyte - ;; session, i.e. the buffer should be multibyte before - ;; `buffer-string' is called. - (mm-enable-multibyte) - (insert string) - (inline - (rfc2047-decode-region (point-min) (point-max) address-mime)) - (buffer-string)) - (when address-mime - (setq string - (with-temp-buffer - (when (mm-multibyte-string-p string) - (mm-enable-multibyte)) - (insert string) - (rfc2047-strip-backslashes-in-quoted-strings) - (buffer-string)))) - ;; Fixme: As above, `m' here is inappropriate. - (if (and ;; m - mail-parse-charset - (not (eq mail-parse-charset 'us-ascii)) - (not (eq mail-parse-charset 'gnus-decoded))) - ;; `decode-coding-string' in Emacs offers a third optional - ;; arg NOCOPY to avoid consing a new string if the decoding - ;; is "trivial". Unfortunately it currently doesn't - ;; consider anything else than a nil coding system - ;; trivial. - ;; `rfc2047-decode-string' is called multiple times for each - ;; article during summary buffer generation, and we really - ;; want to avoid unnecessary consing. So we bypass - ;; `decode-coding-string' if the string is purely ASCII. - (if (and (fboundp 'detect-coding-string) - ;; string is purely ASCII - (eq (detect-coding-string string t) 'undecided)) - string - (mm-decode-coding-string string mail-parse-charset)) - (mm-string-to-multibyte string)))) ;; ) + (if (string-match "=\\?" string) + (with-temp-buffer + ;; We used to only call mm-enable-multibyte if `m' is non-nil, + ;; but this can't be the right criterion. Don't just revert this + ;; change if it encounters a bug. Please help me fix it + ;; right instead. --Stef + ;; The string returned should always be multibyte in a multibyte + ;; session, i.e. the buffer should be multibyte before + ;; `buffer-string' is called. + (mm-enable-multibyte) + (insert string) + (inline + (rfc2047-decode-region (point-min) (point-max) address-mime)) + (buffer-string)) + (when address-mime + (setq string + (with-temp-buffer + (when (multibyte-string-p string) + (mm-enable-multibyte)) + (insert string) + (rfc2047-strip-backslashes-in-quoted-strings) + (buffer-string)))) + ;; Fixme: As above, `m' here is inappropriate. + (if (and ;; m + mail-parse-charset + (not (eq mail-parse-charset 'us-ascii)) + (not (eq mail-parse-charset 'gnus-decoded))) + ;; `decode-coding-string' in Emacs offers a third optional + ;; arg NOCOPY to avoid consing a new string if the decoding + ;; is "trivial". Unfortunately it currently doesn't + ;; consider anything else than a nil coding system + ;; trivial. + ;; `rfc2047-decode-string' is called multiple times for each + ;; article during summary buffer generation, and we really + ;; want to avoid unnecessary consing. So we bypass + ;; `decode-coding-string' if the string is purely ASCII. + (if (eq (detect-coding-string string t) 'undecided) + ;; string is purely ASCII + string + (decode-coding-string string mail-parse-charset)) + (string-to-multibyte string)))) (defun rfc2047-decode-address-string (string) "Decode MIME-encoded STRING and return the result. diff --git a/lisp/gnus/rfc2231.el b/lisp/mail/rfc2231.el index 34c8ecd4583..128779ab4c6 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -63,12 +63,13 @@ must never cause a Lisp error." (let (mod) (when (and (string-match "\\\\\"" string) (not (string-match "\\`\"\\|[^\\]\"" string))) - (setq string (mm-replace-in-string string "\\\\\"" "\"") + (setq string (replace-regexp-in-string "\\\\\"" "\"" string) mod t)) (when (and (string-match "\\\\(" string) (string-match "\\\\)" string) (not (string-match "\\`(\\|[^\\][()]" string))) - (setq string (mm-replace-in-string string "\\\\\\([()]\\)" "\\1") + (setq string (replace-regexp-in-string + "\\\\\\([()]\\)" "\\1" string) mod t)) (or (and mod (ignore-errors @@ -230,7 +231,7 @@ These look like: ;; Decode using the charset, if any. (if (memq coding-system '(nil ascii)) (buffer-string) - (mm-decode-coding-string (buffer-string) coding-system))))) + (decode-coding-string (buffer-string) coding-system))))) (defun rfc2231-encode-string (param value) "Return and PARAM=VALUE string encoded according to RFC2231. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 10ba5b38031..e9882253c70 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -40,6 +40,8 @@ (require 'mail-utils) (require 'rfc2047) +(require 'rmail-loaddefs) + (declare-function compilation--message->loc "compile" (cl-x) t) (declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset)) @@ -161,7 +163,7 @@ its character representation and its display representation.") (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/") + ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/")))) ;;;###autoload @@ -174,7 +176,7 @@ its character representation and its display representation.") "/var/mail/") ;; Many GNU/Linux systems use this name. ((file-exists-p "/var/spool/mail") "/var/spool/mail/") - ((memq system-type '(hpux usg-unix-v irix)) "/usr/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." @@ -239,6 +241,7 @@ please report it with \\[report-emacs-bug].") (declare-function mail-dont-reply-to "mail-utils" (destinations)) (declare-function rmail-update-summary "rmailsum" (&rest ignore)) (declare-function rmail-mime-toggle-hidden "rmailmm" ()) +(declare-function rmail-mime-entity-truncated "rmailmm" (entity)) (defun rmail-probe (prog) "Determine what flavor of movemail PROG is. @@ -1815,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)) @@ -1966,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 @@ -4588,6 +4598,7 @@ Argument MIME is non-nil if this is a mime message." ;; There doesn't really seem to be an appropriate menu. ;; Eg the edit command is not in a menu either. +(defvar rmail-mime-render-html-function) ; defcustom in rmailmm (defun rmail-epa-decrypt () "Decrypt GnuPG or OpenPGP armors in current message." (interactive) @@ -4730,227 +4741,6 @@ Argument MIME is non-nil if this is a mime message." (setq buffer-file-coding-system rmail-message-encoding)))) (add-hook 'after-save-hook 'rmail-after-save-hook) - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "rmailedit" "rmailedit.el" "03eb8c36b3c57d58eecedb9eeffa623e") -;;; Generated autoloads from rmailedit.el - -(autoload 'rmail-edit-current-message "rmailedit" "\ -Edit the contents of this message. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "rmailkwd" "rmailkwd.el" "4e1b251929961e2b9d3b126301d697d0") -;;; Generated autoloads from rmailkwd.el - -(autoload 'rmail-add-label "rmailkwd" "\ -Add LABEL to labels associated with current RMAIL message. -Completes (see `rmail-read-label') over known labels when reading. -LABEL may be a symbol or string. Only one label is allowed. - -\(fn LABEL)" t nil) - -(autoload 'rmail-kill-label "rmailkwd" "\ -Remove LABEL from labels associated with current RMAIL message. -Completes (see `rmail-read-label') over known labels when reading. -LABEL may be a symbol or string. Only one label is allowed. - -\(fn LABEL)" t nil) - -(autoload 'rmail-read-label "rmailkwd" "\ -Read a label with completion, prompting with PROMPT. -Completions are chosen from `rmail-label-obarray'. The default -is `rmail-last-label', if that is non-nil. Updates `rmail-last-label' -according to the choice made, and returns a symbol. - -\(fn PROMPT)" nil nil) - -(autoload 'rmail-previous-labeled-message "rmailkwd" "\ -Show previous message with one of the labels LABELS. -LABELS should be a comma-separated list of label names. -If LABELS is empty, the last set of labels specified is used. -With prefix argument N moves backward N messages with these labels. - -\(fn N LABELS)" t nil) - -(autoload 'rmail-next-labeled-message "rmailkwd" "\ -Show next message with one of the labels LABELS. -LABELS should be a comma-separated list of label names. -If LABELS is empty, the last set of labels specified is used. -With prefix argument N moves forward N messages with these labels. - -\(fn N LABELS)" t nil) - -;;;*** - -;;;### (autoloads nil "rmailmm" "rmailmm.el" "7ab6ab96dfdeeec6bc8f4620295b7119") -;;; Generated autoloads from rmailmm.el - -(autoload 'rmail-mime "rmailmm" "\ -Toggle the display of a MIME message. - -The actual behavior depends on the value of `rmail-enable-mime'. - -If `rmail-enable-mime' is non-nil (the default), this command toggles -the display of a MIME message between decoded presentation form and -raw data. With optional prefix argument ARG, it toggles the display only -of the MIME entity at point, if there is one. The optional argument -STATE forces a particular display state, rather than toggling. -`raw' forces raw mode, any other non-nil value forces decoded mode. - -If `rmail-enable-mime' is nil, this creates a temporary \"*RMAIL*\" -buffer holding a decoded copy of the message. Inline content-types are -handled according to `rmail-mime-media-type-handlers-alist'. -By default, this displays text and multipart messages, and offers to -download attachments as specified by `rmail-mime-attachment-dirs-alist'. -The arguments ARG and STATE have no effect in this case. - -\(fn &optional ARG STATE)" t nil) - -;;;*** - -;;;### (autoloads nil "rmailmsc" "rmailmsc.el" "471c370ff9f183806c8d749961ec9d79") -;;; Generated autoloads from rmailmsc.el - -(autoload 'set-rmail-inbox-list "rmailmsc" "\ -Set the inbox list of the current RMAIL file to FILE-NAME. -You can specify one file name, or several names separated by commas. -If FILE-NAME is empty, remove any existing inbox list. - -This applies only to the current session. - -\(fn FILE-NAME)" t nil) - -;;;*** - -;;;### (autoloads nil "rmailsort" "rmailsort.el" "2c8e39f7bae6fcc465a83ebccd46c8a4") -;;; Generated autoloads from rmailsort.el - -(autoload 'rmail-sort-by-date "rmailsort" "\ -Sort messages of current Rmail buffer by \"Date\" header. -If prefix argument REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-subject "rmailsort" "\ -Sort messages of current Rmail buffer by \"Subject\" header. -Ignores any \"Re: \" prefix. If prefix argument REVERSE is -non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-author "rmailsort" "\ -Sort messages of current Rmail buffer by author. -This uses either the \"From\" or \"Sender\" header, downcased. -If prefix argument REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-recipient "rmailsort" "\ -Sort messages of current Rmail buffer by recipient. -This uses either the \"To\" or \"Apparently-To\" header, downcased. -If prefix argument REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-correspondent "rmailsort" "\ -Sort messages of current Rmail buffer by other correspondent. -This uses either the \"From\", \"Sender\", \"To\", or -\"Apparently-To\" header, downcased. Uses the first header not -excluded by `mail-dont-reply-to-names'. If prefix argument -REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-lines "rmailsort" "\ -Sort messages of current Rmail buffer by the number of lines. -If prefix argument REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE)" t nil) - -(autoload 'rmail-sort-by-labels "rmailsort" "\ -Sort messages of current Rmail buffer by labels. -LABELS is a comma-separated list of labels. The order of these -labels specifies the order of messages: messages with the first -label come first, messages with the second label come second, and -so on. Messages that have none of these labels come last. -If prefix argument REVERSE is non-nil, sorts in reverse order. - -\(fn REVERSE LABELS)" t nil) - -;;;*** - -;;;### (autoloads nil "rmailsum" "rmailsum.el" "8205e67c8188aa5c01715e79e10667c1") -;;; Generated autoloads from rmailsum.el - -(autoload 'rmail-summary "rmailsum" "\ -Display a summary of all messages, one line per message. - -\(fn)" t nil) - -(autoload 'rmail-summary-by-labels "rmailsum" "\ -Display a summary of all messages with one or more LABELS. -LABELS should be a string containing the desired labels, separated by commas. - -\(fn LABELS)" t nil) - -(autoload 'rmail-summary-by-recipients "rmailsum" "\ -Display a summary of all messages with the given RECIPIENTS. -Normally checks the To, From and Cc fields of headers; -but if PRIMARY-ONLY is non-nil (prefix arg given), - only look in the To and From fields. -RECIPIENTS is a regular expression. - -\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil) - -(autoload 'rmail-summary-by-regexp "rmailsum" "\ -Display a summary of all messages according to regexp REGEXP. -If the regular expression is found in the header of the message -\(including in the date and other lines, as well as the subject line), -Emacs will list the message in the summary. - -\(fn REGEXP)" t nil) - -(autoload 'rmail-summary-by-topic "rmailsum" "\ -Display a summary of all messages with the given SUBJECT. -Normally checks just the Subject field of headers; but with prefix -argument WHOLE-MESSAGE is non-nil, looks in the whole message. -SUBJECT is a regular expression. - -\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil) - -(autoload 'rmail-summary-by-senders "rmailsum" "\ -Display a summary of all messages whose \"From\" field matches SENDERS. -SENDERS is a regular expression. - -\(fn SENDERS)" t nil) - -;;;*** - -;;;### (autoloads nil "undigest" "undigest.el" "20561f083496eb113fa9e501902bfcc3") -;;; Generated autoloads from undigest.el - -(autoload 'undigestify-rmail-message "undigest" "\ -Break up a digest message into its constituent messages. -Leaves original message, deleted, before the undigestified messages. - -\(fn)" t nil) - -(autoload 'unforward-rmail-message "undigest" "\ -Extract a forwarded message from the containing message. -This puts the forwarded message into a separate rmail message following -the containing message. This command is only useful when messages are -forwarded with `rmail-enable-mime-composing' set to nil. - -\(fn)" t nil) - -;;;*** - -;;; End of automatically extracted autoloads. - (provide 'rmail) diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index 5c29e7ec8bf..46e5e17a2e8 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -448,7 +448,7 @@ HEADER-DIFF should be a return value from `rmail-edit-diff-headers'." (provide 'rmailedit) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailedit.el ends here diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 0301e512129..6581ee628a7 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -192,7 +192,7 @@ With prefix argument N moves forward N messages with these labels." (provide 'rmailkwd) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailkwd.el ends here diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 75219747684..9343b118067 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1560,7 +1560,7 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." (provide 'rmailmm) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailmm.el ends here diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index 0a76576dfc2..1185dccf225 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -55,7 +55,7 @@ This applies only to the current session." (rmail-show-message-1 rmail-current-message)) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailmsc.el ends here diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 1eb60c2d547..60320b929e4 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -251,7 +251,7 @@ Numeric keys are sorted numerically, all others as strings." (provide 'rmailsort) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailsort.el ends here diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 52b717fb9d5..0a2ca0b8038 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1871,7 +1871,7 @@ the summary is only showing a subset of messages." (provide 'rmailsum) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; rmailsum.el ends here 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/mail/undigest.el b/lisp/mail/undigest.el index 1d0a3718a96..54ee99bafb2 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -327,7 +327,7 @@ forwarded with `rmail-enable-mime-composing' set to nil." (provide 'undigest) ;; Local Variables: -;; generated-autoload-file: "rmail.el" +;; generated-autoload-file: "rmail-loaddefs.el" ;; End: ;;; undigest.el ends here diff --git a/lisp/gnus/yenc.el b/lisp/mail/yenc.el index cfac06d4f19..a4ebd0db15b 100644 --- a/lisp/gnus/yenc.el +++ b/lisp/mail/yenc.el @@ -90,8 +90,8 @@ (setq last (match-beginning 0)) (setq footer-alist (yenc-parse-line (match-string 0))) (setq work-buffer (generate-new-buffer " *yenc-work*")) - (unless (featurep 'xemacs) - (with-current-buffer work-buffer (set-buffer-multibyte nil))) + (with-current-buffer work-buffer + (set-buffer-multibyte nil)) (while (< first last) (setq char (char-after first)) (cond ((or (eq char ?\r) diff --git a/lisp/man.el b/lisp/man.el index 94b9e0d04da..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.") @@ -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))) @@ -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 bc182834bdf..af031bd99c0 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -981,49 +981,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 () @@ -1579,7 +1573,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))) 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-comp.el b/lisp/mh-e/mh-comp.el index 4e64cfb12d3..72980b7ead8 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -916,14 +916,14 @@ CONFIG is the window configuration before sending mail." ;; use it as the drafts folder. Then copy the skeleton to a regular ;; temp file, and return the regular temp file. (let (new - (temp-folder (mm-make-temp-file + (temp-folder (make-temp-file (concat mh-user-path "draftfolder.") t))) (mh-exec-cmd "comp" "-nowhatnowproc" "-draftfolder" (format "+%s" (file-name-nondirectory temp-folder)) (if (stringp mh-comp-formfile) (list "-form" mh-comp-formfile))) - (setq new (mm-make-temp-file "comp.")) + (setq new (make-temp-file "comp.")) (rename-file (concat temp-folder "/" "1") new t) (delete-file (concat temp-folder "/" ".mh_sequences")) (delete-directory temp-folder) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index c900248c9b6..dfaf317fb64 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -5,7 +5,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 8.6 +;; Version: 8.6+git ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -127,7 +127,7 @@ ;; Try to keep variables local to a single file. Provide accessors if ;; variables are shared. Use this section as a last resort. -(defconst mh-version "8.6" "Version number of MH-E.") +(defconst mh-version "8.6+git" "Version number of MH-E.") ;; Variants @@ -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,9 +2328,9 @@ 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 +This option controls the fetching of the \"X-Image-URL:\" header field image with the following values: Ask Before Fetching @@ -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-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/midnight.el b/lisp/midnight.el index 878c5a7f71f..814621fc4e3 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -60,13 +60,6 @@ the time when it is run.") (when (timerp midnight-timer) (cancel-timer midnight-timer)) (if midnight-mode (timer-activate 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)))) - ;;; clean-buffer-list stuff (defcustom clean-buffer-list-delay-general 3 @@ -167,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 56454d5a634..576b8041be9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1972,7 +1972,7 @@ if there was no valid completion, else t." Its arguments and return value are as specified for `completion-in-region'. Also respects the obsolete wrapper hook `completion-in-region-functions'. \(See `with-wrapper-hook' for details about wrapper hooks.)" - (with-wrapper-hook + (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) @@ -2251,6 +2251,17 @@ This is only used when the minibuffer area has no active minibuffer.") (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar)) str)) +(defun minibuffer-maybe-quote-filename (filename) + "Protect FILENAME from `substitute-in-file-name', as needed. +Useful to give the user default values that won't be substituted." + (if (and (not (file-name-quoted-p filename)) + (file-name-absolute-p filename) + (string-match-p (if (memq system-type '(windows-nt ms-dos)) + "[/\\\\]~" "/~") + (file-local-name filename))) + (file-name-quote filename) + (minibuffer--double-dollars filename))) + (defun completion--make-envvar-table () (mapcar (lambda (enventry) (substring enventry 0 (string-match-p "=" enventry))) @@ -2420,7 +2431,7 @@ same as `substitute-in-file-name'." (substitute-in-file-name (substring qstr 0 (1- qpos))))) (setq qpos (1- qpos))) - (cons qpos #'minibuffer--double-dollars)))) + (cons qpos #'minibuffer-maybe-quote-filename)))) (defalias 'completion--file-name-table (completion-table-with-quoting #'completion-file-name-table @@ -2596,10 +2607,10 @@ See `read-file-name' for the meaning of the arguments." (let ((insdef (cond ((and insert-default-directory (stringp dir)) (if initial - (cons (minibuffer--double-dollars (concat dir initial)) - (length (minibuffer--double-dollars dir))) - (minibuffer--double-dollars dir))) - (initial (cons (minibuffer--double-dollars initial) 0))))) + (cons (minibuffer-maybe-quote-filename (concat dir initial)) + (length (minibuffer-maybe-quote-filename dir))) + (minibuffer-maybe-quote-filename dir))) + (initial (cons (minibuffer-maybe-quote-filename initial) 0))))) (let ((completion-ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) @@ -2693,7 +2704,7 @@ See `read-file-name' for the meaning of the arguments." ;; with what we will actually return. As an exception, ;; if that's the same as the second item in ;; file-name-history, it's really a repeat (Bug#4657). - (let ((val1 (minibuffer--double-dollars val))) + (let ((val1 (minibuffer-maybe-quote-filename val))) (if history-delete-duplicates (setcdr file-name-history (delete val1 (cdr file-name-history)))) @@ -2703,7 +2714,7 @@ See `read-file-name' for the meaning of the arguments." (if add-to-history ;; Add the value to the history--but not if it matches ;; the last value already there. - (let ((val1 (minibuffer--double-dollars val))) + (let ((val1 (minibuffer-maybe-quote-filename val))) (unless (and (consp file-name-history) (equal (car file-name-history) val1)) (setq file-name-history 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 699225277de..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))))))) @@ -411,10 +425,8 @@ must be one of the symbols `header', `mode', or `vertical'." (let ((divider-width (frame-right-divider-width frame))) (when (and (or (not (numberp divider-width)) (zerop divider-width)) - (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'left)) - (setq window (window-in-direction 'left window t)))))) + (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) + (setq window (window-in-direction 'left window t)))))) (let* ((exitfun nil) (move @@ -532,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)))) @@ -1623,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) @@ -1701,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/mpc.el b/lisp/mpc.el index 20e4bc85d85..aa7fee6adb6 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -265,10 +265,7 @@ defaults to 6600 and HOST defaults to localhost." (let ((v (match-string 3 host))) (setq host (match-string 2 host)) (when (and (stringp v) (not (string= "" v))) - (setq port - (if (string-match "[^[:digit:]]" v) - (string-to-number v) - v))))) + (setq port v)))) (when (file-name-absolute-p host) ;; Expand file name because `file-name-absolute-p' ;; considers paths beginning with "~" as absolute diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 239da7829df..07c3daf7d7e 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -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 68258d41666..b2077d784c0 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -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. @@ -798,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) @@ -1585,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 620a8a5f9ac..7672bf0e1ef 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -24,13 +24,14 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'format-spec) (require 'shr) (require 'url) (require 'url-queue) (require 'url-util) ; for url-get-url-at-point (require 'mm-url) +(require 'puny) (eval-when-compile (require 'subr-x)) ;; for string-trim (defgroup eww nil @@ -73,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." @@ -222,7 +223,7 @@ See also `eww-form-checkbox-selected-symbol'." "When this regex is found in the URL, it's not a keyword but an address.") (defvar eww-link-keymap - (let ((map (copy-keymap shr-map))) + (let ((map (copy-keymap shr-image-map))) (define-key map "\r" 'eww-follow-link) map)) @@ -279,6 +280,13 @@ word(s) will be searched for via `eww-search-prefix'." (current-buffer) (get-buffer-create "*eww*"))) (eww-setup-buffer) + ;; Check whether the domain only uses "Highly Restricted" Unicode + ;; IDNA characters. If not, transform to punycode to indicate that + ;; there may be funny business going on. + (let ((parsed (url-generic-parse-url url))) + (unless (puny-highly-restrictive-domain-p (url-host parsed)) + (setf (url-host parsed) (puny-encode-domain (url-host parsed))) + (setq url (url-recreate-url parsed)))) (plist-put eww-data :url url) (plist-put eww-data :title "") (eww-update-header-line-format) @@ -306,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." @@ -410,7 +432,7 @@ Currently this means either text/html or application/xhtml+xml." (source (and (null document) (buffer-substring (point) (point-max))))) (with-current-buffer buffer - (setq bidi-paragraph-direction 'left-to-right) + (setq bidi-paragraph-direction nil) (plist-put eww-data :source source) (plist-put eww-data :dom document) (let ((inhibit-read-only t) @@ -418,9 +440,11 @@ Currently this means either text/html or application/xhtml+xml." (shr-target-id (url-target (url-generic-parse-url url))) (shr-external-rendering-functions (append + shr-external-rendering-functions '((title . eww-tag-title) (form . eww-tag-form) (input . eww-tag-input) + (button . eww-form-submit) (textarea . eww-tag-textarea) (select . eww-tag-select) (link . eww-tag-link) @@ -570,7 +594,7 @@ Currently this means either text/html or application/xhtml+xml." (let ((inhibit-read-only t)) (remove-overlays) (erase-buffer)) - (setq bidi-paragraph-direction 'left-to-right) + (setq bidi-paragraph-direction nil) (unless (eq major-mode 'eww-mode) (eww-mode))) @@ -659,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)) @@ -685,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) @@ -703,9 +730,11 @@ the like." (define-key map "R" 'eww-readable) (define-key map "H" 'eww-list-histories) (define-key map "E" 'eww-set-character-encoding) + (define-key map "s" 'eww-switch-to-buffer) (define-key map "S" 'eww-list-buffers) (define-key map "F" 'eww-toggle-fonts) (define-key map "D" 'eww-toggle-paragraph-direction) + (define-key map [(meta C)] 'eww-toggle-colors) (define-key map "b" 'eww-add-bookmark) (define-key map "B" 'eww-list-bookmarks) @@ -717,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 @@ -726,10 +756,13 @@ the like." ["View page source" eww-view-source] ["Copy page URL" eww-copy-page-url t] ["List histories" eww-list-histories t] + ["Switch to buffer" eww-switch-to-buffer t] ["List buffers" eww-list-buffers t] ["Add bookmark" eww-add-bookmark t] ["List bookmarks" eww-list-bookmarks t] ["List cookies" url-cookie-list t] + ["Toggle fonts" eww-toggle-fonts t] + ["Toggle colors" eww-toggle-colors t] ["Character Encoding" eww-set-character-encoding] ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) map)) @@ -1516,6 +1549,24 @@ If CHARSET is nil then use UTF-8." (eww-reload nil 'utf-8) (eww-reload nil charset))) +(defun eww-switch-to-buffer () + "Prompt for an EWW buffer to display in the selected window." + (interactive) + (let ((completion-extra-properties + '(:annotation-function (lambda (buf) + (with-current-buffer buf + (format " %s" (eww-current-url))))))) + (pop-to-buffer-same-window + (read-buffer "Switch to EWW buffer: " + (cl-loop for buf in (nreverse (buffer-list)) + if (with-current-buffer buf (derived-mode-p 'eww-mode)) + return buf) + t + (lambda (bufn) + (with-current-buffer + (if (consp bufn) (cdr bufn) (get-buffer bufn)) + (derived-mode-p 'eww-mode))))))) + (defun eww-toggle-fonts () "Toggle whether to use monospaced or font-enabled layouts." (interactive) @@ -1524,6 +1575,15 @@ If CHARSET is nil then use UTF-8." (message "Proportional fonts are now %s" (if shr-use-fonts "on" "off"))) +(defun eww-toggle-colors () + "Toggle whether to use HTML-specified colors or not." + (interactive) + (message "Colors are now %s" + (if (setq shr-use-colors (not shr-use-colors)) + "on" + "off")) + (eww-reload)) + ;;; Bookmarks code (defvar eww-bookmarks nil) @@ -1964,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/gnutls.el b/lisp/net/gnutls.el index ce44c032231..9ed1c8b8305 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -26,7 +26,7 @@ ;; This package provides language bindings for the GnuTLS library ;; using the corresponding core functions in gnutls.c. It should NOT -;; be used directly, only through open-protocol-stream. +;; be used directly, only through open-network-stream. ;; Simple test: ;; @@ -95,7 +95,7 @@ A value of nil says to use the default GnuTLS value." (integer :tag "Number of bits" 512)) :group 'gnutls) -(defun open-gnutls-stream (name buffer host service) +(defun open-gnutls-stream (name buffer host service &optional nowait) "Open a SSL/TLS connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -109,6 +109,9 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. +Fifth arg NOWAIT (which is optional) means that the socket should +be opened asynchronously. The connection process will be +returned to the caller before TLS negotiation has happened. Usage example: @@ -122,9 +125,20 @@ This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (gnutls-negotiate :process (open-network-stream name buffer host service) - :type 'gnutls-x509pki - :hostname host)) + (let ((process (open-network-stream + name buffer host service + :nowait nowait + :tls-parameters + (and nowait + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :type 'gnutls-x509pki + :hostname host)))))) + (if nowait + process + (gnutls-negotiate :process process + :type 'gnutls-x509pki + :hostname host)))) (define-error 'gnutls-error "GnuTLS error") @@ -140,10 +154,47 @@ trust and key files, and priority string." &allow-other-keys) "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. -Note arguments are passed CL style, :type TYPE instead of just TYPE. +Note that arguments are passed CL style, :type TYPE instead of just TYPE. -TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. PROCESS is a process returned by `open-network-stream'. +For the meaning of the rest of the parameters, see `gnutls-boot-parameters'." + (let* ((type (or type 'gnutls-x509pki)) + ;; The gnutls library doesn't understand files delivered via + ;; the special handlers, so ignore all files found via those. + (file-name-handler-alist nil) + (params (gnutls-boot-parameters + :type type + :hostname hostname + :priority-string priority-string + :trustfiles trustfiles + :crlfiles crlfiles + :keylist keylist + :min-prime-bits min-prime-bits + :verify-flags verify-flags + :verify-error verify-error + :verify-hostname-error verify-hostname-error)) + ret) + (gnutls-message-maybe + (setq ret (gnutls-boot process type + (append (list :complete-negotiation t) + params))) + "boot: %s" params) + + (when (gnutls-errorp ret) + ;; This is a error from the underlying C code. + (signal 'gnutls-error (list process ret))) + + process)) + +(cl-defun gnutls-boot-parameters + (&rest spec + &key type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys) + "Return a keyword list of parameters suitable for passing to `gnutls-boot'. + +TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. HOSTNAME is the remote hostname. It must be a valid string. PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". TRUSTFILES is a list of CA bundles. It defaults to `gnutls-trustfiles'. @@ -189,62 +240,47 @@ here's a recent version of the list. It must be omitted, a number, or nil; if omitted or nil it defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." - (let* ((type (or type 'gnutls-x509pki)) - ;; The gnutls library doesn't understand files delivered via - ;; the special handlers, so ignore all files found via those. - (file-name-handler-alist nil) - (trustfiles (or trustfiles (gnutls-trustfiles))) - (priority-string (or priority-string - (cond - ((eq type 'gnutls-anon) - "NORMAL:+ANON-DH:!ARCFOUR-128") - ((eq type 'gnutls-x509pki) - (if gnutls-algorithm-priority - (upcase gnutls-algorithm-priority) - "NORMAL"))))) - (verify-error (or verify-error - ;; this uses the value of `gnutls-verify-error' - (cond - ;; if t, pass it on - ((eq gnutls-verify-error t) - t) - ;; if a list, look for hostname matches - ((listp gnutls-verify-error) - (apply 'append - (mapcar - (lambda (check) - (when (string-match (nth 0 check) - hostname) - (nth 1 check))) - gnutls-verify-error))) - ;; else it's nil - (t nil)))) - (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)) - params ret) + (let ((trustfiles (or trustfiles (gnutls-trustfiles))) + (priority-string (or priority-string + (cond + ((eq type 'gnutls-anon) + "NORMAL:+ANON-DH:!ARCFOUR-128") + ((eq type 'gnutls-x509pki) + (if gnutls-algorithm-priority + (upcase gnutls-algorithm-priority) + "NORMAL"))))) + (verify-error (or verify-error + ;; this uses the value of `gnutls-verify-error' + (cond + ;; if t, pass it on + ((eq gnutls-verify-error t) + t) + ;; if a list, look for hostname matches + ((listp gnutls-verify-error) + (apply 'append + (mapcar + (lambda (check) + (when (string-match (nth 0 check) + hostname) + (nth 1 check))) + gnutls-verify-error))) + ;; else it's nil + (t nil)))) + (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))) (when verify-hostname-error (push :hostname verify-error)) - (setq params `(:priority ,priority-string - :hostname ,hostname - :loglevel ,gnutls-log-level - :min-prime-bits ,min-prime-bits - :trustfiles ,trustfiles - :crlfiles ,crlfiles - :keylist ,keylist - :verify-flags ,verify-flags - :verify-error ,verify-error - :callbacks nil)) - - (gnutls-message-maybe - (setq ret (gnutls-boot process type params)) - "boot: %s" params) - - (when (gnutls-errorp ret) - ;; This is a error from the underlying C code. - (signal 'gnutls-error (list process ret))) - - process)) + `(:priority ,priority-string + :hostname ,hostname + :loglevel ,gnutls-log-level + :min-prime-bits ,min-prime-bits + :trustfiles ,trustfiles + :crlfiles ,crlfiles + :keylist ,keylist + :verify-flags ,verify-flags + :verify-error ,verify-error + :callbacks nil))) (defun gnutls-trustfiles () "Return a list of usable trustfiles." diff --git a/lisp/gnus/html2text.el b/lisp/net/html2text.el index 2b1c2057bb4..2b1c2057bb4 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/net/html2text.el diff --git a/lisp/gnus/mailcap.el b/lisp/net/mailcap.el index bf7ba0817ea..f71d7ba6675 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/net/mailcap.el @@ -29,29 +29,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (autoload 'mail-header-parse-content-type "mail-parse") -;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22. -(defalias 'mailcap-delete-duplicates - (if (fboundp 'delete-dups) - 'delete-dups - (autoload 'mm-delete-duplicates "mm-util") - 'mm-delete-duplicates)) - -;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'. -(eval-and-compile - (cond - ((fboundp 'replace-regexp-in-string) - (defun mailcap-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. -This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))) - ((fboundp 'replace-in-string) - (defalias 'mailcap-replace-in-string 'replace-in-string)))) - (defgroup mailcap nil "Definition of viewers for MIME types." :version "21.1" @@ -66,12 +46,6 @@ This is a compatibility function for different Emacsen." table) "A syntax table for parsing SGML attributes.") -(eval-and-compile - (when (featurep 'xemacs) - (condition-case nil - (require 'lpr) - (error nil)))) - (defvar mailcap-print-command (mapconcat 'identity (cons (if (boundp 'lpr-command) @@ -84,6 +58,59 @@ This is a compatibility function for different Emacsen." " ") "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 @@ -310,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) @@ -403,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." @@ -533,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))) @@ -580,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))) @@ -645,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)) @@ -677,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 @@ -726,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. @@ -745,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 @@ -758,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 @@ -933,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) @@ -993,7 +1024,7 @@ If FORCE, re-parse even if already parsed." (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) - (mailcap-delete-duplicates + (delete-dups (nconc (mapcar 'cdr mailcap-mime-extensions) (apply @@ -1021,14 +1052,14 @@ If FORCE, re-parse even if already parsed." (mailcap-parse-mimetypes) (let* ((all-mime-type ;; All unique MIME types from file extensions - (mailcap-delete-duplicates + (delete-dups (mapcar (lambda (file) (mailcap-extension-to-mime (file-name-extension file t))) files))) (all-mime-info ;; All MIME info lists - (mailcap-delete-duplicates + (delete-dups (mapcar (lambda (mime-type) (mailcap-mime-info mime-type 'all)) all-mime-type))) @@ -1046,17 +1077,20 @@ If FORCE, re-parse even if already parsed." (car all-mime-info))) (commands ;; Command strings from `viewer' field of the MIME info - (mailcap-delete-duplicates - (delq nil (mapcar (lambda (mime-info) - (let ((command (cdr (assoc 'viewer mime-info)))) - (if (stringp command) - (mailcap-replace-in-string - ;; Replace mailcap's `%s' placeholder - ;; with dired's `?' placeholder - (mailcap-replace-in-string - ;; Remove the final filename placeholder - command "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" t) - "%s" "?" t)))) + (delete-dups + (delq nil (mapcar + (lambda (mime-info) + (let ((command (cdr (assoc 'viewer mime-info)))) + (if (stringp command) + (replace-regexp-in-string + ;; Replace mailcap's `%s' placeholder + ;; with dired's `?' placeholder + "%s" "?" + (replace-regexp-in-string + ;; Remove the final filename placeholder + "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" + command nil t) + nil t)))) common-mime-info))))) commands)) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 8029e2ca70a..73d6ff4d61c 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -79,7 +79,7 @@ ;; On GNU/Linux and Irix, the system's ping program seems to send packets ;; indefinitely unless told otherwise (defcustom ping-program-options - (and (memq system-type '(gnu/linux irix)) + (and (eq system-type 'gnu/linux) (list "-c" "4")) "Options for the ping program. These options can be used to limit how many ICMP packets are emitted." @@ -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 11885987ba5..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. @@ -46,6 +46,7 @@ (require 'starttls) (require 'auth-source) (require 'nsm) +(require 'puny) (autoload 'gnutls-negotiate "gnutls") (autoload 'open-gnutls-stream "gnutls") @@ -64,8 +65,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: @@ -135,8 +136,14 @@ non-nil, is used warn the user if the connection isn't encrypted. :nogreeting is a boolean that can be used to inhibit waiting for a greeting from the server. -:nowait is a boolean that says the connection should be made -asynchronously, if possible." +:nowait, if non-nil, says the connection should be made +asynchronously, if possible. + +:tls-parameters is a list that should be supplied if you're +opening a TLS connection. The first element is the TLS +type (either `gnutls-x509pki' or `gnutls-anon'), and the +remaining elements should be a keyword list accepted by +gnutls-boot (as returned by `gnutls-boot-parameters')." (unless (featurep 'make-network-process) (error "Emacs was compiled without networking support")) (let ((type (plist-get parameters :type)) @@ -148,8 +155,10 @@ asynchronously, if possible." (plist-get parameters :capability-command)))))) ;; The simplest case: wrapper around `make-network-process'. (make-network-process :name name :buffer buffer - :host host :service service - :nowait (plist-get parameters :nowait)) + :host (puny-encode-domain host) :service service + :nowait (plist-get parameters :nowait) + :tls-parameters + (plist-get parameters :tls-parameters)) (let ((work-buffer (or buffer (generate-new-buffer " *stream buffer*"))) (fun (cond ((and (eq type 'plain) @@ -194,11 +203,14 @@ asynchronously, if possible." ;;;###autoload (defalias 'open-protocol-stream 'open-network-stream) +(define-obsolete-function-alias 'open-protocol-stream 'open-network-stream + "26.1") (defun network-stream-open-plain (name buffer host service parameters) (let ((start (with-current-buffer buffer (point))) (stream (make-network-process :name name :buffer buffer - :host host :service service + :host (puny-encode-domain host) + :service service :nowait (plist-get parameters :nowait)))) (when (plist-get parameters :warn-unless-encrypted) (setq stream (nsm-verify-connection stream host service nil t))) @@ -219,7 +231,8 @@ asynchronously, if possible." eoc)) ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE) (stream (make-network-process :name name :buffer buffer - :host host :service service)) + :host (puny-encode-domain host) + :service service)) (greeting (and (not (plist-get parameters :nogreeting)) (network-stream-get-response stream start eoc))) (capabilities (network-stream-command stream capability-command @@ -296,8 +309,12 @@ asynchronously, if possible." (unless require-tls (setq stream (make-network-process :name name :buffer buffer - :host host :service service)) + :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)))) @@ -355,32 +372,34 @@ asynchronously, if possible." (with-current-buffer buffer (let* ((start (point-max)) (stream - (funcall (if (gnutls-available-p) - 'open-gnutls-stream - 'open-tls-stream) - name buffer host service)) + (if (gnutls-available-p) + (open-gnutls-stream name buffer host service + (plist-get parameters :nowait)) + (open-tls-stream name buffer host service))) (eoc (plist-get parameters :end-of-command))) - ;; Check certificate validity etc. - (when (and (gnutls-available-p) stream) - (setq stream (nsm-verify-connection stream host service))) - (if (null stream) - (list nil nil nil 'plain) - ;; If we're using tls.el, we have to delete the output from - ;; openssl/gnutls-cli. - (when (and (not (gnutls-available-p)) - eoc) - (network-stream-get-response stream start eoc) - (goto-char (point-min)) - (when (re-search-forward eoc nil t) - (goto-char (match-beginning 0)) - (delete-region (point-min) (line-beginning-position)))) - (let ((capability-command (plist-get parameters :capability-command)) - (eo-capa (or (plist-get parameters :end-of-capability) - eoc))) - (list stream - (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command eo-capa) - 'tls)))))) + (if (plist-get parameters :nowait) + (list stream nil nil 'tls) + ;; Check certificate validity etc. + (when (and (gnutls-available-p) stream) + (setq stream (nsm-verify-connection stream host service))) + (if (null stream) + (list nil nil nil 'plain) + ;; If we're using tls.el, we have to delete the output from + ;; openssl/gnutls-cli. + (when (and (not (gnutls-available-p)) + eoc) + (network-stream-get-response stream start eoc) + (goto-char (point-min)) + (when (re-search-forward eoc nil t) + (goto-char (match-beginning 0)) + (delete-region (point-min) (line-beginning-position)))) + (let ((capability-command (plist-get parameters :capability-command)) + (eo-capa (or (plist-get parameters :end-of-capability) + eoc))) + (list stream + (network-stream-get-response stream start eoc) + (network-stream-command stream capability-command eo-capa) + 'tls))))))) (defun network-stream-open-shell (name buffer host service parameters) (require 'format-spec) 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 d0b55437732..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) @@ -297,19 +298,30 @@ unencrypted." nil (let ((response (condition-case nil - (nsm-query-user message args (nsm-format-certificate status)) + (intern + (car (split-string + (nsm-query-user message args + (nsm-format-certificate status)))) + obarray) ;; Make sure we manage to close the process if the user hits ;; `C-g'. (quit 'no) (error 'no)))) (if (eq response 'no) - nil + (progn + (message "Aborting connection to %s:%s" host port) + nil) + (message (if (eq response 'session) + "Accepting certificate for %s:%s this session only" + "Permanently accepting certificate for %s:%s") + host port) (nsm-save-host host port status what response) t)))) (defun nsm-query-user (message args cert) (let ((buffer (get-buffer-create "*Network Security Manager*"))) (save-window-excursion + ;; First format the certificate and warnings. (with-help-window buffer (with-current-buffer buffer (erase-buffer) @@ -321,28 +333,15 @@ unencrypted." ;; Fill the first line of the message, which usually ;; contains lots of explanatory text. (fill-region (point) (line-end-position))))) - (let ((responses '((?n . no) - (?s . session) - (?a . always))) - (prefix "") - (cursor-in-echo-area t) - response) - (while (not response) - (setq response - (cdr - (assq (downcase - (read-char - (concat prefix - "Continue connecting? (No, Session only, Always) "))) - responses))) - (unless response - (ding) - (setq prefix "Invalid choice. "))) - (kill-buffer buffer) - ;; If called from a callback, `read-char' will insert things - ;; into the pending input. Clear that. - (clear-this-command-keys) - response)))) + ;; Then ask the user what to do about it. + (unwind-protect + (cadr + (read-multiple-choice + "Continue connecting?" + '((?a "always" "Accept this certificate this session and for all future sessions.") + (?s "session only" "Accept this certificate this session only.") + (?n "no" "Refuse to use this certificate, and close the connection.")))) + (kill-buffer buffer))))) (defun nsm-save-host (host port status what permanency) (let* ((id (nsm-id host port)) 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/gnus/pop3.el b/lisp/net/pop3.el index fc593806bfc..3964288fd23 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/net/pop3.el @@ -34,12 +34,6 @@ (eval-when-compile (require 'cl)) -(eval-and-compile - ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for - ;; `make-network-stream'. - (unless (fboundp 'open-protocol-stream) - (require 'proto-stream))) - (require 'mail-utils) (defvar parse-time-months) @@ -51,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) @@ -406,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) @@ -521,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 @@ -533,13 +528,6 @@ this is nil, `ssl' is assumed for connections to port (const :tag "SSL/TLS" ssl) (const starttls))) -(eval-and-compile - (if (fboundp 'set-process-query-on-exit-flag) - (defalias 'pop3-set-process-query-on-exit-flag - 'set-process-query-on-exit-flag) - (defalias 'pop3-set-process-query-on-exit-flag - 'process-kill-without-query))) - (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST on PORT. Returns the process associated with the connection." @@ -552,7 +540,7 @@ Returns the process associated with the connection." (erase-buffer) (setq pop3-read-point (point-min)) (setq result - (open-protocol-stream + (open-network-stream "POP" (current-buffer) mailhost port :type (cond ((or (eq pop3-stream-type 'ssl) @@ -576,7 +564,7 @@ Returns the process associated with the connection." (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) - (pop3-set-process-query-on-exit-flag (car result) nil) + (set-process-query-on-exit-flag (car result) nil) (erase-buffer) (car result))))) @@ -644,9 +632,7 @@ If NOW, use that time instead." (format " %s " (capitalize (car (rassoc (nth 4 (decode-time now)) parse-time-months)))) - (format-time-string "%Y %H:%M:%S " now) - ;; We do all of this because XEmacs doesn't have the %z spec. - (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) + (format-time-string "%Y %H:%M:%S %z" now)))) (defun pop3-munge-message-separator (start end) "Check to see if a message separator exists. If not, generate one." diff --git a/lisp/net/puny.el b/lisp/net/puny.el new file mode 100644 index 00000000000..50bde85287d --- /dev/null +++ b/lisp/net/puny.el @@ -0,0 +1,248 @@ +;;; puny.el --- translate non-ASCII domain names to ASCII + +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: mail, net + +;; 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: + +;; Written by looking at +;; http://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion + +;;; Code: + +(require 'seq) + +(defun puny-encode-domain (domain) + "Encode DOMAIN according to the IDNA/punycode algorithm. +For instance, \"fśf.org\" => \"xn--ff-2sa.org\"." + ;; The vast majority of domain names are not IDNA domain names, so + ;; add a check first to avoid doing unnecessary work. + (if (string-match "\\'[[:ascii:]]+\\'" domain) + domain + (mapconcat 'puny-encode-string (split-string domain "[.]") "."))) + +(defun puny-encode-string (string) + "Encode STRING according to the IDNA/punycode algorithm. +This is used to encode non-ASCII domain names. +For instance, \"bücher\" => \"xn--bcher-kva\"." + (let ((ascii (seq-filter (lambda (char) + (< char 128)) + string))) + (if (= (length ascii) (length string)) + string + (concat "xn--" + (if (null ascii) + "" + (concat ascii "-")) + (puny-encode-complex (length ascii) string))))) + +(defun puny-decode-domain (domain) + "Decode DOMAIN according to the IDNA/punycode algorithm. +For instance, \"xn--ff-2sa.org\" => \"fśf.org\"." + (mapconcat 'puny-decode-string (split-string domain "[.]") ".")) + +(defun puny-decode-string (string) + "Decode an IDNA/punycode-encoded string. +For instance \"xn--bcher-kva\" => \"bücher\"." + (if (string-match "\\`xn--" string) + (puny-decode-string-internal (substring string 4)) + string)) + +(defconst puny-initial-n 128) +(defconst puny-initial-bias 72) +(defconst puny-base 36) +(defconst puny-damp 700) +(defconst puny-tmin 1) +(defconst puny-tmax 26) +(defconst puny-skew 28) + +;; 0-25 a-z +;; 26-36 0-9 +(defun puny-encode-digit (d) + (if (< d 26) + (+ ?a d) + (+ ?0 (- d 26)))) + +(defun puny-adapt (delta num-points first-time) + (let ((delta (if first-time + (/ delta puny-damp) + (/ delta 2))) + (k 0)) + (setq delta (+ delta (/ delta num-points))) + (while (> delta (/ (* (- puny-base puny-tmin) + puny-tmax) + 2)) + (setq delta (/ delta (- puny-base puny-tmin)) + k (+ k puny-base))) + (+ k (/ (* (1+ (- puny-base puny-tmin)) delta) + (+ delta puny-skew))))) + +(defun puny-encode-complex (insertion-points string) + (let ((n puny-initial-n) + (delta 0) + (bias puny-initial-bias) + (h insertion-points) + result m ijv q) + (while (< h (length string)) + (setq ijv (cl-loop for char across string + when (>= char n) + minimize char)) + (setq m ijv) + (setq delta (+ delta (* (- m n) (+ h 1))) + n m) + (cl-loop for char across string + when (< char n) + do (cl-incf delta) + when (= char ijv) + do (progn + (setq q delta) + (cl-loop with k = puny-base + for t1 = (cond + ((<= k bias) + puny-tmin) + ((>= k (+ bias puny-tmax)) + puny-tmax) + (t + (- k bias))) + while (>= q t1) + do (push (puny-encode-digit + (+ t1 (mod (- q t1) + (- puny-base t1)))) + result) + do (setq q (/ (- q t1) (- puny-base t1)) + k (+ k puny-base))) + (push (puny-encode-digit q) result) + (setq bias (puny-adapt delta (+ h 1) (= h insertion-points)) + delta 0 + h (1+ h)))) + (cl-incf delta) + (cl-incf n)) + (nreverse result))) + +(defun puny-decode-digit (cp) + (cond + ((<= cp ?9) + (+ (- cp ?0) 26)) + ((<= cp ?Z) + (- cp ?A)) + ((<= cp ?z) + (- cp ?a)) + (t + puny-base))) + +(defun puny-decode-string-internal (string) + (with-temp-buffer + (insert string) + (goto-char (point-max)) + (search-backward "-" nil (point-min)) + ;; The encoded chars are after the final dash. + (let ((encoded (buffer-substring (1+ (point)) (point-max))) + (ic 0) + (i 0) + (bias puny-initial-bias) + (n puny-initial-n) + out) + (delete-region (point) (point-max)) + (while (< ic (length encoded)) + (let ((old-i i) + (w 1) + (k puny-base) + digit t1) + (cl-loop do (progn + (setq digit (puny-decode-digit (aref encoded ic))) + (cl-incf ic) + (cl-incf i (* digit w)) + (setq t1 (cond + ((<= k bias) + puny-tmin) + ((>= k (+ bias puny-tmax)) + puny-tmax) + (t + (- k bias))))) + while (>= digit t1) + do (setq w (* w (- puny-base t1)) + k (+ k puny-base))) + (setq out (1+ (buffer-size))) + (setq bias (puny-adapt (- i old-i) out (= old-i 0)))) + + (setq n (+ n (/ i out)) + i (mod i out)) + (goto-char (point-min)) + (forward-char i) + (insert (format "%c" n)) + (cl-incf i))) + (buffer-string))) + +;; http://www.unicode.org/reports/tr39/#Restriction_Level_Detection +;; http://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers + +(defun puny-highly-restrictive-string-p (string) + "Say whether STRING is \"highly restrictive\" in the Unicode IDNA sense. +See http://www.unicode.org/reports/tr39/#Restriction_Level_Detection +for details. The main idea is that if you're mixing +scripts (like latin and cyrillic), you may confuse the user by +using homographs." + (let ((scripts + (delq + t + (seq-uniq + (seq-map (lambda (char) + (if (memq char + ;; These characters are always allowed + ;; in any string. + '(#x0027 ; APOSTROPHE + #x002D ; HYPHEN-MINUS + #x002E ; FULL STOP + #x003A ; COLON + #x00B7 ; MIDDLE DOT + #x058A ; ARMENIAN HYPHEN + #x05F3 ; HEBREW PUNCTUATION GERESH + #x05F4 ; HEBREW PUNCTUATION GERSHAYIM + #x0F0B ; TIBETAN MARK INTERSYLLABIC TSHEG + #x200C ; ZERO WIDTH NON-JOINER* + #x200D ; ZERO WIDTH JOINER* + #x2010 ; HYPHEN + #x2019 ; RIGHT SINGLE QUOTATION MARK + #x2027 ; HYPHENATION POINT + #x30A0 ; KATAKANA-HIRAGANA DOUBLE HYPHEN + #x30FB)) ; KATAKANA MIDDLE DOT + t + (aref char-script-table char))) + string))))) + (or + ;; Every character uses the same script. + (= (length scripts) 1) + (seq-some 'identity + (mapcar (lambda (list) + (seq-every-p (lambda (script) + (memq script list)) + scripts)) + '((latin han hiragana kana) + (latin han bopomofo) + (latin han hangul))))))) + +(defun puny-highly-restrictive-domain-p (domain) + "Say whether DOMAIN is \"highly restrictive\" in the Unicode IDNA sense. +See `puny-highly-restrictive-string-p' for further details." + (seq-every-p 'puny-highly-restrictive-string-p (split-string domain "[.]"))) + +(provide 'puny) + +;;; puny.el ends here diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index bb9ce31307b..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 @@ -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 55b43f63963..66e6326085c 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -103,7 +103,12 @@ connected to automatically. `:encryption' VALUE must be `plain' (the default) for unencrypted connections, or `tls' -for connections using SSL/TLS." +for connections using SSL/TLS. + +`:server-alias' + +VALUE must be a string that will be used instead of the server name for +display purposes. If absent, the real server name will be displayed instead." :type '(alist :key-type string :value-type (plist :options ((:nick string) @@ -113,7 +118,8 @@ for connections using SSL/TLS." (:full-name string) (:channels (repeat string)) (:encryption (choice (const tls) - (const plain)))))) + (const plain))) + (:server-alias string)))) :group 'rcirc) (defcustom rcirc-default-port 6667 @@ -484,22 +490,26 @@ If ARG is non-nil, instead prompt for connection parameters." (channels (plist-get (cdr c) :channels)) (password (plist-get (cdr c) :password)) (encryption (plist-get (cdr c) :encryption)) + (server-alias (plist-get (cdr c) :server-alias)) contact) (when server (let (connected) (dolist (p (rcirc-process-list)) - (when (string= server (process-name p)) + (when (string= (or server-alias server) (process-name p)) (setq connected p))) (if (not connected) (condition-case nil (rcirc-connect server port nick user-name - full-name channels password encryption) - (quit (message "Quit connecting to %s" server))) + full-name channels password encryption + server-alias) + (quit (message "Quit connecting to %s" + (or server-alias server)))) (with-current-buffer (process-buffer connected) (setq contact (process-contact - (get-buffer-process (current-buffer)) :host)) + (get-buffer-process (current-buffer)) :name)) (setq connected-servers - (cons (if (stringp contact) contact server) + (cons (if (stringp contact) + contact (or server-alias server)) connected-servers)))))))) (when connected-servers (message "Already connected to %s" @@ -528,9 +538,10 @@ If ARG is non-nil, instead prompt for connection parameters." ;;;###autoload (defun rcirc-connect (server &optional port nick user-name - full-name startup-channels password encryption) + full-name startup-channels password encryption + server-alias) (save-excursion - (message "Connecting to %s..." server) + (message "Connecting to %s..." (or server-alias server)) (let* ((inhibit-eol-conversion) (port-number (if port (if (stringp port) @@ -542,7 +553,7 @@ If ARG is non-nil, instead prompt for connection parameters." (full-name (or full-name rcirc-default-full-name)) (startup-channels startup-channels) (process (open-network-stream - server nil server port-number + (or server-alias server) nil server port-number :type (or encryption 'plain)))) ;; set up process (set-process-coding-system process 'raw-text 'raw-text) @@ -557,7 +568,8 @@ If ARG is non-nil, instead prompt for connection parameters." password encryption)) (setq-local rcirc-process process) (setq-local rcirc-server server) - (setq-local rcirc-server-name server) ; Update when we get 001 response. + (setq-local rcirc-server-name + (or server-alias server)) ; Update when we get 001 response. (setq-local rcirc-buffer-alist nil) (setq-local rcirc-nick-table (make-hash-table :test 'equal)) (setq-local rcirc-nick nick) @@ -584,7 +596,7 @@ If ARG is non-nil, instead prompt for connection parameters." (setq rcirc-keepalive-timer (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive))) - (message "Connecting to %s...done" server) + (message "Connecting to %s...done" (or server-alias server)) ;; return process object process))) @@ -599,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. @@ -626,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) @@ -635,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*") @@ -2330,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 18bc7b86715..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. @@ -36,6 +36,8 @@ (require 'subr-x) (require 'dom) (require 'seq) +(require 'svg) +(require 'image) (defgroup shr nil "Simple HTML Renderer" @@ -64,6 +66,12 @@ fit these criteria." :group 'shr :type 'boolean) +(defcustom shr-use-colors t + "If non-nil, respect color specifications in the HTML." + :version "26.1" + :group 'shr + :type 'boolean) + (defcustom shr-table-horizontal-line nil "Character used to draw horizontal table lines. If nil, don't draw horizontal table lines." @@ -136,6 +144,14 @@ cid: URL as the argument.") (defvar shr-inhibit-images nil "If non-nil, inhibit loading images.") +(defvar shr-external-rendering-functions nil + "Alist of tag/function pairs used to alter how shr renders certain tags. +For instance, eww uses this to alter rendering of title, forms +and other things: +((title . eww-tag-title) + (form . eww-tag-form) + ...)") + ;;; Internal variables. (defvar shr-folding-mode nil) @@ -151,7 +167,6 @@ cid: URL as the argument.") (defvar shr-depth 0) (defvar shr-warning nil) (defvar shr-ignore-cache nil) -(defvar shr-external-rendering-functions nil) (defvar shr-target-id nil) (defvar shr-table-separator-length 1) (defvar shr-table-separator-pixel-width 0) @@ -172,10 +187,16 @@ cid: URL as the argument.") (define-key map "w" 'shr-copy-url) (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) - (define-key map "o" 'shr-save-contents) + (define-key map "O" 'shr-save-contents) (define-key map "\r" 'shr-browse-url) map)) +(defvar shr-image-map + (let ((map (copy-keymap shr-map))) + (when (boundp 'image-map) + (set-keymap-parent map image-map)) + map)) + ;; Public functions and commands. (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) @@ -254,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. @@ -279,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")) @@ -435,11 +455,10 @@ size, and full-buffer size." (defun shr-descend (dom) (let ((function - (or - ;; Allow other packages to override (or provide) rendering - ;; of elements. - (cdr (assq (dom-tag dom) shr-external-rendering-functions)) - (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))) + (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray)) + ;; Allow other packages to override (or provide) rendering + ;; of elements. + (external (cdr (assq (dom-tag dom) shr-external-rendering-functions))) (style (dom-attr dom 'style)) (shr-stylesheet shr-stylesheet) (shr-depth (1+ shr-depth)) @@ -454,9 +473,12 @@ size, and full-buffer size." (setq style nil))) ;; If we have a display:none, then just ignore this part of the DOM. (unless (equal (cdr (assq 'display shr-stylesheet)) "none") - (if (fboundp function) - (funcall function dom) - (shr-generic dom)) + (cond (external + (funcall external dom)) + ((fboundp function) + (funcall function dom)) + (t + (shr-generic dom))) (when (and shr-target-id (equal (dom-attr dom 'id) shr-target-id)) ;; If the element was empty, we don't have anything to put the @@ -538,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)) @@ -548,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 " ")) @@ -565,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. @@ -639,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 " $") @@ -766,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) ?/)) @@ -955,10 +981,14 @@ element is the data blob and the second element is the content-type." (create-image data 'svg t :ascent 100)) ((eq size 'full) (ignore-errors - (shr-rescale-image data content-type))) + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height)))) (t (ignore-errors - (shr-rescale-image data content-type)))))) + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height))))))) (when image ;; When inserting big-ish pictures, put them at the ;; beginning of the line. @@ -981,21 +1011,40 @@ element is the data blob and the second element is the content-type." image) (insert (or alt "")))) -(defun shr-rescale-image (data &optional content-type) - "Rescale DATA, if too big, to fit the current buffer." - (if (not (and (fboundp 'imagemagick-types) - (get-buffer-window (current-buffer)))) +(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 (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))))) - (create-image - data 'imagemagick t - :ascent 100 - :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)))) - :format content-type)))) + (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))))) + (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 + (< (* width scaling) max-width) + (< (* height scaling) max-height)) + (create-image + data 'imagemagick t + :ascent 100 + :width width + :height height + :format content-type) + (create-image + data 'imagemagick t + :ascent 100 + :max-width max-width + :max-height max-height + :format content-type))))) ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) @@ -1074,8 +1123,15 @@ START, and END. Note that START and END should be markers." url))) (if title (format "%s (%s)" iri title) iri)) 'follow-link t - 'mouse-face 'highlight - 'keymap shr-map))) + 'mouse-face 'highlight)) + ;; Don't overwrite any keymaps that are already in the buffer (i.e., + ;; image keymaps). + (while (and start + (< start (point))) + (let ((next (next-single-property-change start 'keymap nil (point)))) + (if (get-text-property start 'keymap) + (setq start next) + (put-text-property start (or next (point)) 'keymap shr-map))))) (defun shr-encode-url (url) "Encode URL." @@ -1107,7 +1163,9 @@ ones, in case fg and bg are nil." (shr-color-visible bg fg))))))) (defun shr-colorize-region (start end fg &optional bg) - (when (and (or fg bg) (>= (display-color-cells) 88)) + (when (and shr-use-colors + (or fg bg) + (>= (display-color-cells) 88)) (let ((new-colors (shr-color-check fg bg))) (when new-colors (when fg @@ -1120,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) @@ -1140,7 +1186,9 @@ ones, in case fg and bg are nil." ((equal dir "ltr") (setq bidi-paragraph-direction 'left-to-right)) ((equal dir "rtl") - (setq bidi-paragraph-direction 'right-to-left)))) + (setq bidi-paragraph-direction 'right-to-left)) + ((equal dir "auto") + (setq bidi-paragraph-direction nil)))) (shr-generic dom)) (defun shr-tag-body (dom) @@ -1226,9 +1274,6 @@ ones, in case fg and bg are nil." (defun shr-tag-s (dom) (shr-fontize-dom dom 'shr-strike-through)) -(defun shr-tag-del (dom) - (shr-fontize-dom dom 'shr-strike-through)) - (defun shr-tag-b (dom) (shr-fontize-dom dom 'bold)) @@ -1248,6 +1293,24 @@ ones, in case fg and bg are nil." (let ((shr-current-font 'default)) (shr-generic dom))) +(defun shr-tag-ins (cont) + (let* ((start (point)) + (color "green") + (shr-stylesheet (nconc (list (cons 'color color)) + shr-stylesheet))) + (shr-generic cont) + (shr-colorize-region start (point) color + (cdr (assq 'background-color shr-stylesheet))))) + +(defun shr-tag-del (cont) + (let* ((start (point)) + (color "red") + (shr-stylesheet (nconc (list (cons 'color color)) + shr-stylesheet))) + (shr-fontize-dom cont 'shr-strike-through) + (shr-colorize-region start (point) color + (cdr (assq 'background-color shr-stylesheet))))) + (defun shr-parse-style (style) (when style (save-match-data @@ -1391,11 +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)) - (url (shr-expand-url (or url (dom-attr dom 'src))))) + (width (shr-string-number (dom-attr dom 'width))) + (height (shr-string-number (dom-attr dom 'height))) + (url (shr-expand-url (or url (shr--preferred-image dom))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "*")) @@ -1408,7 +1474,8 @@ The preference is a float determined from `shr-prefer-media-type'." (string-match "\\`data:" url)) (let ((image (shr-image-from-data (substring url (match-end 0))))) (if image - (funcall shr-put-image-function image alt) + (funcall shr-put-image-function image alt + (list :width width :height height)) (insert alt)))) ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) @@ -1417,7 +1484,8 @@ The preference is a float determined from `shr-prefer-media-type'." (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) (insert alt) - (funcall shr-put-image-function image alt)))) + (funcall shr-put-image-function image alt + (list :width width :height height))))) ((or shr-inhibit-images (and shr-blocked-images (string-match shr-blocked-images url))) @@ -1425,20 +1493,26 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-insert alt)) ((and (not shr-ignore-cache) (url-is-cached (shr-encode-url url))) - (funcall shr-put-image-function (shr-get-image-data url) alt)) + (funcall shr-put-image-function (shr-get-image-data url) alt + (list :width width :height height))) (t - (insert alt " ") (when (and shr-ignore-cache (url-is-cached (shr-encode-url url))) (let ((file (url-cache-create-filename (shr-encode-url url)))) (when (file-exists-p file) (delete-file file)))) + (when (image-type-available-p 'svg) + (insert-image + (shr-make-placeholder-image dom) + (or alt ""))) + (insert " ") (url-queue-retrieve (shr-encode-url url) 'shr-image-fetched - (list (current-buffer) start (set-marker (make-marker) (1- (point)))) + (list (current-buffer) start (set-marker (make-marker) (point)) + (list :width width :height height)) t t))) (when (zerop shr-table-depth) ;; We are not in a table. - (put-text-property start (point) 'keymap shr-map) + (put-text-property start (point) 'keymap shr-image-map) (put-text-property start (point) 'shr-alt alt) (put-text-property start (point) 'image-url url) (put-text-property start (point) 'image-displayer @@ -1447,6 +1521,89 @@ 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 + (setq string (replace-regexp-in-string "[^0-9]" "" string)) + (if (zerop (length string)) + nil + (string-to-number string)))) + +(defun shr-make-placeholder-image (dom) + (let* ((edges (and + (get-buffer-window (current-buffer)) + (window-inside-pixel-edges + (get-buffer-window (current-buffer))))) + (scaling (image-compute-scaling-factor image-scaling-factor)) + (width (truncate + (* (or (shr-string-number (dom-attr dom 'width)) 100) + scaling))) + (height (truncate + (* (or (shr-string-number (dom-attr dom 'height)) 100) + scaling))) + (max-width + (and edges + (truncate (* shr-max-image-proportion + (- (nth 2 edges) (nth 0 edges)))))) + (max-height (and edges + (truncate (* shr-max-image-proportion + (- (nth 3 edges) (nth 1 edges)))))) + svg) + (when (and max-width + (> width max-width)) + (setq height (truncate (* (/ (float max-width) width) height)) + width max-width)) + (when (and max-height + (> height max-height)) + (setq width (truncate (* (/ (float max-height) height) width)) + height max-height)) + (setq svg (svg-create width height)) + (svg-gradient svg "background" 'linear '((0 . "#b0b0b0") (100 . "#808080"))) + (svg-rectangle svg 0 0 width height :gradient "background" + :stroke-width 2 :stroke-color "black") + (let ((image (svg-image svg))) + (setf (image-property image :ascent) 100) + image))) + (defun shr-tag-pre (dom) (let ((shr-folding-mode 'none) (shr-current-font 'default)) @@ -1513,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. @@ -1576,6 +1735,24 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-colorize-region start (point) color (cdr (assq 'background-color shr-stylesheet)))))) +(defun shr-tag-bdo (dom) + (let* ((direction (dom-attr dom 'dir)) + (char (cond + ((equal direction "ltr") + ?\N{LEFT-TO-RIGHT OVERRIDE}) + ((equal direction "rtl") + ?\N{RIGHT-TO-LEFT OVERRIDE})))) + (when char + (insert ?\N{FIRST STRONG ISOLATE} char)) + (shr-generic dom) + (when char + (insert ?\N{POP DIRECTIONAL FORMATTING} ?\N{POP DIRECTIONAL ISOLATE})))) + +(defun shr-tag-bdi (dom) + (insert ?\N{FIRST STRONG ISOLATE}) + (shr-generic dom) + (insert ?\N{POP DIRECTIONAL ISOLATE})) + ;;; Table rendering algorithm. ;; Table rendering is the only complicated thing here. We do this by @@ -1721,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)) @@ -1747,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) @@ -1755,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))) @@ -1786,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 " " @@ -1968,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/gnus/sieve-manage.el b/lisp/net/sieve-manage.el index 212a7fd9f35..8f7bd449284 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -75,10 +75,9 @@ (require 'password-cache) (require 'password)) -(eval-when-compile - (require 'cl) ; caddr - (require 'sasl) - (require 'starttls)) +(eval-when-compile (require 'cl)) +(require 'sasl) +(require 'starttls) (autoload 'sasl-find-mechanism "sasl") (autoload 'auth-source-search "auth-source") @@ -147,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 @@ -202,7 +207,7 @@ Return the buffer associated with the connection." (sieve-manage-erase) (setq sieve-manage-state 'initial) (destructuring-bind (proc . props) - (open-protocol-stream + (open-network-stream "SIEVE" buffer server port :type stream :capability-command "CAPABILITY\r\n" @@ -211,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/gnus/sieve-mode.el b/lisp/net/sieve-mode.el index 5ea687dd918..6aa1b207ee2 100644 --- a/lisp/gnus/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,19 +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) "#+ *") - (unless (featurep 'xemacs) - (set (make-local-variable 'font-lock-defaults) - '(sieve-font-lock-keywords nil nil ((?_ . "w"))))) + (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/gnus/sieve.el b/lisp/net/sieve.el index 2046e53697d..d126d84c5de 100644 --- a/lisp/gnus/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 12c9f419555..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 @@ -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. diff --git a/lisp/gnus/starttls.el b/lisp/net/starttls.el index 7c4e3839ce1..b9255901f97 100644 --- a/lisp/gnus/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) @@ -160,13 +160,13 @@ find out which parameters are available." :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 @@ -232,13 +232,6 @@ handshake, or nil on failure." (starttls-negotiate-gnutls process) (signal-process (process-id process) 'SIGALRM))) -(eval-and-compile - (if (fboundp 'set-process-query-on-exit-flag) - (defalias 'starttls-set-process-query-on-exit-flag - 'set-process-query-on-exit-flag) - (defalias 'starttls-set-process-query-on-exit-flag - 'process-kill-without-query))) - (defun starttls-open-stream-gnutls (name buffer host port) (message "Opening STARTTLS connection to `%s:%s'..." host port) (let* (done @@ -250,7 +243,7 @@ handshake, or nil on failure." (int-to-string port) port) starttls-extra-arguments))) - (starttls-set-process-query-on-exit-flag process nil) + (set-process-query-on-exit-flag process nil) (while (and (processp process) (eq (process-status process) 'run) (with-current-buffer buffer @@ -292,7 +285,7 @@ GnuTLS requires a port number." name buffer starttls-program host (format "%s" port) starttls-extra-args))) - (starttls-set-process-query-on-exit-flag process nil) + (set-process-query-on-exit-flag process nil) process))) (defun starttls-available-p () diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 32fd1888d36..a4218c28ab3 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -35,16 +35,13 @@ (require 'tramp) -;; Pacify byte-compiler. -(defvar directory-listing-before-filename-regexp) -(defvar directory-sep-char) - ;;;###tramp-autoload (defcustom tramp-adb-program "adb" "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 @@ -52,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 @@ -64,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 @@ -76,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 @@ -109,7 +110,6 @@ It is used for TCP/IP devices." (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-adb-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-adb-handle-expand-file-name) @@ -126,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) @@ -151,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) @@ -162,7 +164,8 @@ 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) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (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) (write-region . tramp-adb-handle-write-region)) @@ -199,8 +202,8 @@ pass to the OPERATION." tramp-current-host nil nil)) result) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) - (tramp-compat-set-process-query-on-exit-flag p nil) - (while (eq 'run (process-status p)) + (set-process-query-on-exit-flag p nil) + (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)) @@ -213,7 +216,7 @@ pass to the OPERATION." (lambda (elt) (setcar (cdr elt) - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string ":" tramp-prefix-port-format (car (cdr elt))))) result) result)))) @@ -233,12 +236,9 @@ pass to the OPERATION." (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do normal `expand-file-name' (this does "/./" and "/../"). - ;; We bind `directory-sep-char' here for XEmacs on Windows, - ;; which would otherwise use backslash. `default-directory' is - ;; bound, because on Windows there would be problems with UNC - ;; shares or Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter @@ -247,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? @@ -261,8 +263,7 @@ pass to the OPERATION." (with-tramp-file-property v localname "file-truename" (let ((result nil)) ; result steps in reverse order (tramp-message v 4 "Finding true name for `%s'" filename) - (let* ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) + (let* ((steps (split-string localname "/" 'omit)) (localnamedir (tramp-run-real-handler 'file-name-as-directory (list localname))) (is-dir (string= localname localnamedir)) @@ -283,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) @@ -312,8 +314,7 @@ pass to the OPERATION." "Symlink target `%s' on wrong host" symlink-target)) (setq symlink-target localname)) (setq steps - (append (tramp-compat-split-string - symlink-target "/") + (append (split-string symlink-target "/" 'omit) steps))) (t ;; It's a file. @@ -434,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") @@ -443,16 +445,14 @@ 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 (apply 'concat (mapcar (lambda (s) - (tramp-compat-replace-regexp-in-string - "\\(.\\)" " -\\1" - (tramp-compat-replace-regexp-in-string "^-" "" s))) + (replace-regexp-in-string + "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s))) ;; FIXME: Warning about removed switches (long and non-dash). (delq nil (mapcar @@ -523,6 +523,9 @@ Emacs dired can't find files." (defun tramp-adb-handle-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files." (setq directory (expand-file-name directory)) + (with-parsed-tramp-file-name (file-truename directory) nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-directory-property v localname)) (with-parsed-tramp-file-name directory nil (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname) @@ -546,7 +549,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 @@ -572,21 +575,21 @@ 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 v 3 (format "Fetching %s to tmp file %s" filename tmpfile) ;; "adb pull ..." does not always return an error code. - (when (or (tramp-adb-execute-adb-command v "pull" localname tmpfile) + (when (or (tramp-adb-execute-adb-command + v "pull" (tramp-compat-file-name-unquote localname) tmpfile) (not (file-exists-p tmpfile))) (ignore-errors (delete-file tmpfile)) (tramp-error v 'file-error "Cannot make local copy of file `%s'" filename)) (set-file-modes tmpfile - (logior (or (file-modes filename) 0) - (tramp-compat-octal-to-decimal "0400")))) + (logior (or (file-modes filename) 0) (string-to-number "0400" 8)))) tmpfile))) (defun tramp-adb-handle-file-writable-p (filename) @@ -631,8 +634,7 @@ But handle the case, if the \"test\" command is not available." (copy-file filename tmpfile 'ok) (set-file-modes tmpfile - (logior (or (file-modes tmpfile) 0) - (tramp-compat-octal-to-decimal "0600")))) + (logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8)))) (tramp-run-real-handler 'write-region (list start end tmpfile append 'no-message lockname confirm)) @@ -640,7 +642,8 @@ But handle the case, if the \"test\" command is not available." v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect - (when (tramp-adb-execute-adb-command v "push" tmpfile localname) + (when (tramp-adb-execute-adb-command + v "push" tmpfile (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) @@ -657,8 +660,7 @@ But handle the case, if the \"test\" command is not available." (with-parsed-tramp-file-name filename nil (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-file-property v localname) - (tramp-adb-send-command-and-check - v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname)))) + (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname)))) (defun tramp-adb-handle-set-file-times (filename &optional time) "Like `set-file-times' for Tramp files." @@ -676,7 +678,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) @@ -684,42 +686,72 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (file-directory-p filename) (tramp-file-name-handler 'copy-directory filename newname keep-date t) - (with-tramp-progress-reporter - (tramp-dissect-file-name - (if (tramp-tramp-file-p filename) filename newname)) - 0 (format "Copying %s to %s" filename newname) - - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname - (expand-file-name (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (when (tramp-adb-execute-adb-command v "push" filename localname) - (tramp-error - v 'file-error "Cannot copy `%s' `%s'" filename newname)))))) + + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname))) + (with-parsed-tramp-file-name (if t1 filename newname) nil + (with-tramp-progress-reporter + v 0 (format "Copying %s to %s" filename newname) + + (if (and t1 t2 (tramp-equal-remote filename newname)) + (let ((l1 (file-remote-p filename 'localname)) + (l2 (file-remote-p newname 'localname))) + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + ;; We must also flush the cache of the directory, + ;; because `file-attributes' reads the values from + ;; there. + (tramp-flush-file-property v (file-name-directory l2)) + (tramp-flush-file-property v l2) + ;; Short track. + (tramp-adb-barf-unless-okay + v (format + "cp -f %s %s" + (tramp-shell-quote-argument l1) + (tramp-shell-quote-argument l2)) + "Error copying %s to %s" filename newname)) + + (let ((tmpfile (file-local-copy filename))) + + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname + (expand-file-name + (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + ;; We must also flush the cache of the directory, + ;; because `file-attributes' reads the values from + ;; there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (when (tramp-adb-execute-adb-command + v "push" + (tramp-compat-file-name-unquote filename) + (tramp-compat-file-name-unquote localname)) + (tramp-error + v 'file-error + "Cannot copy `%s' `%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-adb-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -736,10 +768,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and t1 t2 (tramp-equal-remote filename newname) (not (file-directory-p filename))) - (let ((l1 (tramp-file-name-handler - 'file-remote-p filename 'localname)) - (l2 (tramp-file-name-handler - 'file-remote-p newname 'localname))) + (let ((l1 (file-remote-p filename 'localname)) + (l2 (file-remote-p newname 'localname))) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) @@ -751,11 +781,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-flush-file-property v l2) ;; Short track. (tramp-adb-barf-unless-okay - v (format "mv %s %s" l1 l2) + v (format + "mv -f %s %s" + (tramp-shell-quote-argument l1) + (tramp-shell-quote-argument l2)) "Error renaming %s to %s" filename newname)) ;; Rename by copy. - (copy-file filename newname ok-if-already-exists t t) + (copy-file + filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (delete-file filename)))))) (defun tramp-adb-handle-process-file @@ -856,12 +890,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -904,7 +933,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 @@ -941,9 +970,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (current-buffer)))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (tramp-compat-funcall 'display-message-or-buffer output-buffer) - (pop-to-buffer output-buffer)))))))) + (display-message-or-buffer output-buffer))))))) ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once @@ -956,20 +983,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) @@ -1008,7 +1037,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; process. We ignore errors, because the process ;; could have finished already. (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t) + (set-process-query-on-exit-flag p t) (set-marker (process-mark p) (point))) ;; Return process. p)))) @@ -1035,7 +1064,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (host (tramp-file-name-host vec)) (port (tramp-file-name-port vec)) (devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))) - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string tramp-prefix-port-format ":" (cond ((member host devices) host) ;; This is the case when the host is connected to the default port. @@ -1051,7 +1080,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (not (zerop (length host))) (not (tramp-adb-execute-adb-command vec "connect" - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string tramp-prefix-port-format ":" host)))) ;; When new device connected, running other adb command (e.g. ;; adb shell) immediately will fail. To get around this @@ -1065,7 +1094,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 @@ -1102,8 +1131,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 @@ -1182,8 +1210,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)) @@ -1202,10 +1229,10 @@ 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) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; Check whether the properties have been changed. If ;; yes, this is a strong indication that we must expire all @@ -1250,7 +1277,10 @@ connection if a previous connection has died for some reason." ;; Read the expression. (goto-char (point-min)) (read (current-buffer))) - ":" 'omit-nulls)) + ":" '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 26825ffa2dd..0d90017651b 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -72,31 +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 - (cond - ;; GNU Emacs. - ((and (fboundp 'locate-user-emacs-file)) - (expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp"))) - ((and (boundp 'user-emacs-directory) - (stringp (symbol-value 'user-emacs-directory)) - (file-directory-p (symbol-value 'user-emacs-directory))) - (expand-file-name "tramp" (symbol-value 'user-emacs-directory))) - ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/")) - "~/.emacs.d/tramp") - ;; XEmacs. - ((and (boundp 'user-init-directory) - (stringp (symbol-value 'user-init-directory)) - (file-directory-p (symbol-value 'user-init-directory))) - (expand-file-name "tramp" (symbol-value 'user-init-directory))) - ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/")) - "~/.xemacs/tramp") - ;; For users without `~/.emacs.d/' or `~/.xemacs/'. - (t "~/.tramp")) + (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.") @@ -122,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) @@ -155,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) @@ -174,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) @@ -203,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 @@ -241,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) @@ -250,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) @@ -276,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) @@ -307,19 +309,14 @@ KEY identifies the connection, it is either a process or a vector." (maphash (lambda (key value) ;; Remove text properties from KEY and VALUE. - ;; `substring-no-properties' does not exist in XEmacs. - (when (functionp 'substring-no-properties) - (when (vectorp key) - (dotimes (i (length key)) - (when (stringp (aref key i)) - (aset key i - (tramp-compat-funcall - 'substring-no-properties (aref key i)))))) - (when (stringp key) - (setq key (tramp-compat-funcall 'substring-no-properties key))) - (when (stringp value) - (setq value - (tramp-compat-funcall 'substring-no-properties value)))) + (when (vectorp key) + (dotimes (i (length key)) + (when (stringp (aref key i)) + (aset key i (substring-no-properties (aref key i)))))) + (when (stringp key) + (setq key (substring-no-properties key))) + (when (stringp value) + (setq value (substring-no-properties value))) ;; Dump. (let ((tmp (format "(%s %s)" @@ -338,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))) @@ -375,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 @@ -418,8 +416,8 @@ for all methods. Resulting data are derived from connection history." ;; When "emacs -Q" has been called, both variables are nil. ;; We do not load the persistency file then, in order to ;; have a clean test environment. - (or (and (boundp 'init-file-user) (symbol-value 'init-file-user)) - (and (boundp 'site-run-file) (symbol-value 'site-run-file)))) + (or init-file-user + site-run-file)) (condition-case err (with-temp-buffer (insert-file-contents tramp-persistency-file-name) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index e7901bb7861..208859dbe7f 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -31,6 +31,9 @@ (require 'tramp) ;; Pacify byte-compiler. +(declare-function mml-mode "mml") +(declare-function mml-insert-empty-tag "mml") +(declare-function reporter-dump-variable "reporter") (defvar reporter-eval-buffer) (defvar reporter-prompt-for-summary-p) @@ -98,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. @@ -128,7 +131,7 @@ This includes password cache, file cache, connection cache, buffers." (setq tramp-locked nil) ;; Flush password cache. - (tramp-compat-funcall 'password-reset) + (password-reset) ;; Flush file and connection cache. (clrhash tramp-cache-data) @@ -142,7 +145,7 @@ This includes password cache, file cache, connection cache, buffers." "Kill all remote buffers." (interactive) - ;; Remove all Tramp related buffers. + ;; Remove all Tramp related connections. (tramp-cleanup-all-connections) ;; Remove all buffers with a remote default-directory. @@ -166,7 +169,6 @@ This includes password cache, file cache, connection cache, buffers." (defun tramp-bug () "Submit a bug report to the Tramp developers." (interactive) - (require 'reporter) (catch 'dont-send (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report @@ -185,17 +187,17 @@ This includes password cache, file cache, connection cache, buffers." backup-by-copying-when-mismatch backup-by-copying-when-privileged-mismatch backup-directory-alist - bkup-backup-directory-info 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))))) 'tramp-load-report-modules ; pre-hook 'tramp-append-tramp-buffers ; post-hook - (tramp-compat-funcall - (if (functionp 'propertize) 'propertize 'progn) + (propertize "\n" 'display "\ Enter your bug report in this message, including as much detail as you possibly can about the problem, what you did to cause it @@ -243,7 +245,7 @@ buffer in your bug report. (base64-encode-string (encode-coding-string val 'raw-text))))))) ;; Dump variable. - (tramp-compat-funcall 'reporter-dump-variable varsym mailbuf) + (reporter-dump-variable varsym mailbuf) (unless (hash-table-p val) ;; Remove string quotation. @@ -264,15 +266,8 @@ buffer in your bug report. (defun tramp-load-report-modules () "Load needed modules for reporting." - ;; We load message.el and mml.el from Gnus. - (if (featurep 'xemacs) - (progn - (load "message" 'noerror) - (load "mml" 'noerror)) - (require 'message nil 'noerror) - (require 'mml nil 'noerror)) - (tramp-compat-funcall 'message-mode) - (tramp-compat-funcall 'mml-mode t)) + (message-mode) + (mml-mode t)) (defun tramp-append-tramp-buffers () "Append Tramp buffers and buffer local variables into the bug report." @@ -301,9 +296,9 @@ 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<)) - (tramp-compat-funcall 'reporter-dump-variable varsym elbuf)) + (reporter-dump-variable varsym elbuf)) (lisp-indent-line) (insert ")\n")) (insert-buffer-substring elbuf))) @@ -313,7 +308,7 @@ buffer in your bug report. (ignore-errors (mapc (lambda (x) (when (string-match "tramp" x) (insert x "\n"))) - (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n"))) + (split-string (list-load-path-shadows t) "\n"))) ;; Append buffers only when we are in message mode. (when (and @@ -322,7 +317,7 @@ buffer in your bug report. (symbol-value 'mml-mode)) (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") - (buffer-list (tramp-compat-funcall 'tramp-list-tramp-buffers)) + (buffer-list (tramp-list-tramp-buffers)) (curbuf (current-buffer))) ;; There is at least one Tramp buffer. @@ -352,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) @@ -364,13 +359,13 @@ the debug buffer(s).") (kill-buffer nil) (switch-to-buffer curbuf) (goto-char (point-max)) - (insert (tramp-compat-funcall 'propertize "\n" 'display "\n\ + (insert (propertize "\n" 'display "\n\ This is a special notion of the `gnus/message' package. If you use another mail agent (by copying the contents of this buffer) please ensure that the buffers are attached to your email.\n\n")) (dolist (buffer buffer-list) - (tramp-compat-funcall - 'mml-insert-empty-tag 'part 'type "text/plain" + (mml-insert-empty-tag + 'part 'type "text/plain" 'encoding "base64" 'disposition "attachment" 'buffer buffer 'description buffer)) (set-buffer-modified-p nil)) @@ -391,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 44923aee895..9b779a0566b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,9 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 24. This -;; package provides compatibility functions for Emacs 22, Emacs 23, -;; XEmacs 21.4+ and SXEmacs 22. +;; Tramp's main Emacs version for development is Emacs 26. This +;; package provides compatibility functions for Emacs 23, Emacs 24 and +;; Emacs 25. ;;; Code: @@ -33,164 +33,59 @@ (eval-when-compile (require 'cl)) -(eval-and-compile - - ;; GNU Emacs 22. - (unless (fboundp 'ignore-errors) - (load "cl" 'noerror) - (load "cl-macs" 'noerror)) - - ;; Some packages must be required for XEmacs, because we compile - ;; with -no-autoloads. - (when (featurep 'xemacs) - (require 'cus-edit) - (require 'env) - (require 'executable) - (require 'outline) - (require 'passwd) - (require 'pp) - (require 'regexp-opt) - (require 'time-date)) - - (require 'advice) - (require 'custom) - (require 'format-spec) - (require 'shell) - ;; Introduced in Emacs 23.2. - (require 'ucs-normalize nil 'noerror) - - (require 'trampver) - (require 'tramp-loaddefs) - - ;; As long as password.el is not part of (X)Emacs, it shouldn't be - ;; mandatory. - (if (featurep 'xemacs) - (load "password" 'noerror) - (or (require 'password-cache nil 'noerror) - (require 'password nil 'noerror))) ; Part of contrib. - - ;; auth-source is relatively new. - (if (featurep 'xemacs) - (load "auth-source" 'noerror) - (require 'auth-source nil 'noerror)) - - ;; Load the appropriate timer package. - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer)) - - ;; Avoid byte-compiler warnings if the byte-compiler supports this. - ;; Currently, XEmacs supports this. - (when (featurep 'xemacs) - (unless (boundp 'byte-compile-default-warnings) - (defvar byte-compile-default-warnings nil)) - (delq 'unused-vars byte-compile-default-warnings)) - - ;; `last-coding-system-used' is unknown in XEmacs. - (unless (boundp 'last-coding-system-used) - (defvar last-coding-system-used nil)) - - ;; `directory-sep-char' is an obsolete variable in Emacs. But it is - ;; used in XEmacs, so we set it here and there. The following is - ;; needed to pacify Emacs byte-compiler. - ;; Note that it was removed altogether in Emacs 24.1. - (when (boundp 'directory-sep-char) - (defvar byte-compile-not-obsolete-var nil) - (setq byte-compile-not-obsolete-var 'directory-sep-char) - ;; Emacs 23.2. - (defvar byte-compile-not-obsolete-vars nil) - (setq byte-compile-not-obsolete-vars '(directory-sep-char))) - - ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1. - ;; Besides t, nil, and integer, we use also timestamps (as - ;; returned by `current-time') internally. - (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. - (defmacro tramp-compat-funcall (function &rest arguments) - (if (featurep 'xemacs) - `(funcall (symbol-function ,function) ,@arguments) - `(when (or (subrp ,function) (functionp ,function)) - (with-no-warnings (funcall ,function ,@arguments))))) - - ;; `set-buffer-multibyte' comes from Emacs Leim. - (unless (fboundp 'set-buffer-multibyte) - (defalias 'set-buffer-multibyte 'ignore)) - - ;; The following functions cannot be aliases of the corresponding - ;; `tramp-handle-*' functions, because this would bypass the locking - ;; mechanism. - - ;; `process-file' does not exist in XEmacs. - (unless (fboundp 'process-file) - (defalias 'process-file - (lambda (program &optional infile buffer display &rest args) - (when (tramp-tramp-file-p default-directory) - (apply - 'tramp-file-name-handler - 'process-file program infile buffer display args))))) - - ;; `start-file-process' is new in Emacs 23. - (unless (fboundp 'start-file-process) - (defalias 'start-file-process - (lambda (name buffer program &rest program-args) - (when (tramp-tramp-file-p default-directory) - (apply - 'tramp-file-name-handler - 'start-file-process name buffer program program-args))))) - - ;; `set-file-times' is also new in Emacs 23. - (unless (fboundp 'set-file-times) - (defalias 'set-file-times - (lambda (filename &optional time) - (when (tramp-tramp-file-p filename) - (tramp-compat-funcall - 'tramp-file-name-handler 'set-file-times filename time))))) - - ;; We currently use "[" and "]" in the filename format for IPv6 - ;; hosts of GNU Emacs. This means that Emacs wants to expand - ;; wildcards if `find-file-wildcards' is non-nil, and then barfs - ;; because no expansion could be found. We detect this situation - ;; and do something really awful: we have `file-expand-wildcards' - ;; return the original filename if it can't expand anything. Let's - ;; just hope that this doesn't break anything else. - ;; It is not needed anymore since GNU Emacs 23.2. - (unless (or (featurep 'xemacs) - ;; `featurep' has only one argument in XEmacs. - (funcall 'featurep 'files 'remote-wildcards)) - (defadvice file-expand-wildcards +(require 'auth-source) +(require 'advice) +(require 'custom) +(require 'format-spec) +(require 'parse-time) +(require 'password-cache) +(require 'shell) +(require 'timer) +(require 'ucs-normalize) + +(require 'trampver) +(require 'tramp-loaddefs) + +;; `remote-file-name-inhibit-cache' has been introduced with Emacs +;; 24.1. Besides t, nil, and integer, we use also timestamps (as +;; returned by `current-time') internally. +(unless (boundp 'remote-file-name-inhibit-cache) + (defvar remote-file-name-inhibit-cache nil)) + +;; 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) + "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 +;; of GNU Emacs. This means that Emacs wants to expand wildcards if +;; `find-file-wildcards' is non-nil, and then barfs because no +;; expansion could be found. We detect this situation and do +;; something really awful: we have `file-expand-wildcards' return the +;; original filename if it can't expand anything. Let's just hope +;; that this doesn't break anything else. It is not needed anymore +;; since GNU Emacs 23.2. +(unless (featurep 'files 'remote-wildcards) + (defadvice file-expand-wildcards (around tramp-advice-file-expand-wildcards activate) - (let ((name (ad-get-arg 0))) - ;; If it's a Tramp file, look if wildcards need to be expanded - ;; at all. - (if (and - (tramp-tramp-file-p name) - (not (string-match - "[[*?]" (tramp-compat-funcall - 'file-remote-p name 'localname)))) - (setq ad-return-value (list name)) - ;; Otherwise, just run the original function. - ad-do-it))) - (add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice - 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) - (ad-activate 'file-expand-wildcards)))) - - ;; `redisplay' does not exist in XEmacs. - (unless (fboundp 'redisplay) - (defalias 'redisplay 'ignore))) - -;; `with-temp-message' does not exist in XEmacs. -(if (fboundp 'with-temp-message) - (defalias 'tramp-compat-with-temp-message 'with-temp-message) - (defmacro tramp-compat-with-temp-message (_message &rest body) - "Display MESSAGE temporarily if non-nil while BODY is evaluated." - `(progn ,@body))) + (let ((name (ad-get-arg 0))) + ;; If it's a Tramp file, look if wildcards need to be expanded + ;; at all. + (if (and + (tramp-tramp-file-p name) + (not (string-match "[[*?]" (file-remote-p name 'localname)))) + (setq ad-return-value (list name)) + ;; Otherwise, just run the original function. + ad-do-it))) + (add-hook + 'tramp-unload-hook + (lambda () + (ad-remove-advice + 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) + (ad-activate 'file-expand-wildcards)))) ;; `condition-case-unless-debug' is introduced with Emacs 24. (if (fboundp 'condition-case-unless-debug) @@ -208,110 +103,34 @@ (funcall ,bodysym) ,@handlers)))))) -;; `font-lock-add-keywords' does not exist in XEmacs. -(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how) - "Add highlighting KEYWORDS for MODE." - (ignore-errors - (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) - (defsubst tramp-compat-temporary-file-directory () - "Return name of directory for temporary files (compat function). -For Emacs, this is the variable `temporary-file-directory', for XEmacs -this is the function `temp-directory'." - (let (file-name-handler-alist) - ;; We must return a local directory. If it is remote, we could - ;; run into an infloop. - (cond - ((and (boundp 'temporary-file-directory) - (eval (car (get 'temporary-file-directory 'standard-value))))) - ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) - ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TEMP"))) - ((let ((d (getenv "TMP"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TMP"))) - ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d))) - (file-name-as-directory (getenv "TMPDIR"))) - ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp")) - (t (message (concat "Neither `temporary-file-directory' nor " - "`temp-directory' is defined -- using /tmp.")) - (file-name-as-directory "/tmp"))))) - -;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own -;; implementation with `make-temp-name', creating the temporary file -;; immediately in order to avoid a security hole. + "Return name of directory for temporary files. +It is the default value of `temporary-file-directory'." + ;; We must return a local directory. If it is remote, we could run + ;; into an infloop. + (eval (car (get 'temporary-file-directory 'standard-value)))) + (defsubst tramp-compat-make-temp-file (f &optional dir-flag) - "Create a temporary file (compat function). + "Create a local temporary file (compat function). Add the extension of F, if existing." (let* (file-name-handler-alist (prefix (expand-file-name (symbol-value 'tramp-temp-name-prefix) (tramp-compat-temporary-file-directory))) - (extension (file-name-extension f t)) - result) - (condition-case nil - (setq result - (tramp-compat-funcall 'make-temp-file prefix dir-flag extension)) - (error - ;; We use our own implementation, taken from files.el. - (while - (condition-case () - (progn - (setq result (concat (make-temp-name prefix) extension)) - (if dir-flag - (make-directory result) - (write-region "" nil result nil 'silent)) - nil) - (file-already-exists t)) - ;; The file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil))) - result)) - -;; `most-positive-fixnum' does not exist in XEmacs. -(defsubst tramp-compat-most-positive-fixnum () - "Return largest positive integer value (compat function)." - (cond - ((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum)) - ;; Default value in XEmacs. - (t 134217727))) - -(defun tramp-compat-decimal-to-octal (i) - "Return a string consisting of the octal digits of I. -Not actually used. Use `(format \"%o\" i)' instead?" - (cond ((< i 0) (error "Cannot convert negative number to octal")) - ((not (integerp i)) (error "Cannot convert non-integer to octal")) - ((zerop i) "0") - (t (concat (tramp-compat-decimal-to-octal (/ i 8)) - (number-to-string (% i 8)))))) - -;; Kudos to Gerd Moellmann for this suggestion. -(defun tramp-compat-octal-to-decimal (ostr) - "Given a string of octal digits, return a decimal number." - (let ((x (or ostr ""))) - ;; `save-match' is in `tramp-mode-string-to-int' which calls this. - (unless (string-match "\\`[0-7]*\\'" x) - (error "Non-octal junk in string `%s'" x)) - (string-to-number ostr 8))) - -;; ID-FORMAT does not exist in XEmacs. -(defun tramp-compat-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp files (compat function)." - (cond - ((or (null id-format) (eq id-format 'integer)) - (file-attributes filename)) - ((tramp-tramp-file-p filename) - (tramp-compat-funcall - 'tramp-file-name-handler 'file-attributes filename id-format)) - (t (condition-case nil - (tramp-compat-funcall 'file-attributes filename id-format) - (wrong-number-of-arguments (file-attributes filename)))))) - -;; PRESERVE-UID-GID does not exist in XEmacs. + (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 @@ -320,21 +139,13 @@ Not actually used. Use `(format \"%o\" i)' instead?" 'copy-file filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) (wrong-number-of-arguments - (tramp-compat-copy-file + (copy-file filename newname ok-if-already-exists keep-date preserve-uid-gid)))) - (preserve-uid-gid - (condition-case nil - (tramp-compat-funcall - 'copy-file filename newname ok-if-already-exists keep-date - preserve-uid-gid) - (wrong-number-of-arguments - (tramp-compat-copy-file - filename newname ok-if-already-exists keep-date)))) (t - (copy-file filename newname ok-if-already-exists keep-date)))) + (copy-file + filename newname ok-if-already-exists keep-date preserve-uid-gid)))) -;; `copy-directory' is a new function in Emacs 23.2. Implementation -;; is taken from there. +;; COPY-CONTENTS has been introduced with Emacs 24.1. (defun tramp-compat-copy-directory (directory newname &optional keep-time parents copy-contents) "Make a copy of DIRECTORY (compat function)." @@ -372,8 +183,7 @@ Not actually used. Use `(format \"%o\" i)' instead?" (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)) @@ -401,59 +211,21 @@ Not actually used. Use `(format \"%o\" i)' instead?" (cond (trash (tramp-compat-funcall 'delete-directory directory recursive trash)) - (recursive - (tramp-compat-funcall 'delete-directory directory recursive)) (t - (delete-directory directory))) - ;; This Emacs version does not support the RECURSIVE or TRASH flag. We - ;; use the implementation from Emacs 23.2. + (delete-directory directory recursive))) + ;; This Emacs version does not support the TRASH flag. We use the + ;; 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)))) -;; MUST-SUFFIX doesn't exist on XEmacs. -(defun tramp-compat-load (file &optional noerror nomessage nosuffix must-suffix) - "Like `load' for Tramp files (compat function)." - (if must-suffix - (tramp-compat-funcall 'load file noerror nomessage nosuffix must-suffix) - (load file noerror nomessage nosuffix))) - -;; `number-sequence' does not exist in XEmacs. Implementation is -;; taken from Emacs 23. -(defun tramp-compat-number-sequence (from &optional to inc) - "Return a sequence of numbers from FROM to TO as a list (compat function)." - (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) - (tramp-compat-funcall 'number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - -(defun tramp-compat-split-string (string pattern) - "Like `split-string' but omit empty strings. -In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). -This is, the first, empty, element is omitted. In XEmacs, the first -element is not omitted." - (delete "" (split-string string pattern))) - (defun tramp-compat-process-running-p (process-name) "Returns t if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) @@ -466,7 +238,7 @@ element is not omitted." ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) (let (result) (dolist (pid (tramp-compat-funcall 'list-system-processes) result) - (let ((attributes (tramp-compat-funcall 'process-attributes pid))) + (let ((attributes (process-attributes pid))) (when (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) (let ((comm (cdr (assoc 'comm attributes)))) @@ -476,140 +248,137 @@ element is not omitted." (and comm (string-match (concat "^" (regexp-quote comm)) process-name)))) - (setq result t)))))) - - ;; Fallback, if there is no Lisp support yet. - (t (let ((default-directory - (if (tramp-tramp-file-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory)) - (unix95 (getenv "UNIX95")) - result) - (setenv "UNIX95" "1") - (when (member - (user-login-name) - (tramp-compat-split-string - (shell-command-to-string - (format "ps -C %s -o user=" process-name)) - "[ \f\t\n\r\v]+")) - (setq result t)) - (setenv "UNIX95" unix95) - result))))) - -;; The following functions do not exist in XEmacs. We ignore this; -;; they are used for checking a remote tty. -(defun tramp-compat-process-get (process propname) - "Return the value of PROCESS' PROPNAME property. -This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." - (ignore-errors (tramp-compat-funcall 'process-get process propname))) - -(defun tramp-compat-process-put (process propname value) - "Change PROCESS' PROPNAME property to VALUE. -It can be retrieved with `(process-get PROCESS PROPNAME)'." - (ignore-errors (tramp-compat-funcall 'process-put process propname value))) - -(defun tramp-compat-set-process-query-on-exit-flag (process flag) - "Specify if query is needed for process when Emacs is exited. -If the second argument flag is non-nil, Emacs will query the user before -exiting if process is running." - (if (fboundp 'set-process-query-on-exit-flag) - (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) - (tramp-compat-funcall 'process-kill-without-query process flag))) - -;; There exist different implementations for this function. -(defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) - "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. -EOL-TYPE can be one of `dos', `unix', or `mac'." - (cond ((fboundp 'coding-system-change-eol-conversion) - (tramp-compat-funcall - 'coding-system-change-eol-conversion coding-system eol-type)) - ((fboundp 'subsidiary-coding-system) - (tramp-compat-funcall - 'subsidiary-coding-system coding-system - (cond ((eq eol-type 'dos) 'crlf) - ((eq eol-type 'unix) 'lf) - ((eq eol-type 'mac) 'cr) - (t (error - "Unknown EOL-TYPE `%s', must be `dos', `unix', or `mac'" - eol-type))))) - (t (error "Can't change EOL conversion -- is MULE missing?")))) - -;; `replace-regexp-in-string' does not exist in XEmacs. -;; Implementation is taken from Emacs 24. -(if (fboundp 'replace-regexp-in-string) - (defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string) - (defun tramp-compat-replace-regexp-in-string - (regexp rep string &optional fixedcase literal subexp start) - "Replace all matches for REGEXP with REP in STRING. - -Return a new string containing the replacements. - -Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the -arguments with the same names of function `replace-match'. If START -is non-nil, start replacements at that index in STRING. - -REP is either a string used as the NEWTEXT arg of `replace-match' or a -function. If it is a function, it is called with the actual text of each -match, and its value is used as the replacement text. When REP is called, -the match data are the result of matching REGEXP against a substring -of STRING. - -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) - => \" bar foo\"" - - (let ((l (length string)) - (start (or start 0)) - matches str mb me) - (save-match-data - (while (and (< start l) (string-match regexp string start)) - (setq mb (match-beginning 0) - me (match-end 0)) - ;; If we matched the empty string, make sure we advance by one char - (when (= me mb) (setq me (min l (1+ mb)))) - ;; Generate a replacement for the matched substring. - ;; Operate only on the substring to minimize string consing. - ;; Set up match data for the substring for replacement; - ;; presumably this is likely to be faster than munging the - ;; match data directly in Lisp. - (string-match regexp (setq str (substring string mb me))) - (setq matches - (cons (replace-match (if (stringp rep) - rep - (funcall rep (match-string 0 str))) - fixedcase literal str subexp) - (cons (substring string start mb) ; unmatched prefix - matches))) - (setq start me)) - ;; Reconstruct a string from the pieces. - (setq matches (cons (substring string start l) matches)) ; leftover - (apply #'concat (nreverse matches)))))) + (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)) -;; `format-message' is new in Emacs 25, and does not exist in XEmacs. +;; `format-message' is new in Emacs 25. (unless (fboundp 'format-message) (defalias 'format-message 'format)) -;; `delete-dups' does not exist in XEmacs 21.4. -(if (fboundp 'delete-dups) - (defalias 'tramp-compat-delete-dups 'delete-dups) - (defun tramp-compat-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept." - (tramp-compat-funcall - 'cl-delete-duplicates list '(:test equal :from-end) nil))) +;; `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. +(eval-and-compile + (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 902b0a4ed86..20a12eb6936 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -39,15 +39,6 @@ (defvar ange-ftp-name-format) ;; Disable Ange-FTP from file-name-handler-alist. -;; To handle EFS, the following functions need to be dealt with: -;; -;; * dired-before-readin-hook contains efs-dired-before-readin -;; * file-name-handler-alist contains efs-file-handler-function -;; and efs-root-handler-function and efs-sifn-handler-function -;; * find-file-hooks contains efs-set-buffer-mode -;; -;; But it won't happen for EFS since the XEmacs maintainers -;; don't want to use a unified filename syntax. (defun tramp-disable-ange-ftp () "Turn Ange-FTP off. This is useful for unified remoting. See @@ -69,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 @@ -104,14 +96,15 @@ present for backward compatibility." ;; ... and add it to the method list. ;;;###tramp-autoload -(unless (featurep 'xemacs) - (add-to-list 'tramp-methods (cons tramp-ftp-method nil)) +(add-to-list 'tramp-methods (cons tramp-ftp-method nil)) - ;; Add some defaults for `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist - (list "\\`ftp\\." nil tramp-ftp-method)) - (add-to-list 'tramp-default-method-alist - (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))) +;; Add some defaults for `tramp-default-method-alist'. +;;;###tramp-autoload +(add-to-list 'tramp-default-method-alist + (list "\\`ftp\\." nil tramp-ftp-method)) +;;;###tramp-autoload +(add-to-list 'tramp-default-method-alist + (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) ;; Add completion function for FTP method. ;;;###tramp-autoload @@ -195,9 +188,8 @@ pass to the OPERATION." tramp-ftp-method)) ;;;###tramp-autoload -(unless (featurep 'xemacs) - (add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) +(add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index dee8333e547..37aba59e12e 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 @@ -422,7 +465,6 @@ Every entry is a list (NAME ADDRESS).") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-gvfs-handle-expand-file-name) @@ -438,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) @@ -463,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) @@ -474,7 +518,8 @@ Every entry is a list (NAME ADDRESS).") (shell-command . ignore) (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (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) (write-region . tramp-gvfs-handle-write-region)) @@ -497,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)) @@ -562,8 +607,7 @@ will be traced by Tramp with trace level 6." (put 'with-tramp-dbus-call-method 'lisp-indent-function 2) (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. @@ -587,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 @@ -623,19 +667,19 @@ file names." (and t2 (not (tramp-gvfs-file-name-p newname)))) ;; We cannot copy or rename directly. + ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with + ;; Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and renamed + ;; in Emacs 24.3. (let ((tmpfile (tramp-compat-make-temp-file filename))) (cond (preserve-extended-attributes - (tramp-compat-funcall + (funcall file-operation filename tmpfile t keep-date preserve-uid-gid preserve-extended-attributes)) - (preserve-uid-gid - (tramp-compat-funcall - file-operation filename tmpfile t keep-date preserve-uid-gid)) (t - (tramp-compat-funcall - file-operation filename tmpfile t keep-date))) + (funcall + file-operation filename tmpfile t keep-date preserve-uid-gid))) (rename-file tmpfile newname ok-if-already-exists)) ;; Direct action. @@ -646,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)))) @@ -682,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)) @@ -693,30 +737,34 @@ file names." (tramp-gvfs-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)) - ;; Compat section. + ;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been + ;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and + ;; renamed in Emacs 24.3. (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) (t (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))) (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 @@ -762,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) @@ -787,127 +835,193 @@ 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 + (setq localname (tramp-compat-file-name-unquote localname)) + (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." @@ -921,81 +1035,24 @@ 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 t t) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) (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. - (tramp-compat-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." @@ -1024,14 +1081,14 @@ file names." (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p) (tramp-set-connection-property p "vector" v) - (tramp-compat-process-put p 'events events) - (tramp-compat-process-put p 'watch-name localname) - (tramp-compat-set-process-query-on-exit-flag p nil) + (process-put p 'events events) + (process-put p 'watch-name localname) + (set-process-query-on-exit-flag p nil) (set-process-filter p 'tramp-gvfs-monitor-file-process-filter) ;; 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)))) @@ -1039,7 +1096,7 @@ file names." (defun tramp-gvfs-monitor-file-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ file-notify events." - (let* ((rest-string (tramp-compat-process-get proc 'rest-string)) + (let* ((rest-string (process-get proc 'rest-string)) (dd (with-current-buffer (process-buffer proc) default-directory)) (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) (when rest-string @@ -1047,7 +1104,7 @@ file-notify events." (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (tramp-compat-replace-regexp-in-string + string (replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (when (string-match "Monitoring not supported" string) (delete-process proc)) @@ -1060,7 +1117,7 @@ file-notify events." string) (let ((file (match-string 1 string)) (action (intern-soft - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "_" "-" (downcase (match-string 2 string)))))) (setq string (replace-match "" nil nil string)) ;; File names are returned as URL paths. We must convert them. @@ -1079,12 +1136,12 @@ file-notify events." ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (tramp-compat-process-put proc 'rest-string string))) + (process-put proc 'rest-string string))) (defun tramp-gvfs-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-executable-p" + (with-tramp-file-property v localname "file-readable-p" (tramp-check-cached-permissions v ?r)))) (defun tramp-gvfs-handle-file-writable-p (filename) @@ -1125,7 +1182,8 @@ file-notify events." (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) (tramp-gvfs-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) + 'rename filename newname ok-if-already-exists + 'keep-date 'preserve-uid-gid) (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) @@ -1133,8 +1191,7 @@ file-notify events." (start end filename &optional append visit lockname confirm) "Like `write-region' for Tramp files." (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) @@ -1161,7 +1218,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)) @@ -1174,6 +1233,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 @@ -1181,6 +1241,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)))) @@ -1203,8 +1265,7 @@ file-notify events." (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (tramp-compat-replace-regexp-in-string - "^.*/\\([^/]+\\)$" "\\1" object-path))) + (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) (defun tramp-bluez-address (device) "Return bluetooth device address from a given bluetooth DEVICE name." @@ -1293,7 +1354,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." ;; host signature. (with-temp-buffer ;; Preserve message for `progress-reporter'. - (tramp-compat-with-temp-message "" + (with-temp-message "" (insert message) (pop-to-buffer (current-buffer)) (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) @@ -1351,6 +1412,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)) @@ -1362,13 +1425,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 @@ -1436,6 +1499,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)) @@ -1447,12 +1512,13 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (string-equal user (or (tramp-file-name-user vec) "")) (string-equal host (tramp-file-name-host vec)) (string-match (concat "^" (regexp-quote prefix)) - (tramp-file-name-localname vec))) + (tramp-file-name-unquote-localname vec))) ;; Set prefix, mountpoint and location. (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) @@ -1470,10 +1536,10 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (domain (tramp-file-name-domain vec)) (host (tramp-file-name-real-host vec)) (port (tramp-file-name-port vec)) - (localname (tramp-file-name-localname vec)) + (localname (tramp-file-name-unquote-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 @@ -1493,6 +1559,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)))) @@ -1515,6 +1584,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 @@ -1532,26 +1639,26 @@ 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))) - (tramp-compat-set-process-query-on-exit-flag p nil))) + :server t :host 'local :service t :noquery t))) + (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) (let* ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) - (localname (tramp-file-name-localname vec)) + (localname (tramp-file-name-unquote-localname vec)) (object-path (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)) @@ -1619,30 +1726,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. @@ -1755,7 +1871,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." 'split-string (shell-command-to-string (format "avahi-browse -trkp %s" service)) "[\n\r]+" 'omit "^\\+;.*$")))) - (tramp-compat-delete-dups + (delete-dups (mapcar (lambda (x) (let* ((list (split-string x ";")) @@ -1776,35 +1892,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. @@ -1849,11 +1967,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 deleted file mode 100644 index f868bead09a..00000000000 --- a/lisp/net/tramp-gw.el +++ /dev/null @@ -1,336 +0,0 @@ -;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways - -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. - -;; Author: Michael Albinus <michael.albinus@gmx.de> -;; Keywords: comm, processes -;; Package: tramp - -;; 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: - -;; Access functions for HTTP tunnels and SOCKS gateways from Tramp. -;; SOCKS functionality is implemented by socks.el from the w3 package. -;; HTTP tunnels are partly implemented in socks.el and url-http.el; -;; both implementations are not complete. Therefore, it is -;; implemented in this package. - -;;; Code: - -(require 'tramp) - -;; Pacify byte-compiler. -(eval-when-compile - (require 'cl) - (require 'custom)) -(defvar socks-noproxy) - -;; We don't add the following methods to `tramp-methods', in order to -;; exclude them from file name completion. - -;; Define HTTP tunnel method ... -;;;###tramp-autoload -(defconst tramp-gw-tunnel-method "tunnel" - "Method to connect HTTP gateways.") - -;; ... and port. -(defconst tramp-gw-default-tunnel-port 8080 - "Default port for HTTP gateways.") - -;; Define SOCKS method ... -;;;###tramp-autoload -(defconst tramp-gw-socks-method "socks" - "Method to connect SOCKS servers.") - -;; ... and port. -(defconst tramp-gw-default-socks-port 1080 - "Default port for SOCKS servers.") - -;; Autoload the socks library. It is used only when we access a SOCKS server. -(autoload 'socks-open-network-stream "socks") -(defvar socks-username (user-login-name)) -(defvar socks-server - (list "Default server" "socks" tramp-gw-default-socks-port 5)) - -;; Add a default for `tramp-default-user-alist'. Default is the local user. -;;;###tramp-autoload -(add-to-list - 'tramp-default-user-alist - (list (concat "\\`" - (regexp-opt (list tramp-gw-tunnel-method tramp-gw-socks-method)) - "\\'") - nil (user-login-name))) - -;; Internal file name functions and variables. - -(defvar tramp-gw-vector nil - "Keeps the remote host identification. Needed for Tramp messages.") - -(defvar tramp-gw-gw-vector nil - "Current gateway identification vector.") - -(defvar tramp-gw-gw-proc nil - "Current gateway process.") - -;; This variable keeps the listening process, in order to reuse it for -;; new processes. -(defvar tramp-gw-aux-proc nil - "Process listening on local port, as mediation between SSH and the gateway.") - -(defun tramp-gw-gw-proc-sentinel (proc _event) - "Delete auxiliary process when we are deleted." - (unless (memq (process-status proc) '(run open)) - (tramp-message - tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) - (let* ((tramp-verbose 0) - (p (tramp-get-connection-property proc "process" nil))) - (when (processp p) (delete-process p))))) - -(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)) - ;; A new process has been spawned from `tramp-gw-aux-proc'. - (tramp-message - tramp-gw-vector 4 - "Opening auxiliary process `%s', speaking with process `%s'" - proc tramp-gw-gw-proc) - (tramp-compat-set-process-query-on-exit-flag proc nil) - ;; We don't want debug messages, because the corresponding debug - ;; buffer might be undecided. - (let ((tramp-verbose 0)) - (tramp-set-connection-property tramp-gw-gw-proc "process" proc) - (tramp-set-connection-property proc "process" tramp-gw-gw-proc)) - ;; Set the process-filter functions for both processes. - (set-process-filter proc 'tramp-gw-process-filter) - (set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter) - ;; There might be already some output from the gateway process. - (with-current-buffer (process-buffer tramp-gw-gw-proc) - (unless (= (point-min) (point-max)) - (let ((s (buffer-string))) - (delete-region (point) (point-max)) - (tramp-gw-process-filter tramp-gw-gw-proc s)))))) - -(defun tramp-gw-process-filter (proc string) - (let ((tramp-verbose 0)) - ;; The other process might have been stopped already. We don't - ;; want to be interrupted then. - (ignore-errors - (process-send-string - (tramp-get-connection-property proc "process" nil) string)))) - -;;;###tramp-autoload -(defun tramp-gw-open-connection (vec gw-vec target-vec) - "Open a remote connection to VEC (see `tramp-file-name' structure). -Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a -gateway method. TARGET-VEC identifies where to connect to via -the gateway, it can be different from VEC when there are more -hops to be applied. - -It returns a string like \"localhost#port\", which must be used -instead of the host name declared in TARGET-VEC." - - ;; Remember vectors for property retrieval. - (setq tramp-gw-vector 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))) - (let ((aux-vec - (vector "aux" (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec) nil nil))) - (setq tramp-gw-aux-proc - (make-network-process - :name (tramp-buffer-name aux-vec) :buffer nil :host 'local - :server t :noquery t :service t :coding 'binary)) - (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-aux-proc nil) - (tramp-message - vec 4 "Opening auxiliary process `%s', listening on port %d" - tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service)))) - - (let* ((gw-method - (intern - (tramp-find-method - (tramp-file-name-method gw-vec) - (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec)))) - (socks-username - (tramp-find-user - (tramp-file-name-method gw-vec) - (tramp-file-name-user gw-vec) - (tramp-file-name-host gw-vec))) - ;; Declare the SOCKS server to be used. - (socks-server - (list "Tramp temporary socks server list" - ;; Host name. - (tramp-file-name-real-host gw-vec) - ;; Port number. - (or (tramp-file-name-port gw-vec) - (case gw-method - (tunnel tramp-gw-default-tunnel-port) - (socks tramp-gw-default-socks-port))) - ;; Type. We support only http and socks5, NO socks4. - ;; 'http could be used when HTTP tunnel works in socks.el. - 5)) - ;; The function to be called. - (socks-function - (case gw-method - (tunnel 'tramp-gw-open-network-stream) - (socks 'socks-open-network-stream))) - socks-noproxy) - - ;; Open SOCKS process. - (setq tramp-gw-gw-proc - (funcall - socks-function - (let ((tramp-verbose 0)) (tramp-get-connection-name gw-vec)) - (let ((tramp-verbose 0)) (tramp-get-connection-buffer gw-vec)) - (tramp-file-name-real-host target-vec) - (tramp-file-name-port target-vec))) - (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel) - (set-process-coding-system tramp-gw-gw-proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil) - (tramp-message - vec 4 "Opened %s process `%s'" - (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS")) - tramp-gw-gw-proc) - - ;; Return the new host for gateway access. - (format "localhost#%d" (process-contact tramp-gw-aux-proc :service)))) - -(defun tramp-gw-open-network-stream (name buffer host service) - "Open stream to proxy server HOST:SERVICE. -Resulting process has name NAME and buffer BUFFER. If -authentication is requested from proxy server, provide it." - (let ((command (format (concat - "CONNECT %s:%d HTTP/1.1\r\n" - "Host: %s:%d\r\n" - "Connection: keep-alive\r\n" - "User-Agent: Tramp/%s\r\n") - host service host service tramp-version)) - (authentication "") - (first t) - found proc) - - (while (not found) - ;; Clean up. - (when (processp proc) (delete-process proc)) - (with-current-buffer buffer (erase-buffer)) - ;; Open network stream. - (setq proc (open-network-stream - name buffer (nth 1 socks-server) (nth 2 socks-server))) - (set-process-coding-system proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag proc nil) - ;; Send CONNECT command. - (process-send-string proc (format "%s%s\r\n" command authentication)) - (tramp-message - tramp-gw-vector 6 "\n%s" - (format - "%s%s\r\n" command - (tramp-compat-replace-regexp-in-string ;; no password in trace! - "Basic [^\r\n]+" "Basic xxxxx" authentication t))) - (with-current-buffer buffer - ;; Trap errors to be traced in the right trace buffer. Often, - ;; proxies have a timeout of 60". We wait 65" in order to - ;; receive an answer this case. - (ignore-errors - (let ((tramp-verbose 0)) - (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) - ;; Check return code. - (goto-char (point-min)) - (narrow-to-region - (point-min) - (or (search-forward-regexp "\r?\n\r?\n" nil t) (point-max))) - (tramp-message tramp-gw-vector 6 "\n%s" (buffer-string)) - (goto-char (point-min)) - (search-forward-regexp "^HTTP/[1-9]\\.[0-9]" nil t) - (case (condition-case nil (read (current-buffer)) (error)) - ;; Connected. - (200 (setq found t)) - ;; We need basic authentication. - (401 (setq authentication (tramp-gw-basic-authentication nil first))) - ;; Access forbidden. - (403 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Connection to %s:%d forbidden." host service)) - ;; Target host not found. - (404 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Host %s not found." host)) - ;; We need basic proxy authentication. - (407 (setq authentication (tramp-gw-basic-authentication t first))) - ;; Connection failed. - (503 (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Connection to %s:%d failed." host service)) - ;; That doesn't work at all. - (t (tramp-error-with-buffer - (current-buffer) tramp-gw-vector 'file-error - "Access to HTTP server %s:%d failed." - (nth 1 socks-server) (nth 2 socks-server)))) - ;; Remove HTTP headers. - (delete-region (point-min) (point-max)) - (widen) - (setq first nil))) - ;; Return the process. - proc)) - -(defun tramp-gw-basic-authentication (proxy pw-cache) - "Return authentication header for CONNECT, based on server request. -PROXY is an indication whether we need a Proxy-Authorization header -or an Authorization header. If PW-CACHE is non-nil, check for -password in password cache. This is done for the first try only." - - ;; `tramp-current-*' must be set for `tramp-read-passwd'. - (let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector)) - (tramp-current-user (tramp-file-name-user tramp-gw-gw-vector)) - (tramp-current-host (tramp-file-name-host tramp-gw-gw-vector))) - (unless pw-cache (tramp-clear-passwd tramp-gw-gw-vector)) - ;; We are already in the right buffer. - (tramp-message - tramp-gw-vector 5 "%s required" - (if proxy "Proxy authentication" "Authentication")) - ;; Search for request header. We accept only basic authentication. - (goto-char (point-min)) - (search-forward-regexp - "^\\(Proxy\\|WWW\\)-Authenticate:\\s-*Basic\\s-+realm=") - ;; Return authentication string. - (format - "%s: Basic %s\r\n" - (if proxy "Proxy-Authorization" "Authorization") - (base64-encode-string - (format - "%s:%s" - socks-username - (tramp-read-passwd - nil - (format - "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) - -(add-hook 'tramp-unload-hook - (lambda () - (unload-feature 'tramp-gw 'force))) - -(provide 'tramp-gw) - -;;; TODO: - -;; * Provide descriptive Commentary. -;; * Enable it for several gateway processes in parallel. - -;;; tramp-gw.el ends here diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 842b1ce2880..57cb6e11d21 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -32,9 +32,6 @@ (eval-when-compile (require 'cl) (require 'dired)) -(defvar directory-sep-char) -(defvar tramp-gw-tunnel-method) -(defvar tramp-gw-socks-method) (defvar vc-handled-backends) (defvar vc-bzr-program) (defvar vc-git-program) @@ -47,7 +44,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 @@ -55,7 +53,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" @@ -64,7 +63,8 @@ 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" @@ -81,11 +81,16 @@ the default storage location, e.g. \"$HOME/.sh_history\"." :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 +116,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. @@ -164,11 +170,7 @@ The string is used in `tramp-methods'.") (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("scpx" @@ -183,11 +185,7 @@ The string is used in `tramp-methods'.") (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("rsync" @@ -199,7 +197,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) @@ -229,11 +227,7 @@ The string is used in `tramp-methods'.") (tramp-async-args (("-q"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("sshx" @@ -243,11 +237,7 @@ The string is used in `tramp-methods'.") (tramp-async-args (("-q"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("telnet" @@ -255,8 +245,7 @@ The string is used in `tramp-methods'.") (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-default-port 23))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("nc" @@ -272,8 +261,7 @@ The string is used in `tramp-methods'.") ;; We use "-p" as required for newer busyboxes. For older ;; busybox/nc versions, the value must be (("-l") ("%r")). This ;; can be achieved by tweaking `tramp-connection-properties'. - (tramp-remote-copy-args (("-l") ("-p" "%r") ("2>/dev/null"))) - (tramp-default-port 23))) + (tramp-remote-copy-args (("-l") ("-p" "%r") ("2>/dev/null"))))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("su" @@ -284,6 +272,15 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) ;;;###tramp-autoload +(add-to-list + 'tramp-methods + '("sg" + (tramp-login-program "sg") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) +;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" (tramp-login-program "sudo") @@ -299,6 +296,14 @@ The string is used in `tramp-methods'.") (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods + '("doas" + (tramp-login-program "doas") + (tramp-login-args (("-u" "%u") ("-s"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) +;;;###tramp-autoload +(add-to-list 'tramp-methods '("ksu" (tramp-login-program "ksu") (tramp-login-args (("%u") ("-q"))) @@ -328,8 +333,7 @@ The string is used in `tramp-methods'.") ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods `("plinkx" @@ -361,8 +365,7 @@ The string is used in `tramp-methods'.") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("-p" "%k") ("-q") ("-r"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods `("psftp" @@ -379,9 +382,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t))) + ("-q"))) + (tramp-copy-keep-date t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("fcp" @@ -400,7 +402,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" (regexp-opt '("su" "sudo" "ksu")) "\\'") + `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'") nil "root")) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. @@ -446,12 +448,17 @@ The string is used in `tramp-methods'.") "Default list of (FUNCTION FILE) pairs to be examined for su methods.") ;;;###tramp-autoload +(defconst tramp-completion-function-alist-sg + '((tramp-parse-etc-group "/etc/group")) + "Default list of (FUNCTION FILE) pairs to be examined for sg methods.") + +;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty ,(if (memq system-type '(windows-nt)) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) - "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") + "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") ;;;###tramp-autoload (eval-after-load 'tramp @@ -470,7 +477,9 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet) (tramp-set-completion-function "su" tramp-completion-function-alist-su) (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) + (tramp-set-completion-function "doas" tramp-completion-function-alist-su) (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) + (tramp-set-completion-function "sg" tramp-completion-function-alist-sg) (tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) @@ -483,10 +492,11 @@ The string is used in `tramp-methods'.") ;; "getconf PATH" yields: ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin -;; GNU/Linux (Debian, Suse): /bin:/usr/bin +;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin ;; 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" @@ -515,11 +525,12 @@ the list by the special value `tramp-own-remote-path'." :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" @@ -533,8 +544,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")) @@ -551,7 +563,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) @@ -637,29 +650,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 @@ -987,10 +990,7 @@ of command line.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-sh-handle-directory-files-and-attributes) - ;; `dired-call-process' performed by default handler. (dired-compress-file . tramp-sh-handle-dired-compress-file) - (dired-recursive-delete-directory - . tramp-sh-handle-dired-recursive-delete-directory) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-sh-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) @@ -1005,6 +1005,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) @@ -1026,11 +1027,10 @@ of command line.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) - (insert-file-contents-literally - . tramp-sh-handle-insert-file-contents-literally) (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) @@ -1042,7 +1042,8 @@ 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) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (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) (write-region . tramp-sh-handle-write-region)) @@ -1123,7 +1124,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. @@ -1149,10 +1152,8 @@ target of the symlink differ." (format "tramp_perl_file_truename %s" (tramp-shell-quote-argument localname))))) - ;; Do it yourself. We bind `directory-sep-char' here for - ;; XEmacs on Windows, which would otherwise use backslash. - (t (let ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) + ;; Do it yourself. + (t (let ((steps (split-string localname "/" 'omit)) (thisstep nil) (numchase 0) ;; Don't make the following value larger than @@ -1170,14 +1171,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) @@ -1201,9 +1203,8 @@ target of the symlink differ." symlink-target)) (setq symlink-target localname)) (setq steps - (append (tramp-compat-split-string - symlink-target "/") - steps))) + (append + (split-string symlink-target "/" 'omit) steps))) (t ;; It's a file. (setq result (cons thisstep result))))) @@ -1220,6 +1221,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)))) @@ -1326,8 +1328,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))))) @@ -1356,8 +1360,8 @@ target of the symlink differ." res-gid ;; 4. Last access time, as a list of integers. Normally ;; this would be in the same format as `current-time', but - ;; the subseconds part is not currently implemented, and (0 - ;; 0) denotes an unknown time. + ;; the subseconds part is not currently implemented, and + ;; (0 0) denotes an unknown time. ;; 5. Last modification time, likewise. ;; 6. Last status change time, likewise. '(0 0) '(0 0) '(0 0) ;CCC how to find out? @@ -1371,8 +1375,7 @@ target of the symlink differ." ;; 10. Inode number. res-inode ;; 11. Device number. Will be replaced by a virtual device number. - -1 - )))))) + -1)))))) (defun tramp-do-file-attributes-with-perl (vec localname &optional id-format) @@ -1428,9 +1431,9 @@ 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)))) - (when (boundp 'last-coding-system-used) - (setq coding-system-used (symbol-value 'last-coding-system-used))) + (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'. (if (not (equal modtime '(0 0))) @@ -1444,8 +1447,7 @@ target of the symlink differ." (setq attr (buffer-substring (point) (point-at-eol)))) (tramp-set-file-property v localname "visited-file-modtime-ild" attr)) - (when (boundp 'last-coding-system-used) - (set 'last-coding-system-used coding-system-used)) + (setq last-coding-system-used coding-system-used) nil))))) ;; This function makes the same assumption as @@ -1464,12 +1466,12 @@ of." ;; connection. (if (or (not f) (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + (not (file-remote-p f nil 'connected))) t (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 @@ -1509,48 +1511,26 @@ of." ;; FIXME: extract the proper text from chmod's stderr. (tramp-barf-unless-okay v - (format "chmod %s %s" - (tramp-compat-decimal-to-octal mode) - (tramp-shell-quote-argument localname)) + (format "chmod %o %s" mode (tramp-shell-quote-argument localname)) "Error while changing file's mode %s" filename))) (defun tramp-sh-handle-set-file-times (filename &optional time) "Like `set-file-times' for Tramp files." - (if (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (when (tramp-get-remote-touch v) - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (let ((time (if (or (null time) (equal time '(0 0))) - (current-time) - time)) - ;; With GNU Emacs, `format-time-string' has an - ;; optional parameter ZONE. This is preferred, - ;; because we could handle the case when the remote - ;; host is located in a different time zone as the - ;; local host. - (utc (not (featurep 'xemacs)))) - (tramp-send-command-and-check - v (format - "%s %s %s %s" - (if utc "env TZ=UTC" "") - (tramp-get-remote-touch v) - (if (tramp-get-connection-property v "touch-t" nil) - (format "-t %s" - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time))) - "") - (tramp-shell-quote-argument localname)))))) - - ;; We handle also the local part, because in older Emacsen, - ;; without `set-file-times', this function is an alias for this. - ;; We are local, so we don't need the UTC settings. - (zerop - (tramp-call-process - nil "touch" nil nil nil "-t" - (format-time-string "%Y%m%d%H%M.%S" time) - (tramp-shell-quote-argument filename))))) + (with-parsed-tramp-file-name filename nil + (when (tramp-get-remote-touch v) + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time))) + (tramp-send-command-and-check + v (format + "env TZ=UTC %s %s %s" + (tramp-get-remote-touch v) + (if (tramp-get-connection-property v "touch-t" nil) + (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t)) + "") + (tramp-shell-quote-argument localname))))))) (defun tramp-set-file-uid-gid (filename &optional uid gid) "Set the ownership for FILENAME. @@ -1654,8 +1634,7 @@ be non-negative integers." (goto-char (point-max)) (delete-blank-lines) (when (> (point-max) (point-min)) - (tramp-compat-funcall - 'substring-no-properties (buffer-string)))))))) + (substring-no-properties (buffer-string)))))))) (defun tramp-sh-handle-set-file-acl (filename acl-string) "Like `set-file-acl' for Tramp files." @@ -1716,9 +1695,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 @@ -1770,9 +1756,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. @@ -1875,142 +1863,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. - (tramp-compat-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 (symbol-value - ;; `read-file-name-completion-ignore-case' - ;; is introduced with Emacs 22.1. - (if (boundp - 'read-file-name-completion-ignore-case) - 'read-file-name-completion-ignore-case - '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 @@ -2034,7 +1942,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) @@ -2048,7 +1957,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)) @@ -2059,19 +1968,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)) - ;; Compat section. + ;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been + ;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and + ;; renamed in Emacs 24.3. (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) (t (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))) (defun tramp-sh-handle-copy-directory (dirname newname &optional keep-date parents copy-contents) @@ -2126,13 +2034,14 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) (tramp-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) + 'rename filename newname ok-if-already-exists + 'keep-time 'preserve-uid-gid) (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) (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 @@ -2151,7 +2060,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))))) @@ -2262,7 +2172,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. @@ -2280,7 +2194,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") @@ -2290,14 +2205,8 @@ the uid and gid from FILENAME." v 'file-error "Unknown operation `%s', must be `copy' or `rename'" op)))) - (localname1 - (if t1 - (tramp-file-name-handler 'file-remote-p filename 'localname) - filename)) - (localname2 - (if t2 - (tramp-file-name-handler 'file-remote-p newname 'localname) - newname)) + (localname1 (if t1 (file-remote-p filename 'localname) filename)) + (localname2 (if t2 (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -2334,12 +2243,12 @@ the uid and gid from FILENAME." (zerop (logand (file-modes (file-name-directory localname1)) - (tramp-compat-octal-to-decimal "1000")))) + (string-to-number "1000" 8)))) (file-writable-p (file-name-directory localname2)) (or (file-directory-p localname2) (file-writable-p localname2)))) (if (eq op 'copy) - (tramp-compat-copy-file + (copy-file localname1 localname2 ok-if-already-exists keep-date preserve-uid-gid) (tramp-run-real-handler @@ -2379,25 +2288,21 @@ the uid and gid from FILENAME." ;; Since this does not work reliable, we also ;; give read permissions. (set-file-modes - (concat prefix tmpfile) - (tramp-compat-octal-to-decimal "0777")) + (concat prefix tmpfile) (string-to-number "0777" 8)) (tramp-set-file-uid-gid (concat prefix tmpfile) (tramp-get-local-uid 'integer) (tramp-get-local-gid 'integer))) (t2 (if (eq op 'copy) - (tramp-compat-copy-file - localname1 tmpfile t - keep-date preserve-uid-gid) + (copy-file + localname1 tmpfile t keep-date preserve-uid-gid) (tramp-run-real-handler - 'rename-file - (list localname1 tmpfile t))) + 'rename-file (list localname1 tmpfile t))) ;; We must change the ownership as local user. ;; Since this does not work reliable, we also ;; give read permissions. - (set-file-modes - tmpfile (tramp-compat-octal-to-decimal "0777")) + (set-file-modes tmpfile (string-to-number "0777" 8)) (tramp-set-file-uid-gid tmpfile (tramp-get-remote-uid v 'integer) @@ -2456,7 +2361,7 @@ The method used must be an out-of-band method." ;; Save exit. (ignore-errors (if dir-flag - (tramp-compat-delete-directory + (delete-directory (expand-file-name ".." tmpfile) 'recursive) (delete-file tmpfile))))) @@ -2468,35 +2373,22 @@ The method used must be an out-of-band method." v "login-as" nil)) tramp-current-host (tramp-file-name-real-host v)) - ;; Expand hops. Might be necessary for gateway methods. - (setq v (car (tramp-compute-multi-hops v))) - (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)))) - - ;; Check for host and port number. We cannot use - ;; `tramp-file-name-port', because this returns also - ;; `tramp-default-port', which might clash with settings in - ;; "~/.ssh/config". - (setq host (tramp-file-name-host v) - port "") - (when (string-match tramp-host-with-port-regexp host) - (setq port (string-to-number (match-string 2 host)) - host (string-to-number (match-string 1 host)))) + (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. + (setq host (tramp-file-name-real-host v) + port (tramp-file-name-port v)) ;; Check for user. There might be an interactive setting. (setq user (or (tramp-file-name-user v) @@ -2615,43 +2507,26 @@ 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) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; We must adapt `tramp-local-end-of-line' for ;; 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) @@ -2666,7 +2541,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) @@ -2677,7 +2555,7 @@ The method used must be an out-of-band method." (unless (eq op 'copy) (if (file-regular-p filename) (delete-file filename) - (tramp-compat-delete-directory filename 'recursive)))))) + (delete-directory filename 'recursive)))))) (defun tramp-sh-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -2717,51 +2595,16 @@ The method used must be an out-of-band method." ;; Dired. -;; CCC: This does not seem to be enough. Something dies when -;; we try and delete two directories under Tramp :/ -(defun tramp-sh-handle-dired-recursive-delete-directory (filename) - "Recursively delete the directory given. -This is like `dired-recursive-delete-directory' for Tramp files." - (with-parsed-tramp-file-name filename nil - ;; Run a shell command 'rm -r <localname>'. - ;; Code shamelessly stolen from the dired implementation and, um, hacked :) - (unless (file-exists-p filename) - (tramp-error v 'file-error "No such directory: %s" filename)) - ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>). - (tramp-send-command - v - (format "rm -rf %s" (tramp-shell-quote-argument localname)) - ;; Don't read the output, do it explicitly. - nil t) - ;; Wait for the remote system to return to us... - ;; This might take a while, allow it plenty of time. - (tramp-wait-for-output (tramp-get-connection-process v) 120) - ;; Make sure that it worked... - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) - (and (file-exists-p filename) - (tramp-error - v 'file-error "Failed to recursively delete %s" filename)))) +(defvar dired-compress-file-suffixes) +(declare-function dired-remove-file "dired-aux") -(defun tramp-sh-handle-dired-compress-file (file &rest _ok-flag) +(defun tramp-sh-handle-dired-compress-file (file) "Like `dired-compress-file' for Tramp files." - ;; OK-FLAG is valid for XEmacs only, but not implemented. ;; Code stolen mainly from dired-aux.el. (with-parsed-tramp-file-name file nil (tramp-flush-file-property v localname) (save-excursion - (let ((suffixes - (if (not (featurep 'xemacs)) - ;; Emacs case - (symbol-value 'dired-compress-file-suffixes) - ;; XEmacs has `dired-compression-method-alist', which is - ;; transformed into `dired-compress-file-suffixes' structure. - (mapcar - (lambda (x) - (list (concat (regexp-quote (nth 1 x)) "\\'") - nil - (mapconcat 'identity (nth 3 x) " "))) - (symbol-value 'dired-compression-method-alist)))) + (let ((suffixes dired-compress-file-suffixes) suffix) ;; See if any suffix rule matches this file name. (while suffixes @@ -2779,8 +2622,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat (nth 2 suffix) " " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (string-match (car suffix) file) (concat (substring file 0 (match-beginning 0)))))) (t @@ -2790,8 +2632,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat "gzip -f " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (cond ((file-exists-p (concat file ".gz")) (concat file ".gz")) ((file-exists-p (concat file ".z")) @@ -2810,6 +2651,8 @@ This is like `dired-recursive-delete-directory' for Tramp files." 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))) @@ -2895,15 +2738,14 @@ This is like `dired-recursive-delete-directory' for Tramp files." (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. (decode-coding-region beg (point-max) - (or file-name-coding-system - (and (boundp 'default-file-name-coding-system) - (symbol-value 'default-file-name-coding-system)))) + (or file-name-coding-system default-file-name-coding-system)) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) @@ -2930,7 +2772,7 @@ the result will be a local, non-Tramp, file name." ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler. + ;; If connection is not established yet, run the real handler. (if (not (tramp-connectable-p name)) (tramp-run-real-handler 'expand-file-name (list name nil)) ;; Dissect NAME. @@ -2966,13 +2808,10 @@ the result will be a local, non-Tramp, file name." (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). We bind - ;; `directory-sep-char' here for XEmacs on Windows, which would - ;; otherwise use backslash. `default-directory' is bound, - ;; because on Windows there would be problems with UNC shares or - ;; Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter @@ -2984,7 +2823,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) @@ -2997,7 +2836,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) @@ -3060,9 +2904,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) @@ -3099,7 +2940,7 @@ the result will be a local, non-Tramp, file name." ;; Send the command. (tramp-send-command v command nil t) ; nooutput ;; Check, whether a pty is associated. - (unless (tramp-compat-process-get + (unless (process-get (tramp-get-connection-process v) 'remote-tty) (tramp-error v 'file-error @@ -3109,7 +2950,7 @@ the result will be a local, non-Tramp, file name." ;; process. We ignore errors, because the process ;; could have finished already. (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t) + (set-process-query-on-exit-flag p t) (set-marker (process-mark p) (point))) ;; Return process. p)))) @@ -3241,12 +3082,7 @@ the result will be a local, non-Tramp, file name." ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -3259,10 +3095,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,7 +3109,7 @@ the result will be a local, non-Tramp, file name." ;; `copy-file' handles direct copy and out-of-band methods. ((or (tramp-local-host-p v) (tramp-method-out-of-band-p v size)) - (copy-file filename tmpfile t t)) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)) ;; Use inline encoding for file transfer. (rem-enc @@ -3333,30 +3170,6 @@ the result will be a local, non-Tramp, file name." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) -;; This is needed for XEmacs only. Code stolen from files.el. -(defun tramp-sh-handle-insert-file-contents-literally - (filename &optional visit beg end replace) - "Like `insert-file-contents-literally' for Tramp files." - (let ((format-alist nil) - (after-insert-file-functions nil) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil)) - (inhibit-file-name-handlers - '(epa-file-handler image-file-handler jka-compr-handler)) - (inhibit-file-name-operation 'insert-file-contents)) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (_filename) t)) - (insert-file-contents filename visit beg end replace)) - ;; Save exit. - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - ;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname confirm) @@ -3373,14 +3186,15 @@ the result will be a local, non-Tramp, file name." ;; (error ;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME")) - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (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 (tramp-compat-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 (tramp-compat-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) @@ -3438,9 +3252,7 @@ the result will be a local, non-Tramp, file name." (signal (car err) (cdr err)))) ;; Now, `last-coding-system-used' has the right value. Remember it. - (when (boundp 'last-coding-system-used) - (setq coding-system-used - (symbol-value 'last-coding-system-used)))) + (setq coding-system-used last-coding-system-used)) ;; The permissions of the temporary file should be set. If ;; FILENAME does not exist (eq modes nil) it has been @@ -3450,7 +3262,7 @@ the result will be a local, non-Tramp, file name." (when modes (set-file-modes tmpfile - (logior (or modes 0) (tramp-compat-octal-to-decimal "0400")))) + (logior (or modes 0) (string-to-number "0400" 8)))) ;; This is a bit lengthy due to the different methods ;; possible for file transfer. First, we check whether the @@ -3459,7 +3271,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 @@ -3590,14 +3403,14 @@ the result will be a local, non-Tramp, file name." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq visit t) (stringp visit)) - (let ((file-attr (tramp-compat-file-attributes filename 'integer))) + (let ((file-attr (file-attributes filename 'integer))) (set-visited-file-modtime ;; 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. @@ -3625,7 +3438,7 @@ the result will be a local, non-Tramp, file name." ;; any other remote command. (defun tramp-sh-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - (tramp-compat-with-temp-message "" + (with-temp-message "" (with-parsed-tramp-file-name file nil (with-tramp-progress-reporter v 3 (format-message "Checking `vc-registered' for %s" file) @@ -3782,7 +3595,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 @@ -3803,15 +3621,15 @@ 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'. - (tramp-compat-process-put p 'events events) - (tramp-compat-process-put p 'watch-name localname) - (tramp-compat-set-process-query-on-exit-flag p nil) + ;; Needed for process filter. + (process-put p 'events events) + (process-put p 'watch-name localname) + (set-process-query-on-exit-flag p nil) (set-process-filter p filter) ;; 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)))) @@ -3819,16 +3637,17 @@ 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 (tramp-compat-process-get proc 'rest-string))) + (rest-string (process-get proc 'rest-string))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (tramp-compat-replace-regexp-in-string + string (replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (when (string-match "Monitoring not supported" string) (delete-process proc)) @@ -3845,59 +3664,65 @@ file-notify events." (object (list proc - (intern-soft - (tramp-compat-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)) - (string-equal - file (tramp-compat-process-get proc 'watch-name))) + (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) (tramp-compat-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)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (tramp-compat-process-put proc 'rest-string string))) + (process-put proc 'rest-string string))) (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-nulls)) - ;; 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 - (tramp-compat-replace-regexp-in-string "_" "-" (downcase x)))) - (split-string (match-string 1 line) "," 'omit-nulls)) - (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: @@ -3913,7 +3738,7 @@ Only send the definition if it has not already been done." vec 5 (format-message "Sending script `%s'" name) ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names' ;; could result in unwanted command expansion. Avoid this. - (setq script (tramp-compat-replace-regexp-in-string + (setq script (replace-regexp-in-string (make-string 1 ?\t) (make-string 8 ? ) script)) ;; The script could contain a call of Perl. This is masked with `%s'. (when (and (string-match "%s" script) @@ -3986,8 +3811,7 @@ This function expects to be in the right *tramp* buffer." (setq result (concat "\\" progname)))) (unless result (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. In XEmacs, - ;; `remove' is in CL, and we want to avoid CL dependencies. + ;; Remove all ~/foo directories from dirlist. (let (newdl d) (while dirlist (setq d (car dirlist)) @@ -4107,7 +3931,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)) @@ -4139,7 +3964,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)) @@ -4243,41 +4068,32 @@ process to set up. VEC specifies the connection." ;; 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) - (if (featurep 'mule) - ;; 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)) - (tramp-compat-funcall '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)) - (setq cs-encode - (tramp-compat-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 (tramp-compat-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)) - (tramp-compat-funcall - 'set-buffer-process-coding-system cs-decode cs-encode) - (tramp-message - vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)) - ;; Look for ^M and do something useful if found. - (when (search-forward "\r" nil t) - ;; We have found a ^M but cannot frob the process coding - ;; system because we're running on a non-MULE Emacs. Let's - ;; try stty, instead. - (tramp-send-command vec "stty -onlcr" t)))) + ;; 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) @@ -4332,7 +4148,7 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) - (tramp-compat-process-put proc 'remote-tty tty))) + (process-put proc 'remote-tty tty))) ;; Dump stty settings in the traces. (when (>= tramp-verbose 9) @@ -4341,23 +4157,23 @@ process to set up. VEC specifies the connection." ;; 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 (tramp-compat-split-string (car env) "=")) - (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))) + (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) + (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 @@ -4535,8 +4351,7 @@ Goes through the list `tramp-local-coding-commands' and value (format-spec-make ?t - (tramp-file-name-handler - 'file-remote-p tmpfile 'localname))))) + (file-remote-p tmpfile 'localname))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -4657,8 +4472,7 @@ Goes through the list `tramp-inline-compress-commands'." vec 2 "Couldn't find an inline transfer compress command"))))) (defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'. -Gateway hops are already opened." + "Expands VEC according to `tramp-default-proxies-alist'." (let ((target-alist `(,vec)) (hops (or (tramp-file-name-hop vec) "")) (item vec) @@ -4715,32 +4529,6 @@ Gateway hops are already opened." ;; Start next search. (setq choices tramp-default-proxies-alist))))) - ;; Handle gateways. - (when (and (boundp 'tramp-gw-tunnel-method) (boundp 'tramp-gw-socks-method) - (string-match - (format - "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) - (tramp-file-name-method (car target-alist)))) - (let ((gw (pop target-alist)) - (hop (pop target-alist))) - ;; Is the method prepared for gateways? - (unless (tramp-file-name-port hop) - (tramp-error - vec 'file-error - "Connection `%s' is not supported for gateway access." hop)) - ;; Open the gateway connection. - (push - (vector - (tramp-file-name-method hop) (tramp-file-name-user hop) - (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil) - target-alist) - ;; For the password prompt, we need the correct values. - ;; Therefore, we must remember the gateway vector. But we - ;; cannot do it as connection property, because it shouldn't - ;; be persistent. And we have no started process yet either. - (let ((tramp-verbose 0)) - (tramp-set-file-property (car target-alist) "" "gateway" hop)))) - ;; Foreign and out-of-band methods are not supported for multi-hops. (when (cdr target-alist) (setq choices target-alist) @@ -4830,7 +4618,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 @@ -4851,9 +4639,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"))) @@ -4863,9 +4651,10 @@ 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. (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) @@ -4903,6 +4692,9 @@ connection if a previous connection has died for some reason." (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. @@ -4920,7 +4712,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. (tramp-set-connection-property p "vector" vec) (set-process-sentinel p 'tramp-process-sentinel) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) @@ -4951,13 +4743,6 @@ connection if a previous connection has died for some reason." (connection-timeout (tramp-get-method-parameter hop 'tramp-connection-timeout)) - (gw-args - (tramp-get-method-parameter hop 'tramp-gw-args)) - (gw (let ((tramp-verbose 0)) - (tramp-get-file-property hop "" "gateway" nil))) - (g-method (and gw (tramp-file-name-method gw))) - (g-user (and gw (tramp-file-name-user gw))) - (g-host (and gw (tramp-file-name-real-host gw))) (command login-program) ;; We don't create the temporary file. In ;; fact, it is just a prefix for the @@ -4981,12 +4766,6 @@ connection if a previous connection has died for some reason." (when (and process-name async-args) (setq login-args (append async-args login-args))) - ;; Add gateway arguments if necessary. - (when gw - (tramp-set-connection-property p "gateway" t) - (when gw-args - (setq login-args (append gw-args login-args)))) - ;; Check for port number. Until now, there's no ;; need for handling like method, user, host. (when (string-match tramp-host-with-port-regexp l-host) @@ -4999,11 +4778,10 @@ connection if a previous connection has died for some reason." (setq r-shell t))) ;; Set variables for computing the prompt for - ;; reading password. They can also be derived - ;; from a gateway. - (setq tramp-current-method (or g-method l-method) - tramp-current-user (or g-user l-user) - tramp-current-host (or g-host l-host)) + ;; reading password. + (setq tramp-current-method l-method + tramp-current-user l-user + tramp-current-host l-host) ;; Add login environment. (when login-env @@ -5054,7 +4832,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)) @@ -5062,6 +4843,9 @@ 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) @@ -5109,7 +4893,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 ...". @@ -5212,18 +5001,19 @@ 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) (tramp-compat-most-positive-fixnum))) + (<= (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) (tramp-compat-most-positive-fixnum))) + (<= (nth 3 attr) most-positive-fixnum)) (setcar (nthcdr 3 attr) (round (nth 3 attr)))) ;; Convert last access time. (unless (listp (nth 4 attr)) @@ -5244,7 +5034,7 @@ Return ATTR." (when (< (nth 7 attr) 0) (setcar (nthcdr 7 attr) -1)) (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 7 attr) most-positive-fixnum)) (setcar (nthcdr 7 attr) (round (nth 7 attr)))) ;; Convert file mode bits to string. (unless (stringp (nth 8 attr)) @@ -5296,7 +5086,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 + (directory-file-name (tramp-file-name-unquote-localname vec)))) (when (string-match tramp-ipv6-regexp host) (setq host (format "[%s]" host))) (unless (string-match "ftp$" method) @@ -5305,8 +5096,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)))))) + (format "%s@%s:%s" user host (shell-quote-argument localname))) + (t (format "%s:%s" host (shell-quote-argument localname)))))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." @@ -5324,6 +5115,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 @@ -5376,7 +5169,7 @@ Return ATTR." (when elt1 (setcdr elt1 (append - (tramp-compat-split-string (or default-remote-path "") ":") + (split-string (or default-remote-path "") ":" 'omit) (cdr elt1))) (setq remote-path (delq 'tramp-default-remote-path remote-path))) @@ -5384,7 +5177,7 @@ Return ATTR." (when elt2 (setcdr elt2 (append - (tramp-compat-split-string (or own-remote-path "") ":") + (split-string (or own-remote-path "") ":" 'omit) (cdr elt2))) (setq remote-path (delq 'tramp-own-remote-path remote-path))) @@ -5412,6 +5205,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")) @@ -5428,6 +5222,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 @@ -5453,6 +5248,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") @@ -5463,6 +5259,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") @@ -5471,6 +5268,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") @@ -5481,6 +5279,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") @@ -5488,6 +5287,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. @@ -5509,33 +5309,41 @@ 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 @@ -5556,6 +5364,7 @@ Return ATTR." 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 @@ -5566,11 +5375,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 @@ -5590,22 +5401,25 @@ Return ATTR." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (tramp-file-name-handler 'file-remote-p tmpfile 'localname)))) + (file-remote-p tmpfile 'localname)))) (delete-file tmpfile)) 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 @@ -5619,6 +5433,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" @@ -5628,6 +5443,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'" @@ -5637,6 +5453,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)) @@ -5644,6 +5461,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\"" @@ -5653,6 +5471,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 @@ -5665,11 +5485,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" @@ -5679,6 +5502,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'" @@ -5688,6 +5512,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\"" @@ -5697,6 +5522,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 @@ -5709,11 +5536,14 @@ 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. @@ -5776,18 +5606,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 @@ -5835,14 +5661,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 @@ -5864,21 +5694,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 509e2e388b8..70b72d82f54 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" @@ -224,7 +230,6 @@ See `tramp-actions-before-shell' for more info.") (directory-files . tramp-smb-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-smb-handle-expand-file-name) @@ -240,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) @@ -265,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) @@ -276,7 +283,8 @@ 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) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (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) (write-region . tramp-smb-handle-write-region)) @@ -291,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" @@ -299,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 -" @@ -307,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. @@ -380,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) @@ -419,15 +430,14 @@ pass to the OPERATION." (unwind-protect (progn (make-directory tmpdir) - (tramp-compat-copy-directory - dirname tmpdir keep-date 'parents) - (tramp-compat-copy-directory + (copy-directory dirname tmpdir keep-date 'parents) + (copy-directory (expand-file-name (file-name-nondirectory dirname) tmpdir) newname keep-date parents)) - (tramp-compat-delete-directory tmpdir 'recursive)))) + (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)))) @@ -448,7 +458,7 @@ pass to the OPERATION." (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) (localname (file-name-as-directory - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v)))) (tmpdir (make-temp-name (expand-file-name @@ -468,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 @@ -494,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)))) @@ -510,21 +525,24 @@ pass to the OPERATION." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (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)))) ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) (tramp-set-connection-property v "process-buffer" nil) - (when t1 (tramp-compat-delete-directory tmpdir 'recurse)))) + (when t1 (delete-directory tmpdir 'recurse)))) ;; 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 @@ -543,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." @@ -555,7 +573,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." 0 (format "Copying %s to %s" filename newname) (if (file-directory-p filename) - (tramp-compat-copy-directory filename newname keep-date t t) + (tramp-compat-copy-directory + filename newname keep-date 'parents 'copy-contents) (let ((tmpfile (file-local-copy filename))) (if tmpfile @@ -585,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) - (tramp-compat-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 @@ -664,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. - (tramp-compat-delete-dups result))) + result)) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -699,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) @@ -730,7 +751,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (domain (tramp-file-name-domain v)) (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) - (localname (tramp-compat-replace-regexp-in-string + (localname (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v))) (args (list (concat "//" real-host "/" share) "-E"))) @@ -744,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 @@ -765,11 +787,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-get-acl) (when (> (point-max) (point-min)) - (tramp-compat-funcall - 'substring-no-properties (buffer-string))))) + (substring-no-properties (buffer-string))))) ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) @@ -882,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 @@ -909,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))))) @@ -1009,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) @@ -1068,9 +1093,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-smb-send-command v (if (tramp-smb-get-cifs-capabilities v) - (format - "posix_mkdir \"%s\" %s" - file (tramp-compat-decimal-to-octal (default-file-modes))) + (format "posix_mkdir \"%s\" %o" file (default-file-modes)) (format "mkdir \"%s\"" file))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. @@ -1112,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")) @@ -1215,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)) @@ -1240,12 +1263,7 @@ target of the symlink differ." (unless outbuf (kill-buffer (tramp-get-connection-property v "process-buffer" nil))) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -1296,14 +1314,15 @@ target of the symlink differ." (tramp-error v2 'file-error "Cannot rename `%s'" filename)))) ;; We must rename via copy. - (tramp-compat-copy-file filename newname ok-if-already-exists t t t) + (copy-file + filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (if (file-directory-p filename) - (tramp-compat-delete-directory filename 'recursive) + (delete-directory filename 'recursive) (delete-file filename))))) (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) @@ -1325,10 +1344,10 @@ target of the symlink differ." (domain (tramp-file-name-domain v)) (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) - (localname (tramp-compat-replace-regexp-in-string + (localname (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v))) (args (list (concat "//" real-host "/" share) "-E" "-S" - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "\n" "," acl-string)))) (if (not (zerop (length real-user))) @@ -1341,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"))) @@ -1364,7 +1383,7 @@ target of the symlink differ." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-set-acl) (goto-char (point-max)) (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) @@ -1387,9 +1406,7 @@ target of the symlink differ." (when (tramp-smb-get-cifs-capabilities v) (tramp-flush-file-property v localname) (unless (tramp-smb-send-command - v (format "chmod \"%s\" %s" - (tramp-smb-get-localname v) - (tramp-compat-decimal-to-octal mode))) + v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode)) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -1399,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) @@ -1445,24 +1464,25 @@ 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) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) - confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) @@ -1505,7 +1525,7 @@ 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-file-name-unquote-localname vec))) (when (string-match "^/?\\([^/]+\\)/" localname) (match-string 1 localname))))) @@ -1513,7 +1533,7 @@ 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-file-name-unquote-localname vec))) (setq localname (if (string-match "^/?[^/]+\\(/.*\\)" localname) @@ -1575,10 +1595,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." ;; Add directory itself. (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; There's a very strange error (debugged with XEmacs 21.4.14) - ;; If there's no short delay, it returns nil. No idea about. - (when (featurep 'xemacs) (sleep-for 0.01)) - ;; Return entries. (delq nil res)))))) @@ -1717,7 +1733,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)))) @@ -1725,8 +1741,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 @@ -1738,14 +1753,13 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (member "pathnames" (split-string - (buffer-substring (point) (point-at-eol)) nil t))))))))) + (buffer-substring (point) (point-at-eol)) nil 'omit))))))))) (defun tramp-smb-get-stat-capability (vec) "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 \"/\"")))) @@ -1812,18 +1826,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. @@ -1878,7 +1891,7 @@ If ARGUMENT is non-nil, use it as argument for (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" vec) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; Set variables for computing the prompt for reading password. (setq tramp-current-method tramp-smb-method @@ -1916,6 +1929,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)) @@ -1954,7 +1970,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) @@ -1968,7 +1984,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) @@ -1992,7 +2008,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) @@ -2031,7 +2047,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 () @@ -2042,8 +2058,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 5d8081cd815..7b5f71a754f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -34,9 +34,7 @@ ;; Notes: ;; ----- ;; -;; This package only works for Emacs 22.1 and higher, and for XEmacs 21.4 -;; and higher. For XEmacs 21, you need the package `fsf-compat' for -;; the `with-timeout' macro. +;; This package only works for Emacs 23.1 and higher. ;; ;; Also see the todo list at the bottom of this file. ;; @@ -61,11 +59,7 @@ ;; Pacify byte-compiler. (eval-when-compile (require 'cl)) -(defvar bkup-backup-directory-info) -(defvar directory-sep-char) (defvar eshell-path-env) -(defvar ls-lisp-use-insert-directory-program) -(defvar outline-regexp) ;;; User Customizable Internal Variables: @@ -82,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. @@ -100,13 +95,11 @@ 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) -;; Emacs case. -(eval-and-compile - (when (boundp 'backup-directory-alist) - (defcustom tramp-backup-directory-alist nil - "Alist of filename patterns and backup directory names. +(defcustom tramp-backup-directory-alist nil + "Alist of filename patterns and backup directory names. Each element looks like (REGEXP . DIRECTORY), with the same meaning like in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY is a local file name, the backup directory is prepended with Tramp file @@ -116,34 +109,10 @@ name prefix \(method, user, host) of file. 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")))))) - -;; XEmacs case. We cannot check for `bkup-backup-directory-info', because -;; the package "backup-dir" might not be loaded yet. -(eval-and-compile - (when (featurep 'xemacs) - (defcustom tramp-bkup-backup-directory-info nil - "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...)) -It has the same meaning like `bkup-backup-directory-info' from package -`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local -file name, the backup directory is prepended with Tramp file name prefix -\(method, user, host) of file. - -\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info) - -gives the same backup policy for Tramp files on their hosts like the -policy for local files." - :type '(repeat - (list (regexp :tag "File regexp") - (string :tag "Backup Dir") - (set :inline t - (const ok-create) - (const full-path) - (const prepend-name) - (const search-upward)))) - :group 'tramp))) + :group 'tramp + :type '(repeat (cons (regexp :tag "Regexp matching filename") + (directory :tag "Backup directory name"))) + :require 'tramp) (defcustom tramp-auto-save-directory nil "Put auto-save files in this directory, if set. @@ -151,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 @@ -177,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" (or 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" (or 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 @@ -272,12 +241,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-copy-recursive' Whether the operation copies directories recursively. * `tramp-default-port' - The default port of a method is needed in case of gateway connections. - Additionally, it is used as indication which method is prepared for - passing gateways. - * `tramp-gw-args' - As the attribute name says, additional arguments are specified here - when a method is applied via a gateway. + The default port of a method. * `tramp-tmpdir' A directory on the remote host for temporary files. If not specified, \"/tmp\" is taken as default. @@ -286,6 +250,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, @@ -303,8 +272,7 @@ See the variables `tramp-local-coding-commands' and So, to summarize: if the method is an out-of-band method, then you must specify `tramp-copy-program' and `tramp-copy-args'. If it is an -inline method, then these two parameters should be nil. Methods which -are fit for gateways must have `tramp-default-port' at least. +inline method, then these two parameters should be nil. Notes: @@ -329,32 +297,17 @@ useful only in combination with `tramp-default-proxies-alist'.") ;; PuTTY is installed. We don't take it, if it is installed on a ;; non-windows system, or pscp from the pssh (parallel ssh) package ;; is found. - ((and (eq system-type 'windows-nt) - (executable-find "pscp")) - (if (or (fboundp 'password-read) - (fboundp 'auth-source-user-or-password) - (fboundp 'auth-source-search) - ;; Pageant is running. - (tramp-compat-process-running-p "Pageant")) - "pscp" - "plink")) + ((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp") ;; There is an ssh installation. - ((executable-find "scp") - (if (or (fboundp 'password-read) - (fboundp 'auth-source-user-or-password) - (fboundp 'auth-source-search) - ;; ssh-agent is running. - (getenv "SSH_AUTH_SOCK") - (getenv "SSH_AGENT_PID")) - "scp" - "ssh")) + ((executable-find "scp") "scp") ;; Fallback. (t "ftp")) "Default method to use for transferring files. 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 @@ -372,7 +325,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. @@ -381,7 +335,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 @@ -397,13 +352,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 @@ -420,7 +377,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. @@ -439,13 +397,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)) @@ -457,7 +417,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 @@ -482,6 +443,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists: * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files, * `tramp-parse-hosts' for \"/etc/hosts\" like files, * `tramp-parse-passwd' for \"/etc/passwd\" like files. + * `tramp-parse-etc-group' for \"/etc/group\" like files. * `tramp-parse-netrc' for \"~/.netrc\" like files. * `tramp-parse-putty' for PuTTY registered sessions. @@ -517,14 +479,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\\)\\( .*\\)?: *" @@ -533,7 +497,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 @@ -541,7 +506,7 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; regexp works only for GNU Emacs. ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. - (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)") + (concat "\\(?:^\\|\r\\)" "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*") "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' @@ -555,10 +520,12 @@ 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\\).*:\^@? *" + ;; `password-word-equivalents' has been introduced with Emacs 24.4. (if (boundp 'password-word-equivalents) (regexp-opt (symbol-value 'password-word-equivalents)) "password\\|passphrase")) @@ -568,7 +535,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 "^.*" @@ -592,7 +560,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 @@ -603,19 +572,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 "\\(" @@ -627,7 +599,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-*" @@ -636,18 +609,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 "" @@ -657,7 +633,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. @@ -677,29 +654,19 @@ Useful for \"rsync\" like methods.") (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) -;; XEmacs is distributed with few Lisp packages. Further packages are -;; installed using EFS. If we use a unified filename format, then -;; Tramp is required in addition to EFS. (But why can't Tramp just -;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS -;; just like before.) Another reason for using a separate filename -;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but -;; Tramp only knows how to deal with `file-name-handler-alist', not -;; the other places. - -;; Currently, we have the choice between 'ftp and 'sep. ;;;###autoload -(defcustom tramp-syntax - (if (featurep 'xemacs) 'sep 'ftp) +(defcustom tramp-syntax 'ftp "Tramp filename syntax to be used. It can have the following values: - `ftp' -- Ange-FTP respective EFS like syntax (GNU Emacs default) - `sep' -- Syntax as defined for XEmacs." + `ftp' -- Ange-FTP like syntax + `sep' -- Syntax as defined for XEmacs originally." :group 'tramp :version "24.4" - :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp) - (const :tag "XEmacs" sep))) + :type '(choice (const :tag "Ange-FTP" ftp) + (const :tag "XEmacs" sep)) + :require 'tramp) (defconst tramp-prefix-format (cond ((equal tramp-syntax 'ftp) "/") @@ -837,6 +804,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 @@ -847,7 +820,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 @@ -883,43 +856,30 @@ See also `tramp-file-name-regexp'.") "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):" "\\`/[^/|:][^/|]*:") "Value for `tramp-file-name-regexp' for unified remoting. -Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and -Tramp. See `tramp-file-name-structure' for more explanations. +See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") ;;;###autoload (defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "Value for `tramp-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. 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 (if (memq system-type '(cygwin windows-nt)) "\\`/[^/]\\{2,\\}\\'" "\\`/[^/]*\\'") "Value for `tramp-completion-file-name-regexp' for unified remoting. -GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") @@ -928,7 +888,6 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate "\\`/\\([[][^]]*\\)?\\'" "Value for `tramp-completion-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload @@ -951,10 +910,7 @@ Also see `tramp-file-name-structure'.") ;; to drop bytes when data is sent too quickly. There is also a connection ;; buffer local variable, which is computed depending on remote host properties ;; when `tramp-chunksize' is zero or nil. -(defcustom tramp-chunksize - (when (and (not (featurep 'xemacs)) - (memq system-type '(hpux))) - 500) +(defcustom tramp-chunksize (when (memq system-type '(hpux)) 500) ;; Parentheses in docstring starting at beginning of line are escaped. ;; Fontification is messed up when ;; `open-paren-in-column-0-is-defun-start' set to t. @@ -972,14 +928,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) @@ -1015,7 +971,8 @@ 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 has process-connection-type set to nil by default, @@ -1026,7 +983,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). @@ -1035,7 +993,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. @@ -1049,7 +1008,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. @@ -1061,7 +1021,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: @@ -1077,14 +1038,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 @@ -1095,12 +1057,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. @@ -1111,11 +1067,10 @@ If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' entry does not exist, return nil." (let ((hash-entry - (tramp-compat-replace-regexp-in-string - "^tramp-" "" (symbol-name param)))) + (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. - (tramp-get-connection-property vec hash-entry nil) + (tramp-get-connection-property vec hash-entry nil) ;; Use the static value from `tramp-methods'. (let ((methods-entry (assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) @@ -1178,33 +1133,33 @@ entry does not exist, return nil." (defun tramp-file-name-port (vec) "Return the port number of VEC." (save-match-data - (let ((method (tramp-file-name-method vec)) - (host (tramp-file-name-host vec))) + (let ((host (tramp-file-name-host vec))) (or (and (stringp host) (string-match tramp-host-with-port-regexp host) (string-to-number (match-string 2 host))) (tramp-get-method-parameter vec 'tramp-default-port))))) +;; The localname can be quoted with "/:". Extract this. +(defun tramp-file-name-unquote-localname (vec) + "Return unquoted localname component of VEC." + (tramp-compat-file-name-unquote (tramp-file-name-localname vec))) + ;;;###tramp-autoload (defun tramp-tramp-file-p (name) "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) @@ -1217,24 +1172,10 @@ 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. Not - ;; applicable for XEmacs. - (if (or method (null result) (null (functionp 'propertize))) + ;; We must mark, whether a default value has been used. + (if (or method (null result)) result - (tramp-compat-funcall 'propertize result 'tramp-default t)))) + (propertize result 'tramp-default t)))) (defun tramp-find-user (method user host) "Return the right user string to use. @@ -1252,11 +1193,10 @@ This is USER, if non-nil. Otherwise, do a lookup in (setq choices nil))) luser) tramp-default-user))) - ;; We must mark, whether a default value has been used. Not - ;; applicable for XEmacs. - (if (or user (null result) (null (functionp 'propertize))) + ;; We must mark, whether a default value has been used. + (if (or user (null result)) result - (tramp-compat-funcall 'propertize result 'tramp-default t)))) + (propertize result 'tramp-default t)))) (defun tramp-find-host (method user host) "Return the right host string to use. @@ -1281,13 +1221,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. @@ -1296,8 +1237,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)) @@ -1318,9 +1260,6 @@ values." (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." - ;; We must use `tramp-file-name-real-host', because for gateway - ;; methods the default port will be expanded later on, which would - ;; tamper the name. (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec))) @@ -1365,6 +1304,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 @@ -1394,11 +1338,17 @@ 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 - ;; methods the default port will be expanded later on, which would - ;; tamper the name. (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec))) @@ -1447,8 +1397,7 @@ ARGUMENTS to actually emit the message (if applicable)." (when (bobp) (insert (format - ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" - (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) + ";; Emacs: %s Tramp: %s -*- mode: outline; -*-" emacs-version tramp-version)) (when (>= tramp-verbose 10) (insert @@ -1481,13 +1430,12 @@ ARGUMENTS to actually emit the message (if applicable)." '("tramp-backtrace" "tramp-compat-condition-case-unless-debug" "tramp-compat-funcall" - "tramp-compat-with-temp-message" + "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))) @@ -1651,14 +1599,14 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) +(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) "")) - (tramp-compat-funcall 'progress-reporter-update reporter value)))) + (progress-reporter-update reporter value)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. @@ -1675,19 +1623,18 @@ without a visible progress reporter." ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) (ignore-errors - (let ((pr (tramp-compat-funcall - #'make-progress-reporter ,message))) + (let ((pr (make-progress-reporter ,message nil nil))) (when pr - (run-at-time 3 0.1 - #'tramp-progress-reporter-update pr))))))) + (run-at-time + 3 0.1 #'tramp-progress-reporter-update pr))))))) (unwind-protect ;; Execute the body. (prog1 (progn ,@body) (setq cookie "done")) ;; Stop progress reporter. - (if tm (tramp-compat-funcall 'cancel-timer tm)) + (if tm (cancel-timer tm)) (tramp-message ,vec ,level "%s...%s" ,message cookie))))) -(tramp-compat-font-lock-add-keywords +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) (defmacro with-tramp-file-property (vec file property &rest body) @@ -1706,8 +1653,7 @@ FILE must be a local file name on a connection identified via VEC." (put 'with-tramp-file-property 'lisp-indent-function 3) (put 'with-tramp-file-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) (defmacro with-tramp-connection-property (key property &rest body) "Check in Tramp for property PROPERTY, otherwise executes BODY and set." @@ -1722,7 +1668,7 @@ FILE must be a local file name on a connection identified via VEC." (put 'with-tramp-connection-property 'lisp-indent-function 2) (put 'with-tramp-connection-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) (defun tramp-drop-volume-letter (name) @@ -1732,9 +1678,13 @@ locally on a remote file name. When the local system is a W32 system but the remote system is Unix, this introduces a superfluous drive letter into the file name. This function removes it." (save-match-data - (if (string-match "\\`[a-zA-Z]:/" name) - (replace-match "/" nil t name) - name))) + (funcall + (if (tramp-compat-file-name-quoted-p name) + 'tramp-compat-file-name-quote 'identity) + (let ((name (tramp-compat-file-name-unquote name))) + (if (string-match "\\`[a-zA-Z]:/" name) + (replace-match "/" nil t name) + name))))) ;;; Config Manipulation Functions: @@ -1787,16 +1737,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) @@ -1806,28 +1757,22 @@ Adds another overlay hiding filename parts according to Tramp's special handling of `substitute-in-file-name'." (when (symbol-value 'minibuffer-completing-file-name) (setq tramp-rfn-eshadow-overlay - (tramp-compat-funcall - 'make-overlay - (tramp-compat-funcall 'minibuffer-prompt-end) - (tramp-compat-funcall 'minibuffer-prompt-end))) + (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) ;; Copy rfn-eshadow-overlay properties. - (let ((props (tramp-compat-funcall - 'overlay-properties (symbol-value 'rfn-eshadow-overlay)))) + (let ((props (overlay-properties (symbol-value 'rfn-eshadow-overlay)))) (while props ;; The `field' property prevents correct minibuffer ;; completion; we exclude it. (if (not (eq (car props) 'field)) - (tramp-compat-funcall - 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) + (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) (pop props) (pop props)))))) -(when (boundp 'rfn-eshadow-setup-minibuffer-hook) - (add-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer)))) +(add-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer))) (defconst tramp-rfn-eshadow-update-overlay-regexp (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) @@ -1839,15 +1784,13 @@ This is intended to be used as a minibuffer `post-command-hook' for been set up by `rfn-eshadow-setup-minibuffer'." ;; In remote files name, there is a shadowing just for the local part. (ignore-errors - (let ((end (or (tramp-compat-funcall - 'overlay-end (symbol-value 'rfn-eshadow-overlay)) - (tramp-compat-funcall 'minibuffer-prompt-end))) + (let ((end (or (overlay-end (symbol-value 'rfn-eshadow-overlay)) + (minibuffer-prompt-end))) ;; We do not want to send any remote command. (non-essential t)) (when (tramp-tramp-file-p - (tramp-compat-funcall - 'buffer-substring-no-properties end (point-max))) + (buffer-substring-no-properties end (point-max))) (save-excursion (save-restriction (narrow-to-region @@ -1859,17 +1802,15 @@ been set up by `rfn-eshadow-setup-minibuffer'." (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) (rfn-eshadow-update-overlay-hook nil) file-name-handler-alist) - (tramp-compat-funcall - 'move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))) - -(when (boundp 'rfn-eshadow-update-overlay-hook) - (add-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay)))) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay)))))))) + +(add-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay))) ;; Inodes don't exist for some file systems. Therefore we must ;; generate virtual ones. Used in `find-buffer-visiting'. The method @@ -1892,12 +1833,13 @@ been set up by `rfn-eshadow-setup-minibuffer'." If the file modes of FILENAME cannot be determined, return the value of `default-file-modes', without execute permissions." (or (file-modes filename) - (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) + (logand (default-file-modes) (string-to-number "0666" 8)))) (defun tramp-replace-environment-variables (filename) "Replace environment variables in FILENAME. Return the string with the replaced variables." (or (ignore-errors + ;; Optional arg has been introduced with Emacs 24 (?). (tramp-compat-funcall 'substitute-env-vars filename 'only-defined)) ;; We need an own implementation. (save-match-data @@ -1912,35 +1854,6 @@ Return the string with the replaced variables." t nil filename))) filename)))) -;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, -;; which calls corresponding functions (see minibuf.el). -(when (fboundp 'minibuffer-electric-separator) - (mapc - (lambda (x) - (eval - `(defadvice ,x - (around ,(intern (format "tramp-advice-%s" x)) activate) - "Invoke `substitute-in-file-name' for Tramp files." - (if (and (symbol-value 'minibuffer-electric-file-name-behavior) - (tramp-tramp-file-p (buffer-substring))) - ;; We don't need to handle `last-input-event', because - ;; due to the key map we know it must be ?/ or ?~. - (let ((s (concat (buffer-substring (point-min) (point)) - (string last-command-char)))) - (delete-region (point-min) (point)) - (insert (substitute-in-file-name s)) - (setq ad-return-value last-command-char)) - ad-do-it))) - (eval - `(add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x))) - (ad-activate ',x))))) - - '(minibuffer-electric-separator - minibuffer-electric-tilde))) - (defun tramp-find-file-name-coding-system-alist (filename tmpname) "Like `find-operation-coding-system' for Tramp filenames. Tramp's `insert-file-contents' and `write-region' work over @@ -2000,49 +1913,37 @@ ARGS are the arguments OPERATION has been called with." (cond ;; FILE resp DIRECTORY. ((member operation - (list 'access-file 'byte-compiler-base-file-name 'delete-directory - 'delete-file 'diff-latest-backup-file 'directory-file-name - 'directory-files 'directory-files-and-attributes - 'dired-compress-file 'dired-uncache - 'file-accessible-directory-p 'file-attributes - 'file-directory-p 'file-executable-p 'file-exists-p - 'file-local-copy 'file-modes - 'file-name-as-directory 'file-name-directory - 'file-name-nondirectory 'file-name-sans-versions - 'file-ownership-preserved-p 'file-readable-p - 'file-regular-p 'file-remote-p 'file-symlink-p 'file-truename - 'file-writable-p 'find-backup-file-name 'find-file-noselect - 'get-file-buffer 'insert-directory 'insert-file-contents - 'load 'make-directory 'make-directory-internal - 'set-file-modes 'substitute-in-file-name - 'unhandled-file-name-directory 'vc-registered - ;; Emacs 22+ only. - 'set-file-times - ;; Emacs 24+ only. - 'file-acl 'file-notify-add-watch - 'file-selinux-context 'set-file-acl 'set-file-selinux-context - ;; XEmacs only. - 'abbreviate-file-name 'create-file-buffer - 'dired-file-modtime 'dired-make-compressed-filename - 'dired-recursive-delete-directory 'dired-set-file-modtime - 'dired-shell-unhandle-file-name 'dired-uucode-file - 'insert-file-contents-literally 'make-temp-name 'recover-file - 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail)) + '(access-file byte-compiler-base-file-name delete-directory + delete-file diff-latest-backup-file directory-file-name + directory-files directory-files-and-attributes + dired-compress-file dired-uncache + file-accessible-directory-p file-attributes + file-directory-p file-executable-p file-exists-p + file-local-copy file-modes + file-name-as-directory file-name-directory + file-name-nondirectory file-name-sans-versions + file-ownership-preserved-p file-readable-p + file-regular-p file-remote-p file-symlink-p file-truename + file-writable-p find-backup-file-name find-file-noselect + get-file-buffer insert-directory insert-file-contents + load make-directory make-directory-internal + set-file-modes set-file-times substitute-in-file-name + 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 + ;; 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)))) ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation - (list 'add-name-to-file 'copy-file 'expand-file-name - 'file-name-all-completions 'file-name-completion - 'file-newer-than-file-p 'make-symbolic-link 'rename-file - ;; Emacs 23+ only. - 'copy-directory - ;; Emacs 24+ only. - 'file-equal-p 'file-in-directory-p - ;; XEmacs only. - 'dired-make-relative-symlink - 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) + '(add-name-to-file copy-directory copy-file expand-file-name + file-name-all-completions file-name-completion + file-newer-than-file-p make-symbolic-link rename-file + ;; Emacs 24+ only. + file-equal-p file-in-directory-p)) (save-match-data (cond ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) @@ -2053,35 +1954,30 @@ ARGS are the arguments OPERATION has been called with." (nth 2 args)) ;; BUFFER. ((member operation - (list 'set-visited-file-modtime 'verify-visited-file-modtime - ;; Emacs 22+ only. - 'make-auto-save-file-name - ;; XEmacs only. - 'backup-buffer)) + '(make-auto-save-file-name + set-visited-file-modtime verify-visited-file-modtime)) (buffer-file-name (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - (list ;; not in Emacs 23+. - 'dired-call-process - ;; Emacs only. - 'shell-command - ;; Emacs 22+ only. - 'process-file - ;; Emacs 23+ only. - 'start-file-process - ;; XEmacs only. - 'dired-print-file 'dired-shell-call-process)) + '(process-file shell-command start-file-process + ;; Emacs 26+ only. + make-nearby-temp-file temporary-file-directory)) default-directory) ;; PROC. - ((member operation (list 'file-notify-rm-watch 'file-notify-valid-p)) + ((member operation + '(;; Emacs 24+ only. + file-notify-rm-watch + ;; Emacs 25+ only. + file-notify-valid-p)) (when (processp (nth 0 args)) (with-current-buffer (process-buffer (nth 0 args)) default-directory))) ;; 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)) @@ -2089,11 +1985,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)) @@ -2115,19 +2017,20 @@ 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))) - (with-parsed-tramp-file-name filename nil - ;; Call the backend function. - (if foreign - (tramp-condition-case-unless-debug err - (let ((sf (symbol-function foreign)) - result) + (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 ;; are already loaded. This results in @@ -2164,38 +2067,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. - (tramp-run-real-handler operation args))))) - - ;; 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 @@ -2224,17 +2133,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." - ;; We bind `directory-sep-char' here for XEmacs on Windows, which - ;; would otherwise use backslash. - (let ((directory-sep-char ?/) - (fn (assoc operation tramp-completion-file-name-handler-alist))) + (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 @@ -2242,8 +2151,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; indicated his interest in using a fancier completion system. (or (eq tramp-syntax 'sep) (featurep 'tramp) ;; If it's loaded, we may as well use it. - ;; `partial-completion-mode' does not exist in XEmacs. - ;; It is obsoleted with Emacs 24.1. + ;; `partial-completion-mode' is obsoleted with Emacs 24.1. (and (boundp 'partial-completion-mode) (symbol-value 'partial-completion-mode)) ;; FIXME: These may have been loaded even if the user never @@ -2251,14 +2159,13 @@ 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) "Load Tramp file name handler, and perform OPERATION." - ;; Avoid recursive loading of tramp.el. `temporary-file-directory' - ;; does not exist in XEmacs, so we must use something else. - (let ((default-directory "/")) + ;; Avoid recursive loading of tramp.el. + (let ((default-directory temporary-file-directory)) (load "tramp" nil t)) (apply operation args))) @@ -2292,6 +2199,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)) @@ -2332,6 +2243,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) @@ -2343,6 +2255,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. @@ -2361,15 +2274,13 @@ should never be set globally, the intention is to let-bind it.") ;; variable. On the other hand, those files shouldn't have partial ;; 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, like in XEmacs ... -;;;###tramp-autoload +;; syntax in order to avoid ambiguities. (defun tramp-completion-mode-p () "Check, whether method / user name / host name completion is active." (or ;; Signal from outside. `non-essential' has been introduced in Emacs 24. (and (boundp 'non-essential) (symbol-value 'non-essential)) tramp-completion-mode - ;; Emacs. (equal last-input-event 'tab) (and (natnump last-input-event) (or @@ -2377,40 +2288,37 @@ should never be set globally, the intention is to let-bind it.") (equal last-input-event ?\t) (and (not (event-modifiers last-input-event)) (or (equal last-input-event ?\?) - (equal last-input-event ?\ ))))) - ;; XEmacs. - (and (featurep 'xemacs) - ;; `last-input-event' might be nil. - (not (null last-input-event)) - ;; `last-input-event' may have no character approximation. - (tramp-compat-funcall 'event-to-character last-input-event) - (or - ;; ?\t has event-modifier 'control. - (equal - (tramp-compat-funcall 'event-to-character last-input-event) ?\t) - (and (not (event-modifiers last-input-event)) - (or (equal - (tramp-compat-funcall 'event-to-character last-input-event) - ?\?) - (equal - (tramp-compat-funcall 'event-to-character last-input-event) - ?\ ))))))) + (equal last-input-event ?\ ))))))) (defun tramp-connectable-p (filename) "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." @@ -2483,7 +2391,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." @@ -2675,6 +2582,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. @@ -2781,17 +2694,18 @@ User is always nil." (tramp-parse-group (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t")) -;; For su-alike methods it would be desirable to return "root@localhost" -;; as default. Unfortunately, we have no information whether any user name -;; has been typed already. So we use `tramp-current-user' as indication, -;; assuming it is set in `tramp-completion-handle-file-name-all-completions'. ;;;###tramp-autoload (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. Host is always \"localhost\"." - (if (zerop (length tramp-current-user)) - '(("root" nil)) - (tramp-parse-file filename 'tramp-parse-passwd-group))) + (with-tramp-connection-property nil "parse-passwd" + (if (executable-find "getent") + (with-temp-buffer + (when (zerop (tramp-call-process nil "getent" nil t nil "passwd")) + (goto-char (point-min)) + (loop while (not (eobp)) collect + (tramp-parse-etc-group-group)))) + (tramp-parse-file filename 'tramp-parse-passwd-group)))) (defun tramp-parse-passwd-group () "Return a (user host) tuple allowed to access. @@ -2804,6 +2718,29 @@ Host is always \"localhost\"." result)) ;;;###tramp-autoload +(defun tramp-parse-etc-group (filename) + "Return a list of (group host) tuples allowed to access. +Host is always \"localhost\"." + (with-tramp-connection-property nil "parse-group" + (if (executable-find "getent") + (with-temp-buffer + (when (zerop (tramp-call-process nil "getent" nil t nil "group")) + (goto-char (point-min)) + (loop while (not (eobp)) collect + (tramp-parse-etc-group-group)))) + (tramp-parse-file filename 'tramp-parse-etc-group-group)))) + +(defun tramp-parse-etc-group-group () + "Return a (group host) tuple allowed to access. +Host is always \"localhost\"." + (let ((result) + (split (split-string (buffer-substring (point) (point-at-eol)) ":"))) + (when (member (user-login-name) (split-string (nth 3 split) "," 'omit)) + (setq result (list (nth 0 split) "localhost"))) + (forward-line 1) + result)) + +;;;###tramp-autoload (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." @@ -2827,12 +2764,13 @@ User may be nil." "Return a list of (user host) tuples allowed to access. User is always nil." (if (memq system-type '(windows-nt)) - (with-temp-buffer - (when (zerop (tramp-call-process - nil "reg" nil t nil "query" registry-or-dirname)) - (goto-char (point-min)) - (loop while (not (eobp)) collect - (tramp-parse-putty-group registry-or-dirname)))) + (with-tramp-connection-property nil "parse-putty" + (with-temp-buffer + (when (zerop (tramp-call-process + nil "reg" nil t nil "query" registry-or-dirname)) + (goto-char (point-min)) + (loop while (not (eobp)) collect + (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$")))) @@ -2868,10 +2806,8 @@ User is always nil." (substring directory 0 -1) directory))) -(defun tramp-handle-directory-files - (directory &optional full match nosort files-only) +(defun tramp-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for Tramp files." - ;; FILES-ONLY is valid for XEmacs only. (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) @@ -2879,12 +2815,7 @@ User is always nil." (while temp (setq item (directory-file-name (pop temp))) - (when (and (or (null match) (string-match match item)) - (or (null files-only) - ;; Files only. - (and (equal files-only t) (file-regular-p item)) - ;; Directories only. - (file-directory-p item))) + (when (or (null match) (string-match match item)) (push (if full (concat directory item) item) result))) (if nosort result (sort result 'string<))))) @@ -2894,15 +2825,14 @@ User is always nil." "Like `directory-files-and-attributes' for Tramp files." (mapcar (lambda (x) - (cons x (tramp-compat-file-attributes + (cons x (file-attributes (if full x (expand-file-name x directory)) id-format))) (directory-files directory full match nosort))) -(defun tramp-handle-dired-uncache (dir &optional dir-p) +(defun tramp-handle-dired-uncache (dir) "Like `dired-uncache' for Tramp files." - ;; DIR-P is valid for XEmacs only. (with-parsed-tramp-file-name - (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil + (if (file-directory-p dir) dir (file-name-directory dir)) nil (tramp-flush-directory-property v localname))) (defun tramp-handle-file-accessible-directory-p (filename) @@ -2938,7 +2868,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) @@ -2946,15 +2877,66 @@ 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 + (tramp-compat-file-name-unquote + (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." @@ -2962,11 +2944,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." @@ -2994,13 +2986,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." @@ -3009,7 +3005,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 @@ -3026,7 +3022,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) @@ -3035,43 +3031,19 @@ User is always nil." (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil - ;; We set both variables. It doesn't matter whether it is - ;; Emacs or XEmacs. (let ((backup-directory-alist - ;; Emacs case. - (when (boundp 'backup-directory-alist) - (if (symbol-value 'tramp-backup-directory-alist) - (mapcar - (lambda (x) - (cons - (car x) - (if (and (stringp (cdr x)) - (file-name-absolute-p (cdr x)) - (not (tramp-file-name-p (cdr x)))) - (tramp-make-tramp-file-name method user host (cdr x)) - (cdr x)))) - (symbol-value 'tramp-backup-directory-alist)) - (symbol-value 'backup-directory-alist)))) - - (bkup-backup-directory-info - ;; XEmacs case. - (when (boundp 'bkup-backup-directory-info) - (if (symbol-value 'tramp-bkup-backup-directory-info) - (mapcar - (lambda (x) - (nconc - (list (car x)) - (list - (if (and (stringp (car (cdr x))) - (file-name-absolute-p (car (cdr x))) - (not (tramp-file-name-p (car (cdr x))))) - (tramp-make-tramp-file-name - method user host (car (cdr x))) - (car (cdr x)))) - (cdr (cdr x)))) - (symbol-value 'tramp-bkup-backup-directory-info)) - (symbol-value 'bkup-backup-directory-info))))) - + (if tramp-backup-directory-alist + (mapcar + (lambda (x) + (cons + (car x) + (if (and (stringp (cdr x)) + (file-name-absolute-p (cdr x)) + (not (tramp-file-name-p (cdr x)))) + (tramp-make-tramp-file-name method user host (cdr x)) + (cdr x)))) + tramp-backup-directory-alist) + backup-directory-alist))) (tramp-run-real-handler 'find-backup-file-name (list filename))))) (defun tramp-handle-insert-directory @@ -3116,7 +3088,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) @@ -3182,8 +3155,7 @@ User is always nil." ;; When the file is not readable for the owner, it ;; cannot be inserted, even if it is readable for the ;; group or for everybody. - (set-file-modes - local-copy (tramp-compat-octal-to-decimal "0600")) + (set-file-modes local-copy (string-to-number "0600" 8)) (when (and (null remote-copy) (tramp-get-method-parameter @@ -3193,9 +3165,7 @@ User is always nil." (setq tramp-temp-buffer-file-name local-copy)) ;; We must ensure that `file-coding-system-alist' - ;; matches `local-copy'. We must also use `visit', - ;; otherwise there might be an error in the - ;; `revert-buffer' function under XEmacs. + ;; matches `local-copy'. (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename local-copy))) @@ -3244,14 +3214,15 @@ 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))) (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) (unwind-protect - (tramp-compat-load local-copy noerror t nosuffix must-suffix) + (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) @@ -3305,7 +3276,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 @@ -3345,35 +3316,28 @@ User is always nil." (current-buffer)))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (tramp-compat-funcall 'display-message-or-buffer output-buffer) - (pop-to-buffer output-buffer)))))))) + (display-message-or-buffer output-buffer))))))) (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))))) - -(defun tramp-handle-unhandled-file-name-directory (_filename) - "Like `unhandled-file-name-directory' for Tramp files." - ;; Starting with Emacs 23, we must simply return nil. But we must - ;; keep backward compatibility, also with XEmacs. "~/" cannot be - ;; returned, because there might be machines without a HOME - ;; directory (like hydra). - (and (< emacs-major-version 23) "/")) + ;; 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." @@ -3384,7 +3348,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)))) @@ -3403,12 +3369,12 @@ of." ;; connection. (if (or (not f) (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + (not (file-remote-p f nil 'connected))) t (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 @@ -3448,13 +3414,13 @@ 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) (file-exists-p (concat (file-remote-p default-directory) - (tramp-compat-process-get proc 'watch-name)))))) + (process-get proc 'watch-name)))))) ;;; Functions for establishing connection: @@ -3543,14 +3509,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)) @@ -3567,7 +3533,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: @@ -3628,6 +3594,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 @@ -3649,19 +3619,13 @@ connection buffer." This is needed in order to hide `last-coding-system-used', which is set for process communication also." (with-current-buffer (process-buffer proc) - ;; FIXME: If there is a gateway process, we need communication - ;; between several processes. Too complicate to implement, so we - ;; read output from all processes. - (let ((p (if (tramp-get-connection-property proc "gateway" nil) nil proc)) - buffer-read-only last-coding-system-used) + (let (buffer-read-only last-coding-system-used) ;; Under Windows XP, accept-process-output doesn't return ;; sometimes. So we add an additional timeout. (with-timeout ((or timeout 1)) - (if (featurep 'xemacs) - (accept-process-output p timeout timeout-msecs) - (accept-process-output p timeout timeout-msecs (and proc t)))) - (tramp-message proc 10 "%s %s %s\n%s" - proc (process-status proc) p (buffer-string))))) + (accept-process-output proc timeout timeout-msecs (and proc t))) + (tramp-message proc 10 "%s %s\n%s" + proc (process-status proc) (buffer-string))))) (defun tramp-check-for-regexp (proc regexp) "Check, whether REGEXP is contained in process buffer of PROC. @@ -3684,11 +3648,10 @@ Erase echoed commands if exists." (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil)) ;; Sometimes, the echo string is suppressed on the remote side. (not (string-equal - (tramp-compat-funcall - 'substring-no-properties tramp-echo-mark-marker + (substring-no-properties + tramp-echo-mark-marker 0 (min tramp-echo-mark-marker-length (1- (point-max)))) - (tramp-compat-funcall - 'buffer-substring-no-properties + (buffer-substring-no-properties (point-min) (min (+ (point-min) tramp-echo-mark-marker-length) (point-max)))))) @@ -3706,26 +3669,19 @@ Expects the output of PROC to be sent to the current buffer. Returns the string that matched, or nil. Waits indefinitely if TIMEOUT is nil." (with-current-buffer (process-buffer proc) - (let ((found (tramp-check-for-regexp proc regexp)) - (start-time (current-time))) + (let ((found (tramp-check-for-regexp proc regexp))) (cond (timeout - ;; Work around a bug in XEmacs 21, where the timeout - ;; expires faster than it should. This degenerates - ;; to polling for buggy XEmacsen, but oh, well. - (while (and (not found) - (< (tramp-time-diff (current-time) start-time) - timeout)) - (with-timeout (timeout) - (while (not found) - (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) - (tramp-error-with-buffer - nil proc 'file-error "Process has died")) - (setq found (tramp-check-for-regexp proc regexp)))))) + (with-timeout (timeout) + (while (not found) + (tramp-accept-process-output proc 1) + (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))))) @@ -3761,9 +3717,8 @@ the remote host use line-endings as defined in the variable (let (buffer-read-only) (delete-region (point-min) (point-max))) ;; Replace "\n" by `tramp-rsh-end-of-line'. (setq string - (mapconcat 'identity - (tramp-compat-split-string string "\n") - tramp-rsh-end-of-line)) + (mapconcat + 'identity (split-string string "\n") tramp-rsh-end-of-line)) (unless (or (string= string "") (string-equal (substring string -1) tramp-rsh-end-of-line)) (setq string (concat string tramp-rsh-end-of-line))) @@ -3827,57 +3782,47 @@ would yield t. On the other hand, the following check results in nil: (save-match-data (logior (cond - ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400")) + ((char-equal owner-read ?r) (string-to-number "00400" 8)) ((char-equal owner-read ?-) 0) (t (error "Second char `%c' must be one of `r-'" owner-read))) (cond - ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200")) + ((char-equal owner-write ?w) (string-to-number "00200" 8)) ((char-equal owner-write ?-) 0) (t (error "Third char `%c' must be one of `w-'" owner-write))) (cond - ((char-equal owner-execute-or-setid ?x) - (tramp-compat-octal-to-decimal "00100")) - ((char-equal owner-execute-or-setid ?S) - (tramp-compat-octal-to-decimal "04000")) - ((char-equal owner-execute-or-setid ?s) - (tramp-compat-octal-to-decimal "04100")) + ((char-equal owner-execute-or-setid ?x) (string-to-number "00100" 8)) + ((char-equal owner-execute-or-setid ?S) (string-to-number "04000" 8)) + ((char-equal owner-execute-or-setid ?s) (string-to-number "04100" 8)) ((char-equal owner-execute-or-setid ?-) 0) (t (error "Fourth char `%c' must be one of `xsS-'" owner-execute-or-setid))) (cond - ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040")) + ((char-equal group-read ?r) (string-to-number "00040" 8)) ((char-equal group-read ?-) 0) (t (error "Fifth char `%c' must be one of `r-'" group-read))) (cond - ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020")) + ((char-equal group-write ?w) (string-to-number "00020" 8)) ((char-equal group-write ?-) 0) (t (error "Sixth char `%c' must be one of `w-'" group-write))) (cond - ((char-equal group-execute-or-setid ?x) - (tramp-compat-octal-to-decimal "00010")) - ((char-equal group-execute-or-setid ?S) - (tramp-compat-octal-to-decimal "02000")) - ((char-equal group-execute-or-setid ?s) - (tramp-compat-octal-to-decimal "02010")) + ((char-equal group-execute-or-setid ?x) (string-to-number "00010" 8)) + ((char-equal group-execute-or-setid ?S) (string-to-number "02000" 8)) + ((char-equal group-execute-or-setid ?s) (string-to-number "02010" 8)) ((char-equal group-execute-or-setid ?-) 0) (t (error "Seventh char `%c' must be one of `xsS-'" group-execute-or-setid))) (cond - ((char-equal other-read ?r) - (tramp-compat-octal-to-decimal "00004")) + ((char-equal other-read ?r) (string-to-number "00004" 8)) ((char-equal other-read ?-) 0) (t (error "Eighth char `%c' must be one of `r-'" other-read))) (cond - ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002")) - ((char-equal other-write ?-) 0) - (t (error "Ninth char `%c' must be one of `w-'" other-write))) + ((char-equal other-write ?w) (string-to-number "00002" 8)) + ((char-equal other-write ?-) 0) + (t (error "Ninth char `%c' must be one of `w-'" other-write))) (cond - ((char-equal other-execute-or-sticky ?x) - (tramp-compat-octal-to-decimal "00001")) - ((char-equal other-execute-or-sticky ?T) - (tramp-compat-octal-to-decimal "01000")) - ((char-equal other-execute-or-sticky ?t) - (tramp-compat-octal-to-decimal "01001")) + ((char-equal other-execute-or-sticky ?x) (string-to-number "00001" 8)) + ((char-equal other-execute-or-sticky ?T) (string-to-number "01000" 8)) + ((char-equal other-execute-or-sticky ?t) (string-to-number "01001" 8)) ((char-equal other-execute-or-sticky ?-) 0) (t (error "Tenth char `%c' must be one of `xtT-'" other-execute-or-sticky))))))) @@ -3931,15 +3876,22 @@ 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 (tramp-compat-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")) @@ -3979,7 +3931,7 @@ be granted." (tramp-get-file-property vec (tramp-file-name-localname vec) (concat "file-attributes-" suffix) nil) - (tramp-compat-file-attributes + (file-attributes (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -3992,25 +3944,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) @@ -4040,19 +4006,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) - (tramp-file-name-handler 'file-remote-p dir 'localname)) - (tramp-error vec 'file-error "Directory %s not accessible" dir))) - dir)) + (file-remote-p dir 'localname)) + (tramp-error vec 'file-error "Directory %s not accessible" dir)) + dir))) ;;;###tramp-autoload (defun tramp-make-tramp-temp-file (vec) @@ -4071,7 +4035,7 @@ Return the local name of the temporary file." (setq result nil) ;; This creates the file by side effect. (set-file-times result) - (set-file-modes result (tramp-compat-octal-to-decimal "0700")))) + (set-file-modes result (string-to-number "0700" 8)))) ;; Return the local part. (with-parsed-tramp-file-name result nil localname))) @@ -4087,9 +4051,6 @@ Return the local name of the temporary file." (remove-hook 'kill-buffer-hook 'tramp-delete-temp-file-function))) -;;; Auto saving to a special directory: -(defvar auto-save-file-name-transforms) - (defun tramp-handle-make-auto-save-file-name () "Like `make-auto-save-file-name' for Tramp files. Returns a file name in `tramp-auto-save-directory' for autosaving @@ -4104,9 +4065,8 @@ this file, if that variable is non-nil." (let ((system-type 'not-windows) (auto-save-file-name-transforms - (if (and (null tramp-auto-save-directory) - (boundp 'auto-save-file-name-transforms)) - (symbol-value 'auto-save-file-name-transforms))) + (if (null tramp-auto-save-directory) + auto-save-file-name-transforms)) (buffer-file-name (if (null tramp-auto-save-directory) buffer-file-name @@ -4118,63 +4078,10 @@ 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'. There might be an advice when - ;; it is not a magic file name operation (since Emacs 22). - ;; We must deactivate it temporarily. - (if (not (ad-is-active 'make-auto-save-file-name)) - (tramp-run-real-handler 'make-auto-save-file-name nil) - ;; else - (ad-deactivate 'make-auto-save-file-name) - (prog1 - (tramp-run-real-handler 'make-auto-save-file-name nil) - (ad-activate 'make-auto-save-file-name))))) - -(unless (tramp-exists-file-name-handler 'make-auto-save-file-name) - (defadvice make-auto-save-file-name - (around tramp-advice-make-auto-save-file-name () activate) - "Invoke `tramp-*-handle-make-auto-save-file-name' for Tramp files." - (if (tramp-tramp-file-p (buffer-file-name)) - ;; We cannot call `tramp-handle-make-auto-save-file-name' - ;; directly, because this would bypass the locking mechanism. - (setq ad-return-value - (tramp-file-name-handler 'make-auto-save-file-name)) - ad-do-it)) - (add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice - 'make-auto-save-file-name - 'around 'tramp-advice-make-auto-save-file-name) - (ad-activate 'make-auto-save-file-name)))) - -;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus -;; umask. This is a security threat. - -(defun tramp-set-auto-save-file-modes () - "Set permissions of autosaved remote files to the original permissions." - (let ((bfn (buffer-file-name))) - (when (and (tramp-tramp-file-p bfn) - (buffer-modified-p) - (stringp buffer-auto-save-file-name) - (not (equal bfn buffer-auto-save-file-name))) - (unless (file-exists-p buffer-auto-save-file-name) - (write-region "" nil buffer-auto-save-file-name)) - ;; Permissions should be set always, because there might be an old - ;; auto-saved file belonging to another original file. This could - ;; be a security threat. - (set-file-modes - buffer-auto-save-file-name - (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600")))))) - -(unless (and (featurep 'xemacs) - (= emacs-major-version 21) - (> emacs-minor-version 4)) - (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)))) + ;; Run plain `make-auto-save-file-name'. + (tramp-run-real-handler 'make-auto-save-file-name nil))) (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. @@ -4189,6 +4096,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 @@ -4197,11 +4120,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) @@ -4212,13 +4136,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 @@ -4227,7 +4155,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)) @@ -4268,31 +4197,32 @@ Invokes `password-read' if available, `read-passwd' else." (tramp-check-for-regexp proc tramp-password-prompt-regexp) (format "%s for %s " (capitalize (match-string 1)) key)))) ;; We suspend the timers while reading the password. - (stimers (and (functionp 'with-timeout-suspend) - (tramp-compat-funcall 'with-timeout-suspend))) + (stimers (with-timeout-suspend)) auth-info auth-passwd) (unwind-protect (with-parsed-tramp-file-name key nil (prog1 (or - ;; See if auth-sources contains something useful, if - ;; it's bound. `auth-source-user-or-password' is an - ;; obsoleted function, it has been replaced by + ;; See if auth-sources contains something useful. + ;; `auth-source-user-or-password' is an obsoleted + ;; function since Emacs 24.1, it has been replaced by ;; `auth-source-search'. (ignore-errors - (and (boundp 'auth-sources) - (tramp-get-connection-property + (and (tramp-get-connection-property v "first-password-request" nil) ;; Try with Tramp's current method. (if (fboundp 'auth-source-search) (setq auth-info - (tramp-compat-funcall - 'auth-source-search + (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) @@ -4302,73 +4232,55 @@ Invokes `password-read' if available, `read-passwd' else." 'auth-source-user-or-password "password" tramp-current-host tramp-current-method)))) ;; Try the password cache. - (when (functionp 'password-read) - (let ((password - (tramp-compat-funcall 'password-read pw-prompt key))) - (tramp-compat-funcall 'password-cache-add key password) - password)) + (let ((password (password-read pw-prompt key))) + (password-cache-add key password) + password) ;; Else, get the password interactively. (read-passwd pw-prompt)) (tramp-set-connection-property v "first-password-request" nil))) ;; Reenable the timers. - (and (functionp 'with-timeout-unsuspend) - (tramp-compat-funcall 'with-timeout-unsuspend stimers))))) + (with-timeout-unsuspend stimers)))) ;;;###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 (tramp-dissect-file-name (concat tramp-prefix-format - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string (concat tramp-postfix-hop-regexp "$") - tramp-postfix-host-format hop)))))) - (tramp-compat-funcall - '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)." - (cond ((and (fboundp 'subtract-time) - (fboundp 'float-time)) - (tramp-compat-funcall - 'float-time (tramp-compat-funcall 'subtract-time t1 t2))) - ((and (fboundp 'subtract-time) - (fboundp 'time-to-seconds)) - (tramp-compat-funcall - 'time-to-seconds (tramp-compat-funcall 'subtract-time t1 t2))) - ((fboundp 'itimer-time-difference) - (tramp-compat-funcall - 'itimer-time-difference - (if (< (length t1) 3) (append t1 '(0)) t1) - (if (< (length t2) 3) (append t2 '(0)) t2))) - (t - (let ((time (time-subtract t1 t2))) - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (nth 2 time) 0) 1000000.0)))))) + ;; 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 @@ -4401,7 +4313,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) "\\~")) @@ -4433,11 +4345,14 @@ Only works for Bourne-like shells." (eval-after-load "esh-util" '(progn - (tramp-eshell-directory-change) + (add-hook 'eshell-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-mode-hook + 'tramp-eshell-directory-change) (remove-hook 'eshell-directory-change-hook 'tramp-eshell-directory-change))))) @@ -4462,31 +4377,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) -;; * abbreviate-file-name +;; ;; * 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 25e8b22d327..1cdbe161d52 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.2.13.25.2 +;; Version: 2.3.1 ;; This file is part of GNU Emacs. @@ -27,45 +27,36 @@ ;; In the Tramp GIT repository, the version number and the bug report ;; address are auto-frobbed from configure.ac, so you should edit that -;; file and run "autoconf && ./configure" to change them. (X)Emacs +;; file and run "autoconf && ./configure" to change them. Emacs ;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.13.25.2" +(defconst tramp-version "2.3.1" "This version of Tramp.") ;;;###tramp-autoload (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") -;; `locate-dominating-file' does not exist in XEmacs. But it is not used here. -(autoload 'locate-dominating-file "files") -(autoload 'tramp-compat-replace-regexp-in-string "tramp-compat") - (defun tramp-repository-get-version () "Try to return as a string the repository revision of the Tramp sources." - (unless (featurep 'xemacs) - (let ((dir (locate-dominating-file (locate-library "tramp") ".git"))) - (when dir - (with-temp-buffer - (let ((default-directory (file-name-as-directory dir))) - (and (zerop - (ignore-errors - (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) - (not (zerop (buffer-size))) - (tramp-compat-replace-regexp-in-string - "\n" "" (buffer-string))))))))) - -;; Check for (X)Emacs version. -(let ((x (if (or (>= emacs-major-version 22) - (and (featurep 'xemacs) - (= emacs-major-version 21) - (>= emacs-minor-version 4))) - "ok" - (format "Tramp 2.2.13.25.2 is not fit for %s" - (when (string-match "^.*$" (emacs-version)) - (match-string 0 (emacs-version))))))) + (let ((dir (locate-dominating-file (locate-library "tramp") ".git"))) + (when dir + (with-temp-buffer + (let ((default-directory (file-name-as-directory dir))) + (and (zerop + (ignore-errors + (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) + (not (zerop (buffer-size))) + (replace-regexp-in-string "\n" "" (buffer-string)))))))) + +;; Check for Emacs version. +(let ((x (if (>= emacs-major-version 23) + "ok" + (format "Tramp 2.3.1 is not fit for %s" + (when (string-match "^.*$" (emacs-version)) + (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) (add-hook 'tramp-unload-hook 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/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el index bcee0882aa2..6406f57ff63 100644 --- a/lisp/nxml/nxml-enc.el +++ b/lisp/nxml/nxml-enc.el @@ -1,4 +1,4 @@ -;;; nxml-enc.el --- XML encoding auto-detection +;;; nxml-enc.el --- XML encoding auto-detection -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -68,7 +68,7 @@ (and nxml-non-xml-set-auto-coding-function (funcall nxml-non-xml-set-auto-coding-function file-name size)))) -(defun nxml-set-xml-coding (file-name size) +(defun nxml-set-xml-coding (_file-name size) "Function to use as `set-auto-coding-function' when file is known to be XML." (nxml-detect-coding-system (+ (point) (min size 1024)))) diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el deleted file mode 100644 index 4a518218c23..00000000000 --- a/lisp/nxml/nxml-glyph.el +++ /dev/null @@ -1,423 +0,0 @@ -;;; nxml-glyph.el --- glyph-handling for nxml-mode - -;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; 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: - -;; The entry point to this file is `nxml-glyph-display-string'. -;; The current implementation is heuristic due to a lack of -;; Emacs primitives necessary to implement it properly. The user -;; can tweak the heuristics using `nxml-glyph-set-functions'. - -;;; Code: - -(defconst nxml-ascii-glyph-set - [(#x0020 . #x007E)]) - -(defconst nxml-latin1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF)]) - -;; These were generated by using nxml-insert-target-repertoire-glyph-set -;; on the TARGET[123] files in -;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz - -(defconst nxml-misc-fixed-1-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - (#x02D8 . #x02DD) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2039 . #x203A) - #x20AC #x2116 #x2122 #x2126 - (#x215B . #x215E) - (#x2190 . #x2193) - #x2260 - (#x2264 . #x2265) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD] - "Glyph set for TARGET1 glyph repertoire of misc-fixed-* font. -This repertoire is supported for the bold and oblique fonts.") - -(defconst nxml-misc-fixed-2-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x017F) - #x018F #x0192 - (#x01FA . #x01FF) - (#x0218 . #x021B) - #x0259 - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DD) - (#x0300 . #x0311) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - #x03D1 - (#x03D5 . #x03D6) - #x03F1 - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x05D0 . #x05EA) - (#x1E02 . #x1E03) - (#x1E0A . #x1E0B) - (#x1E1E . #x1E1F) - (#x1E40 . #x1E41) - (#x1E56 . #x1E57) - (#x1E60 . #x1E61) - (#x1E6A . #x1E6B) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2010 . #x2022) - #x2026 #x2030 - (#x2032 . #x2034) - (#x2039 . #x203A) - #x203C #x203E #x2044 - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A3 . #x20A4) - #x20A7 #x20AC - (#x20D0 . #x20D7) - #x2102 #x2105 #x2113 - (#x2115 . #x2116) - #x211A #x211D #x2122 #x2124 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - (#x21A4 . #x21A8) - (#x21D0 . #x21D5) - (#x2200 . #x2209) - (#x220B . #x220C) - #x220F - (#x2211 . #x2213) - #x2215 - (#x2218 . #x221A) - (#x221D . #x221F) - #x2221 - (#x2224 . #x222B) - #x222E #x223C #x2243 #x2245 - (#x2248 . #x2249) - #x2259 - (#x225F . #x2262) - (#x2264 . #x2265) - (#x226A . #x226B) - (#x2282 . #x228B) - #x2295 #x2297 - (#x22A4 . #x22A7) - (#x22C2 . #x22C3) - #x22C5 #x2300 #x2302 - (#x2308 . #x230B) - #x2310 - (#x2320 . #x2321) - (#x2329 . #x232A) - (#x23BA . #x23BD) - (#x2409 . #x240D) - #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C - (#x254C . #x2573) - (#x2580 . #x25A1) - (#x25AA . #x25AC) - (#x25B2 . #x25B3) - #x25BA #x25BC #x25C4 #x25C6 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02) - #xFFFD] - "Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -5x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf") - -(defconst nxml-misc-fixed-3-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x00FF) - (#x0100 . #x01FF) - (#x0200 . #x0220) - (#x0222 . #x0233) - (#x0250 . #x02AD) - (#x02B0 . #x02EE) - (#x0300 . #x034F) - (#x0360 . #x036F) - (#x0374 . #x0375) - #x037A #x037E - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x03D0 . #x03F6) - (#x0400 . #x0486) - (#x0488 . #x04CE) - (#x04D0 . #x04F5) - (#x04F8 . #x04F9) - (#x0500 . #x050F) - (#x0531 . #x0556) - (#x0559 . #x055F) - (#x0561 . #x0587) - (#x0589 . #x058A) - (#x05B0 . #x05B9) - (#x05BB . #x05C4) - (#x05D0 . #x05EA) - (#x05F0 . #x05F4) - (#x10D0 . #x10F8) - #x10FB - (#x1E00 . #x1E9B) - (#x1EA0 . #x1EF9) - (#x1F00 . #x1F15) - (#x1F18 . #x1F1D) - (#x1F20 . #x1F45) - (#x1F48 . #x1F4D) - (#x1F50 . #x1F57) - #x1F59 #x1F5B #x1F5D - (#x1F5F . #x1F7D) - (#x1F80 . #x1FB4) - (#x1FB6 . #x1FC4) - (#x1FC6 . #x1FD3) - (#x1FD6 . #x1FDB) - (#x1FDD . #x1FEF) - (#x1FF2 . #x1FF4) - (#x1FF6 . #x1FFE) - (#x2000 . #x200A) - (#x2010 . #x2027) - (#x202F . #x2052) - #x2057 - (#x205F . #x2063) - (#x2070 . #x2071) - (#x2074 . #x208E) - (#x20A0 . #x20B1) - (#x20D0 . #x20EA) - (#x2100 . #x213A) - (#x213D . #x214B) - (#x2153 . #x2183) - (#x2190 . #x21FF) - (#x2200 . #x22FF) - (#x2300 . #x23CE) - (#x2400 . #x2426) - (#x2440 . #x244A) - (#x2500 . #x25FF) - (#x2600 . #x2613) - (#x2616 . #x2617) - (#x2619 . #x267D) - (#x2680 . #x2689) - (#x27E6 . #x27EB) - (#x27F5 . #x27FF) - (#x2A00 . #x2A06) - #x2A1D #x2A3F #x303F - (#xFB00 . #xFB06) - (#xFB13 . #xFB17) - (#xFB1D . #xFB36) - (#xFB38 . #xFB3C) - #xFB3E - (#xFB40 . #xFB41) - (#xFB43 . #xFB44) - (#xFB46 . #xFB4F) - (#xFE20 . #xFE23) - (#xFF61 . #xFF9F) - #xFFFD] - "Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts. -This repertoire is supported for the following fonts: -6x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf") - -(defconst nxml-wgl4-glyph-set - [(#x0020 . #x007E) - (#x00A0 . #x017F) - #x0192 - (#x01FA . #x01FF) - (#x02C6 . #x02C7) - #x02C9 - (#x02D8 . #x02DB) - #x02DD - (#x0384 . #x038A) - #x038C - (#x038E . #x03A1) - (#x03A3 . #x03CE) - (#x0401 . #x040C) - (#x040E . #x044F) - (#x0451 . #x045C) - (#x045E . #x045F) - (#x0490 . #x0491) - (#x1E80 . #x1E85) - (#x1EF2 . #x1EF3) - (#x2013 . #x2015) - (#x2017 . #x201E) - (#x2020 . #x2022) - #x2026 #x2030 - (#x2032 . #x2033) - (#x2039 . #x203A) - #x203C #x203E #x2044 #x207F - (#x20A3 . #x20A4) - #x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E - (#x215B . #x215E) - (#x2190 . #x2195) - #x21A8 #x2202 #x2206 #x220F - (#x2211 . #x2212) - #x2215 - (#x2219 . #x221A) - (#x221E . #x221F) - #x2229 #x222B #x2248 - (#x2260 . #x2261) - (#x2264 . #x2265) - #x2302 #x2310 - (#x2320 . #x2321) - #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 - #x252C #x2534 #x253C - (#x2550 . #x256C) - #x2580 #x2584 #x2588 #x258C - (#x2590 . #x2593) - (#x25A0 . #x25A1) - (#x25AA . #x25AC) - #x25B2 #x25BA #x25BC #x25C4 - (#x25CA . #x25CB) - #x25CF - (#x25D8 . #x25D9) - #x25E6 - (#x263A . #x263C) - #x2640 #x2642 #x2660 #x2663 - (#x2665 . #x2666) - (#x266A . #x266B) - (#xFB01 . #xFB02)] - "Glyph set corresponding to Windows Glyph List 4.") - -(defvar nxml-glyph-set-functions nil - "Abnormal hook for determining the set of glyphs in a face. -Each function in this hook is called in turn, unless one of them -returns non-nil. Each function is called with a single argument -FACE. If it can determine the set of glyphs representable by -FACE, it must set the variable `nxml-glyph-set' and return -non-nil. Otherwise, it must return nil. - -The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set', -`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set', -`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are -predefined for use by `nxml-glyph-set-functions'.") - -(define-obsolete-variable-alias 'nxml-glyph-set-hook - 'nxml-glyph-set-functions "24.3") - -(defvar nxml-glyph-set nil - "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE. -This should dynamically bound by any function that runs -`nxml-glyph-set-functions'. The value must be either nil representing an -empty set or a vector. Each member of the vector is either a single -integer or a cons (FIRST . LAST) representing the range of integers -from FIRST to LAST. An integer represents a glyph with that Unicode -code-point. The vector must be ordered.") - -(defun nxml-x-set-glyph-set (face) - (setq nxml-glyph-set - (if (equal (face-attribute face :family) "misc-fixed") - nxml-misc-fixed-3-glyph-set - nxml-wgl4-glyph-set))) - -(defun nxml-w32-set-glyph-set (face) - (setq nxml-glyph-set nxml-wgl4-glyph-set)) - -(defun nxml-window-system-set-glyph-set (face) - (setq nxml-glyph-set nxml-latin1-glyph-set)) - -(defun nxml-terminal-set-glyph-set (face) - (setq nxml-glyph-set nxml-ascii-glyph-set)) - -(add-hook 'nxml-glyph-set-functions - (or (cdr (assq window-system - '((x . nxml-x-set-glyph-set) - (w32 . nxml-w32-set-glyph-set) - (nil . nxml-terminal-set-glyph-set)))) - 'nxml-window-system-set-glyph-set) - t) - -;;;###autoload -(defun nxml-glyph-display-string (n face) - "Return a string that can display a glyph for Unicode code-point N. -FACE gives the face that will be used for displaying the string. -Return nil if the face cannot display a glyph for N." - (let ((nxml-glyph-set nil)) - (run-hook-with-args-until-success 'nxml-glyph-set-functions face) - (and nxml-glyph-set - (nxml-glyph-set-contains-p n nxml-glyph-set) - (let ((ch (decode-char 'ucs n))) - (and ch (string ch)))))) - -(defun nxml-glyph-set-contains-p (n v) - (let ((start 0) - (end (length v)) - found mid mid-val mid-start-val mid-end-val) - (while (> end start) - (setq mid (+ start - (/ (- end start) 2))) - (setq mid-val (aref v mid)) - (if (consp mid-val) - (setq mid-start-val (car mid-val) - mid-end-val (cdr mid-val)) - (setq mid-start-val mid-val - mid-end-val mid-val)) - (cond ((and (<= mid-start-val n) - (<= n mid-end-val)) - (setq found t) - (setq start end)) - ((< n mid-start-val) - (setq end mid)) - (t - (setq start - (if (eq start mid) - end - mid))))) - found)) - -(provide 'nxml-glyph) - -;;; nxml-glyph.el ends here diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el index b81e3113efb..5d24d9b3138 100644 --- a/lisp/nxml/nxml-maint.el +++ b/lisp/nxml/nxml-maint.el @@ -1,4 +1,4 @@ -;;; nxml-maint.el --- commands for maintainers of nxml-*.el +;;; nxml-maint.el --- commands for maintainers of nxml-*.el -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -24,48 +24,6 @@ ;;; Code: -;;; Generating files with Unicode char names. - -(require 'nxml-uchnm) - -(defun nxml-create-unicode-char-name-sets (file) - "Generate files containing char names from Unicode standard." - (interactive "fUnicodeData file: ") - (mapc (lambda (block) - (let ((nameset (nxml-unicode-block-char-name-set (nth 0 block)))) - (save-excursion - (find-file (concat (get nameset 'nxml-char-name-set-file) - ".el")) - (erase-buffer) - (insert "(nxml-define-char-name-set '") - (prin1 nameset (current-buffer)) - (insert "\n '())\n") - (goto-char (- (point) 3))))) - nxml-unicode-blocks) - (save-excursion - (find-file file) - (goto-char (point-min)) - (let ((blocks nxml-unicode-blocks) - code name) - (while (re-search-forward "^\\([0-9A-F]+\\);\\([^<;][^;]*\\);" - nil - t) - (setq code (string-to-number (match-string 1) 16)) - (setq name (match-string 2)) - (while (and blocks - (> code (nth 2 (car blocks)))) - (setq blocks (cdr blocks))) - (when (and (<= (nth 1 (car blocks)) code) - (<= code (nth 2 (car blocks)))) - (save-excursion - (find-file (concat (get (nxml-unicode-block-char-name-set - (nth 0 (car blocks))) - 'nxml-char-name-set-file) - ".el")) - (insert "(") - (prin1 name (current-buffer)) - (insert (format " #x%04X)\n " code)))))))) - ;;; Parsing target repertoire files from ucs-fonts. ;; This is for converting the TARGET? files in ;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 324350f591c..8c249d54073 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -26,14 +26,10 @@ ;;; Code: -(when (featurep 'mucs) - (error "nxml-mode is not compatible with Mule-UCS")) - (eval-when-compile (require 'cl-lib)) (require 'xmltok) (require 'nxml-enc) -(require 'nxml-glyph) (require 'nxml-util) (require 'nxml-rap) (require 'nxml-outln) @@ -41,6 +37,7 @@ ;; So we might as well just require it and silence the compiler. (provide 'nxml-mode) ; avoid recursive require (require 'rng-nxml) +(require 'sgml-mode) ;;; Customization @@ -55,9 +52,7 @@ (defcustom nxml-char-ref-display-glyph-flag t "Non-nil means display glyph following character reference. -The glyph is displayed in face `nxml-glyph'. The abnormal hook -`nxml-glyph-set-functions' can be used to change the characters -for which glyphs are displayed." +The glyph is displayed in face `nxml-glyph'." :group 'nxml :type 'boolean) @@ -153,16 +148,6 @@ This is not used directly, but only via inheritance by other faces." "Face used to highlight text." :group 'nxml-faces) -(defface nxml-comment-content - '((t (:inherit font-lock-comment-face))) - "Face used to highlight the content of comments." - :group 'nxml-faces) - -(defface nxml-comment-delimiter - '((t (:inherit font-lock-comment-delimiter-face))) - "Face used for the delimiters of comments, i.e., <!-- and -->." - :group 'nxml-faces) - (defface nxml-processing-instruction-delimiter '((t (:inherit nxml-delimiter))) "Face used for the delimiters of processing instructions, i.e., <? and ?>." @@ -280,15 +265,6 @@ This includes ths `x' in hex references." "Face used for the delimiters of attribute values." :group 'nxml-faces) -(defface nxml-namespace-attribute-value - '((t (:inherit nxml-attribute-value))) - "Face used for the value of namespace attributes." - :group 'nxml-faces) - -(defface nxml-namespace-attribute-value-delimiter - '((t (:inherit nxml-attribute-value-delimiter))) - "Face used for the delimiters of namespace attribute values." - :group 'nxml-faces) (defface nxml-prolog-literal-delimiter '((t (:inherit nxml-delimited-data))) @@ -342,22 +318,19 @@ The delimiters are <! and >." ;;; Global variables -(defvar nxml-parent-document nil +(defvar-local nxml-parent-document nil "The parent document for a part of a modular document. Use `nxml-parent-document-set' to set it.") -(make-variable-buffer-local 'nxml-parent-document) (put 'nxml-parent-document 'safe-local-variable 'stringp) -(defvar nxml-prolog-regions nil +(defvar-local nxml-prolog-regions nil "List of regions in the prolog to be fontified. See the function `xmltok-forward-prolog' for more information.") -(make-variable-buffer-local 'nxml-prolog-regions) -(defvar nxml-degraded nil +(defvar-local nxml-degraded nil "Non-nil if currently operating in degraded mode. Degraded mode is enabled when an internal error is encountered in the fontification or after-change functions.") -(make-variable-buffer-local 'nxml-degraded) (defvar nxml-completion-hook nil "Hook run by `nxml-complete'. @@ -375,13 +348,12 @@ one of the functions returns nil.") (defvar nxml-end-tag-indent-scan-distance 4000 "Maximum distance from point to scan backwards when indenting end-tag.") -(defvar nxml-char-ref-extra-display t +(defvar-local nxml-char-ref-extra-display t "Non-nil means display extra information for character references. The extra information consists of a tooltip with the character name and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph corresponding to the referenced character following the character reference.") -(make-variable-buffer-local 'nxml-char-ref-extra-display) (defvar nxml-mode-map (let ((map (make-sparse-keymap))) @@ -415,7 +387,9 @@ reference.") (defsubst nxml-set-face (start end face) (when (and face (< start end)) - (font-lock-append-text-property start end 'face face))) + ;; Prepend, so the character reference highlighting takes precedence over + ;; the string highlighting applied syntactically. + (font-lock-prepend-text-property start end 'face face))) (defun nxml-parent-document-set (parent-document) "Set `nxml-parent-document' and inherit the DTD &c." @@ -519,53 +493,39 @@ Many aspects this mode can be customized using ;; FIXME: Use the fact that we're parsing the document already ;; rather than using regex-based filtering. (setq-local tildify-foreach-region-function - (apply-partially 'tildify-foreach-ignore-environments + (apply-partially #'tildify-foreach-ignore-environments '(("<! *--" . "-- *>") ("<" . ">")))) - (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) + (setq-local mode-line-process '((nxml-degraded "/degraded"))) ;; We'll determine the fill prefix ourselves - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode nil) - (make-local-variable 'forward-sexp-function) - (setq forward-sexp-function 'nxml-forward-balanced-item) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'nxml-indent-line) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'nxml-do-fill-paragraph) + (setq-local adaptive-fill-mode nil) + (setq-local forward-sexp-function #'nxml-forward-balanced-item) + (setq-local indent-line-function #'nxml-indent-line) + (setq-local fill-paragraph-function #'nxml-do-fill-paragraph) ;; Comment support ;; This doesn't seem to work too well; ;; I think we should probably roll our own nxml-comment-dwim function. - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'nxml-indent-line) - (make-local-variable 'comment-start) - (setq comment-start "<!--") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "<!--[ \t\r\n]*") - (make-local-variable 'comment-end) - (setq comment-end "-->") - (make-local-variable 'comment-end-skip) - (setq comment-end-skip "[ \t\r\n]*-->") - (make-local-variable 'comment-line-break-function) - (setq comment-line-break-function 'nxml-newline-and-indent) - (setq-local comment-quote-nested-function 'nxml-comment-quote-nested) - (use-local-map nxml-mode-map) + (setq-local comment-indent-function #'nxml-indent-line) + (setq-local comment-start "<!--") + (setq-local comment-start-skip "<!--[ \t\r\n]*") + (setq-local comment-end "-->") + (setq-local comment-end-skip "[ \t\r\n]*-->") + (setq-local comment-line-break-function #'nxml-newline-and-indent) + (setq-local comment-quote-nested-function #'nxml-comment-quote-nested) (save-excursion (save-restriction (widen) - (setq nxml-scan-end (copy-marker (point-min) nil)) (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) - (add-hook 'completion-at-point-functions - #'nxml-completion-at-point-function nil t) - (setq-local syntax-propertize-function #'nxml-after-change) - (add-hook 'change-major-mode-hook 'nxml-cleanup nil t) + (setq-local syntax-ppss-table sgml-tag-syntax-table) + (setq-local syntax-propertize-function sgml-syntax-propertize-function) + (add-hook 'change-major-mode-hook #'nxml-cleanup nil t) ;; Emacs 23 handles the encoding attribute on the xml declaration ;; transparently to nxml-mode, so there is no longer a need for the below ;; hook. The hook also had the drawback of overriding explicit user ;; instruction to save as some encoding other than utf-8. - ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save) + ;;(add-hook 'write-contents-hooks #'nxml-prepare-to-save) (when (not (and (buffer-file-name) (file-exists-p (buffer-file-name)))) (when (and nxml-default-buffer-file-coding-system (not (local-variable-p 'buffer-file-coding-system))) @@ -575,16 +535,14 @@ Many aspects this mode can be customized using (setq font-lock-defaults '(nxml-font-lock-keywords - t ; keywords-only; we highlight comments and strings here + nil ; highlight comments and strings based on syntax-tables nil ; font-lock-keywords-case-fold-search. XML is case sensitive nil ; no special syntax table - nil ; no automatic syntactic fontification (font-lock-extend-region-functions . (nxml-extend-region)) (jit-lock-contextually . t) (font-lock-unfontify-region-function . nxml-unfontify-region))) - (rng-nxml-mode-init) - (nxml-enable-unicode-char-name-sets)) + (with-demoted-errors (rng-nxml-mode-init))) (defun nxml-cleanup () "Clean up after nxml-mode." @@ -596,7 +554,7 @@ Many aspects this mode can be customized using (with-silent-modifications (nxml-with-invisible-motion (remove-text-properties (point-min) (point-max) '(face))))) - (remove-hook 'change-major-mode-hook 'nxml-cleanup t)) + (remove-hook 'change-major-mode-hook #'nxml-cleanup t)) (defun nxml-degrade (context err) (message "Internal nXML mode error in %s (%s), degrading" @@ -604,12 +562,7 @@ Many aspects this mode can be customized using (error-message-string err)) (ding) (setq nxml-degraded t) - (setq nxml-prolog-end 1) - (save-excursion - (save-restriction - (widen) - (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)))))) + (setq nxml-prolog-end 1)) ;;; Change management @@ -622,41 +575,6 @@ Many aspects this mode can be customized using (goto-char font-lock-beg) (set-mark font-lock-end))) -(defun nxml-after-change (start end) - ;; Called via syntax-propertize-function. - (unless nxml-degraded - (nxml-with-degradation-on-error 'nxml-after-change - (save-restriction - (widen) - (nxml-with-invisible-motion - (nxml-after-change1 start end)))))) - -(defun nxml-after-change1 (start end) - "After-change bookkeeping. -Returns a cons cell containing a possibly-enlarged change region. -You must call `nxml-extend-region' on this expanded region to obtain -the full extent of the area needing refontification. - -For bookkeeping, call this function even when fontification is -disabled." - ;; If the prolog might have changed, rescan the prolog. - (when (<= start - ;; Add 2 so as to include the < and following char that - ;; start the instance (document element), since changing - ;; these can change where the prolog ends. - (+ nxml-prolog-end 2)) - (nxml-scan-prolog) - (setq start (point-min))) - - (when (> end nxml-prolog-end) - (goto-char start) - (nxml-move-tag-backwards (point-min)) - (setq start (point)) - (setq end (max (nxml-scan-after-change start end) - end))) - - (nxml-debug-change "nxml-after-change1" start end)) - ;;; Encodings (defun nxml-insert-xml-declaration () @@ -982,11 +900,11 @@ faces appropriately." [1 -1 nxml-entity-ref-name] [-1 nil nxml-entity-ref-delimiter])) -(put 'comment - 'nxml-fontify-rule - '([nil 4 nxml-comment-delimiter] - [4 -3 nxml-comment-content] - [-3 nil nxml-comment-delimiter])) +;; (put 'comment +;; 'nxml-fontify-rule +;; '([nil 4 nxml-comment-delimiter] +;; [4 -3 nxml-comment-content] +;; [-3 nil nxml-comment-delimiter])) (put 'processing-instruction 'nxml-fontify-rule @@ -1018,7 +936,7 @@ faces appropriately." 'nxml-fontify-rule '([nil nil nxml-attribute-local-name])) -(put 'xml-declaration-attribute-value +(put 'xml-declaration-attribute-value ;FIXME: What is this for? 'nxml-fontify-rule '([nil 1 nxml-attribute-value-delimiter] [1 -1 nxml-attribute-value] @@ -1137,28 +1055,11 @@ faces appropriately." 'nxml-attribute-prefix 'nxml-attribute-colon 'nxml-attribute-local-name)) - (let ((start (xmltok-attribute-value-start att)) - (end (xmltok-attribute-value-end att)) - (refs (xmltok-attribute-refs att)) - (delimiter-face (if namespace-declaration - 'nxml-namespace-attribute-value-delimiter - 'nxml-attribute-value-delimiter)) - (value-face (if namespace-declaration - 'nxml-namespace-attribute-value - 'nxml-attribute-value))) - (when start - (nxml-set-face (1- start) start delimiter-face) - (nxml-set-face end (1+ end) delimiter-face) - (while refs - (let* ((ref (car refs)) - (ref-type (aref ref 0)) - (ref-start (aref ref 1)) - (ref-end (aref ref 2))) - (nxml-set-face start ref-start value-face) - (nxml-apply-fontify-rule ref-type ref-start ref-end) - (setq start ref-end)) - (setq refs (cdr refs))) - (nxml-set-face start end value-face)))) + (dolist (ref (xmltok-attribute-refs att)) + (let* ((ref-type (aref ref 0)) + (ref-start (aref ref 1)) + (ref-end (aref ref 2))) + (nxml-apply-fontify-rule ref-type ref-start ref-end)))) (defun nxml-fontify-qname (start colon @@ -1599,30 +1500,7 @@ of the line. This expects the xmltok-* variables to be set up as by (t (back-to-indentation))) (current-column)) -;;; Completion - -(defun nxml-complete () - "Perform completion on the symbol preceding point. - -Inserts as many characters as can be completed. However, if not even -one character can be completed, then a buffer with the possibilities -is popped up and the symbol is read from the minibuffer with -completion. If the symbol is complete, then any characters that must -follow the symbol are also inserted. - -The name space used for completion and what is treated as a symbol -depends on the context. The contexts in which completion is performed -depend on `nxml-completion-hook'." - (interactive) - (unless (run-hook-with-args-until-success 'nxml-completion-hook) - ;; Eventually we will complete on entity names here. - (ding) - (message "Cannot complete in this context"))) - -(defun nxml-completion-at-point-function () - "Call `nxml-complete' to perform completion at point." - (when nxml-bind-meta-tab-to-complete-flag - #'nxml-complete)) +(define-obsolete-function-alias 'nxml-complete #'completion-at-point "26.1") ;;; Movement @@ -1643,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 @@ -1674,7 +1552,7 @@ single name. A character reference contains a character number." (t end))))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err))))) + (apply #'error (cddr err))))) (defun nxml-backward-single-balanced-item () (condition-case err @@ -1696,7 +1574,7 @@ single name. A character reference contains a character number." (t xmltok-start))))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err))))) + (apply #'error (cddr err))))) (defun nxml-scan-forward-within (end) (setq end (- end (nxml-end-delimiter-length xmltok-type))) @@ -1855,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)) @@ -1880,10 +1758,10 @@ single name. A character reference contains a character number." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (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)) @@ -1909,13 +1787,13 @@ single name. A character reference contains a character number." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-down-element (&optional arg) "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)) @@ -1933,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)) @@ -1961,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)) @@ -1974,13 +1852,13 @@ Negative ARG means move backward." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-backward-element (&optional arg) "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)) @@ -1996,7 +1874,7 @@ Negative ARG means move forward." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-mark-token-after () (interactive) @@ -2015,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))) @@ -2025,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))) @@ -2477,116 +2355,15 @@ and attempts to find another possible way to do the markup." ;;; Character names -(defvar nxml-char-name-ignore-case t) - -(defvar nxml-char-name-alist nil - "Alist of character names. -Each member of the list has the form (NAME CODE . NAMESET), -where NAME is a string naming a character, NAMESET is a symbol -identifying a set of names and CODE is an integer specifying the -Unicode scalar value of the named character. -The NAME will only be used for completion if NAMESET has -a non-nil `nxml-char-name-set-enabled' property. -If NAMESET does does not have `nxml-char-name-set-defined' property, -then it must have a `nxml-char-name-set-file' property and `load' -will be applied to the value of this property if the nameset -is enabled.") - -(defvar nxml-char-name-table (make-hash-table :test 'eq) - "Hash table for mapping char codes to names. -Each key is a Unicode scalar value. -Each value is a list of pairs of the form (NAMESET . NAME), -where NAMESET is a symbol identifying a set of names, -and NAME is a string naming a character.") - -(defvar nxml-autoload-char-name-set-list nil - "List of char namesets that can be autoloaded.") - -(defun nxml-enable-char-name-set (nameset) - (put nameset 'nxml-char-name-set-enabled t)) - -(defun nxml-disable-char-name-set (nameset) - (put nameset 'nxml-char-name-set-enabled nil)) - -(defun nxml-char-name-set-enabled-p (nameset) - (get nameset 'nxml-char-name-set-enabled)) - -(defun nxml-autoload-char-name-set (nameset file) - (unless (memq nameset nxml-autoload-char-name-set-list) - (setq nxml-autoload-char-name-set-list - (cons nameset nxml-autoload-char-name-set-list))) - (put nameset 'nxml-char-name-set-file file)) - -(defun nxml-define-char-name-set (nameset alist) - "Define a set of character names. -NAMESET is a symbol identifying the set. -ALIST is a list where each member has the form (NAME CODE), -where NAME is a string naming a character and code is an -integer giving the Unicode scalar value of the character." - (when (get nameset 'nxml-char-name-set-defined) - (error "Nameset `%s' already defined" nameset)) - (let ((iter alist)) - (while iter - (let* ((name-code (car iter)) - (name (car name-code)) - (code (cadr name-code))) - (puthash code - (cons (cons nameset name) - (gethash code nxml-char-name-table)) - nxml-char-name-table)) - (setcdr (cdr (car iter)) nameset) - (setq iter (cdr iter)))) - (setq nxml-char-name-alist - (nconc alist nxml-char-name-alist)) - (put nameset 'nxml-char-name-set-defined t)) - -(defun nxml-get-char-name (code) - (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list) - (let ((names (gethash code nxml-char-name-table)) - name) - (while (and names (not name)) - (if (nxml-char-name-set-enabled-p (caar names)) - (setq name (cdar names)) - (setq names (cdr names)))) - name)) - -(defvar nxml-named-char-history nil) - (defun nxml-insert-named-char (arg) "Insert a character using its name. The name is read from the minibuffer. Normally, inserts the character as a numeric character reference. With a prefix argument, inserts the character directly." (interactive "*P") - (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list) - (let ((name - (let ((completion-ignore-case nxml-char-name-ignore-case)) - (completing-read "Character name: " - nxml-char-name-alist - (lambda (member) - (get (cddr member) 'nxml-char-name-set-enabled)) - t - nil - 'nxml-named-char-history))) - (alist nxml-char-name-alist) - elt code) - (while (and alist (not code)) - (setq elt (assoc name alist)) - (if (get (cddr elt) 'nxml-char-name-set-enabled) - (setq code (cadr elt)) - (setq alist (cdr (member elt alist))))) + (let ((code (read-char-by-name "Character name: "))) (when code - (insert (if arg - (or (decode-char 'ucs code) - (error "Character %x is not supported by Emacs" - code)) - (format "&#x%X;" code)))))) - -(defun nxml-maybe-load-char-name-set (sym) - (when (and (get sym 'nxml-char-name-set-enabled) - (not (get sym 'nxml-char-name-set-defined)) - (stringp (get sym 'nxml-char-name-set-file))) - (load (get sym 'nxml-char-name-set-file)))) + (insert (if arg code (format "&#x%X;" code)))))) (defun nxml-toggle-char-ref-extra-display (arg) "Toggle the display of extra information for character references." @@ -2602,9 +2379,11 @@ With a prefix argument, inserts the character directly." (defun nxml-char-ref-display-extra (start end n) (when nxml-char-ref-extra-display - (let ((name (nxml-get-char-name n)) + (let ((name (or (get-char-code-property n 'name) + (get-char-code-property n 'old-name))) (glyph-string (and nxml-char-ref-display-glyph-flag - (nxml-glyph-display-string n 'nxml-glyph))) + (char-displayable-p n) + (string n))) ov) (when (or name glyph-string) (setq ov (make-overlay start end nil t)) diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 962160cb435..289816a1bba 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -1,4 +1,4 @@ -;;; nxml-outln.el --- outline support for nXML mode +;;; nxml-outln.el --- outline support for nXML mode -*- lexical-binding:t -*- ;; Copyright (C) 2004, 2007-2016 Free Software Foundation, Inc. @@ -248,6 +248,16 @@ customize which elements are recognized as sections and headings." (interactive) (nxml-transform-subtree-outline '((hide-children . t)))) +;; These variables are dynamically bound. They are use to pass information to +;; nxml-section-tag-transform-outline-state. + +(defvar nxml-outline-state-transform-exceptions nil) +(defvar nxml-target-section-pos nil) +(defvar nxml-depth-in-target-section nil) +(defvar nxml-outline-state-transform-alist nil) + +(defvar nxml-outline-display-section-tag-function nil) + (defun nxml-hide-other () "Hide text content other than that directly in the section containing point. Hide headings other than those of ancestors of that section and their @@ -275,14 +285,6 @@ customize which elements are recognized as sections and headings." (nxml-transform-buffer-outline '((nil . hide-children) (t . hide-children))))) -;; These variables are dynamically bound. They are use to pass information to -;; nxml-section-tag-transform-outline-state. - -(defvar nxml-outline-state-transform-exceptions nil) -(defvar nxml-target-section-pos nil) -(defvar nxml-depth-in-target-section nil) -(defvar nxml-outline-state-transform-alist nil) - (defun nxml-transform-buffer-outline (alist) (let ((nxml-target-section-pos nil) (nxml-depth-in-target-section 0) @@ -350,7 +352,7 @@ customize which elements are recognized as sections and headings." (defun nxml-section-tag-transform-outline-state (startp section-start-pos &optional - heading-start-pos) + _heading-start-pos) (if (not startp) (setq nxml-depth-in-target-section (and nxml-depth-in-target-section @@ -427,8 +429,6 @@ customize which elements are recognized as sections and headings." (nxml-outline-error (nxml-report-outline-error "Cannot display outline: %s" err))))) -(defvar nxml-outline-display-section-tag-function nil) - (defun nxml-outline-display-rest (outline-state start-tag-indent tag-qnames) "Display up to and including the end of the current element. OUTLINE-STATE can be nil, t, hide-children. START-TAG-INDENT is the @@ -789,7 +789,7 @@ no new overlay will be created." (defun nxml-end-of-heading () "Move from the start of the content of the heading to the end. Do not move past the end of the line." - (let ((pos (condition-case err + (let ((pos (condition-case nil (and (nxml-scan-element-forward (point) t) xmltok-start) (nxml-scan-error nil)))) @@ -888,7 +888,7 @@ Point is at the end of the tag. `xmltok-start' is the start." (nxml-ensure-scan-up-to-date) (let ((pos (nxml-inside-start (point)))) (when pos - (goto-char (1- pos)) + (goto-char pos) t)))) ((progn (xmltok-forward) diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el index 41b2e8ee513..edf012921a9 100644 --- a/lisp/nxml/nxml-parse.el +++ b/lisp/nxml/nxml-parse.el @@ -1,4 +1,4 @@ -;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode +;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index 47b23da62ad..e66289d042a 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -1,4 +1,4 @@ -;;; nxml-rap.el --- low-level support for random access parsing for nXML mode +;;; nxml-rap.el --- low-level support for random access parsing for nXML mode -*- lexical-binding:t -*- ;; Copyright (C) 2003-2004, 2007-2016 Free Software Foundation, Inc. @@ -46,8 +46,7 @@ ;; look like it scales to large numbers of overlays in a buffer. ;; ;; We don't in fact track all these constructs, but only track them in -;; some initial part of the instance. The variable `nxml-scan-end' -;; contains the limit of where we have scanned up to for them. +;; some initial part of the instance. ;; ;; Thus to parse some random point in the file we first ensure that we ;; have scanned up to that point. Then we search backwards for a @@ -74,93 +73,33 @@ (require 'xmltok) (require 'nxml-util) +(require 'sgml-mode) -(defvar nxml-prolog-end nil +(defvar-local nxml-prolog-end nil "Integer giving position following end of the prolog.") -(make-variable-buffer-local 'nxml-prolog-end) - -(defvar nxml-scan-end nil - "Marker giving position up to which we have scanned. -nxml-scan-end must be >= nxml-prolog-end. Furthermore, nxml-scan-end -must not be an inside position in the following sense. A position is -inside if the following character is a part of, but not the first -character of, a CDATA section, comment or processing instruction. -Furthermore all positions >= nxml-prolog-end and < nxml-scan-end that -are inside positions must have a non-nil `nxml-inside' property whose -value is a symbol specifying what it is inside. Any characters with a -non-nil `fontified' property must have position < nxml-scan-end and -the correct face. Dependent regions must also be established for any -unclosed constructs starting before nxml-scan-end. -There must be no `nxml-inside' properties after nxml-scan-end.") -(make-variable-buffer-local 'nxml-scan-end) (defsubst nxml-get-inside (pos) - (get-text-property pos 'nxml-inside)) - -(defsubst nxml-clear-inside (start end) - (nxml-debug-clear-inside start end) - (remove-text-properties start end '(nxml-inside nil))) - -(defsubst nxml-set-inside (start end type) - (nxml-debug-set-inside start end) - (put-text-property start end 'nxml-inside type)) + (save-excursion (nth 8 (syntax-ppss pos)))) (defun nxml-inside-end (pos) "Return the end of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (next-single-property-change pos 'nxml-inside) - (point-max)) - nil)) + (save-excursion + (let ((ppss (syntax-ppss pos))) + (when (nth 8 ppss) + (goto-char (nth 8 ppss)) + (with-syntax-table sgml-tag-syntax-table + (if (nth 3 ppss) + (progn (forward-comment 1) (point)) + (or (scan-sexps (point) 1) (point-max)))))))) (defun nxml-inside-start (pos) "Return the start of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (previous-single-property-change (1+ pos) 'nxml-inside) - (point-min)) - nil)) + (save-excursion (nth 8 (syntax-ppss pos)))) ;;; Change management -(defun nxml-scan-after-change (start end) - "Restore `nxml-scan-end' invariants after a change. -The change happened between START and END. -Return position after which lexical state is unchanged. -END must be > `nxml-prolog-end'. START must be outside -any “inside” regions and at the beginning of a token." - (if (>= start nxml-scan-end) - nxml-scan-end - (let ((inside-remove-start start) - xmltok-errors) - (while (or (when (xmltok-forward-special (min end nxml-scan-end)) - (when (memq xmltok-type - '(comment - cdata-section - processing-instruction)) - (nxml-clear-inside inside-remove-start - (1+ xmltok-start)) - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type) - (setq inside-remove-start (point))) - (if (< (point) (min end nxml-scan-end)) - t - (setq end (point)) - nil)) - ;; The end of the change was inside but is now outside. - ;; Imagine something really weird like - ;; <![CDATA[foo <!-- bar ]]> <![CDATA[ stuff --> <!-- ]]> --> - ;; and suppose we deleted "<![CDATA[f" - (let ((inside-end (nxml-inside-end end))) - (when inside-end - (setq end inside-end) - t)))) - (nxml-clear-inside inside-remove-start end)) - (when (> end nxml-scan-end) - (set-marker nxml-scan-end end)) - end)) - ;; n-s-p only called from nxml-mode.el, where this variable is defined. (defvar nxml-prolog-regions) @@ -169,10 +108,7 @@ any “inside” regions and at the beginning of a token." (let (xmltok-dtd xmltok-errors) (setq nxml-prolog-regions (xmltok-forward-prolog)) - (setq nxml-prolog-end (point)) - (nxml-clear-inside (point-min) nxml-prolog-end)) - (when (< nxml-scan-end nxml-prolog-end) - (set-marker nxml-scan-end nxml-prolog-end))) + (setq nxml-prolog-end (point)))) ;;; Random access parsing @@ -223,14 +159,7 @@ Sets variables like `nxml-token-after'." (defun nxml-tokenize-forward () (let (xmltok-errors) - (when (and (xmltok-forward) - (> (point) nxml-scan-end)) - (cond ((memq xmltok-type '(comment - cdata-section - processing-instruction)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) (point) xmltok-type)))) - (set-marker nxml-scan-end (point))) + (xmltok-forward) xmltok-type)) (defun nxml-move-tag-backwards (bound) @@ -253,32 +182,12 @@ As a precondition, point must be >= BOUND." Leave point unmoved if it is not inside anything special." (let ((start (nxml-inside-start (point)))) (when start - (goto-char (1- start)) + (goto-char start) (when (nxml-get-inside (point)) - (error "Char before inside-start at %s had nxml-inside property %s" - (point) - (nxml-get-inside (point))))))) + (error "Char before inside-start at %s is still \"inside\"" (point)))))) (defun nxml-ensure-scan-up-to-date () - (let ((pos (point))) - (when (< nxml-scan-end pos) - (save-excursion - (goto-char nxml-scan-end) - (let (xmltok-errors) - (while (when (xmltok-forward-special pos) - (when (memq xmltok-type - '(comment - processing-instruction - cdata-section)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type))) - (if (< (point) pos) - t - (setq pos (point)) - nil))) - (set-marker nxml-scan-end pos)))))) + (syntax-propertize (point))) ;;; Element scanning diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el deleted file mode 100644 index 7d7d785f152..00000000000 --- a/lisp/nxml/nxml-uchnm.el +++ /dev/null @@ -1,251 +0,0 @@ -;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode - -;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. - -;; Author: James Clark -;; Keywords: wp, hypermedia, languages, XML - -;; 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 enables the use of the character names defined in the Unicode -;; Standard. The use of the names can be controlled on a per-block -;; basis, so as both to reduce memory usage and loading time, -;; and to make completion work better. - -;;; Code: - -(require 'nxml-mode) - -(defconst nxml-unicode-blocks - '(("Basic Latin" #x0000 #x007F) - ("Latin-1 Supplement" #x0080 #x00FF) - ("Latin Extended-A" #x0100 #x017F) - ("Latin Extended-B" #x0180 #x024F) - ("IPA Extensions" #x0250 #x02AF) - ("Spacing Modifier Letters" #x02B0 #x02FF) - ("Combining Diacritical Marks" #x0300 #x036F) - ("Greek and Coptic" #x0370 #x03FF) - ("Cyrillic" #x0400 #x04FF) - ("Cyrillic Supplementary" #x0500 #x052F) - ("Armenian" #x0530 #x058F) - ("Hebrew" #x0590 #x05FF) - ("Arabic" #x0600 #x06FF) - ("Syriac" #x0700 #x074F) - ("Thaana" #x0780 #x07BF) - ("Devanagari" #x0900 #x097F) - ("Bengali" #x0980 #x09FF) - ("Gurmukhi" #x0A00 #x0A7F) - ("Gujarati" #x0A80 #x0AFF) - ("Oriya" #x0B00 #x0B7F) - ("Tamil" #x0B80 #x0BFF) - ("Telugu" #x0C00 #x0C7F) - ("Kannada" #x0C80 #x0CFF) - ("Malayalam" #x0D00 #x0D7F) - ("Sinhala" #x0D80 #x0DFF) - ("Thai" #x0E00 #x0E7F) - ("Lao" #x0E80 #x0EFF) - ("Tibetan" #x0F00 #x0FFF) - ("Myanmar" #x1000 #x109F) - ("Georgian" #x10A0 #x10FF) - ("Hangul Jamo" #x1100 #x11FF) - ("Ethiopic" #x1200 #x137F) - ("Cherokee" #x13A0 #x13FF) - ("Unified Canadian Aboriginal Syllabics" #x1400 #x167F) - ("Ogham" #x1680 #x169F) - ("Runic" #x16A0 #x16FF) - ("Tagalog" #x1700 #x171F) - ("Hanunoo" #x1720 #x173F) - ("Buhid" #x1740 #x175F) - ("Tagbanwa" #x1760 #x177F) - ("Khmer" #x1780 #x17FF) - ("Mongolian" #x1800 #x18AF) - ("Latin Extended Additional" #x1E00 #x1EFF) - ("Greek Extended" #x1F00 #x1FFF) - ("General Punctuation" #x2000 #x206F) - ("Superscripts and Subscripts" #x2070 #x209F) - ("Currency Symbols" #x20A0 #x20CF) - ("Combining Diacritical Marks for Symbols" #x20D0 #x20FF) - ("Letterlike Symbols" #x2100 #x214F) - ("Number Forms" #x2150 #x218F) - ("Arrows" #x2190 #x21FF) - ("Mathematical Operators" #x2200 #x22FF) - ("Miscellaneous Technical" #x2300 #x23FF) - ("Control Pictures" #x2400 #x243F) - ("Optical Character Recognition" #x2440 #x245F) - ("Enclosed Alphanumerics" #x2460 #x24FF) - ("Box Drawing" #x2500 #x257F) - ("Block Elements" #x2580 #x259F) - ("Geometric Shapes" #x25A0 #x25FF) - ("Miscellaneous Symbols" #x2600 #x26FF) - ("Dingbats" #x2700 #x27BF) - ("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF) - ("Supplemental Arrows-A" #x27F0 #x27FF) - ("Braille Patterns" #x2800 #x28FF) - ("Supplemental Arrows-B" #x2900 #x297F) - ("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF) - ("Supplemental Mathematical Operators" #x2A00 #x2AFF) - ("CJK Radicals Supplement" #x2E80 #x2EFF) - ("Kangxi Radicals" #x2F00 #x2FDF) - ("Ideographic Description Characters" #x2FF0 #x2FFF) - ("CJK Symbols and Punctuation" #x3000 #x303F) - ("Hiragana" #x3040 #x309F) - ("Katakana" #x30A0 #x30FF) - ("Bopomofo" #x3100 #x312F) - ("Hangul Compatibility Jamo" #x3130 #x318F) - ("Kanbun" #x3190 #x319F) - ("Bopomofo Extended" #x31A0 #x31BF) - ("Katakana Phonetic Extensions" #x31F0 #x31FF) - ("Enclosed CJK Letters and Months" #x3200 #x32FF) - ("CJK Compatibility" #x3300 #x33FF) - ("CJK Unified Ideographs Extension A" #x3400 #x4DBF) - ;;("CJK Unified Ideographs" #x4E00 #x9FFF) - ("Yi Syllables" #xA000 #xA48F) - ("Yi Radicals" #xA490 #xA4CF) - ;;("Hangul Syllables" #xAC00 #xD7AF) - ;;("High Surrogates" #xD800 #xDB7F) - ;;("High Private Use Surrogates" #xDB80 #xDBFF) - ;;("Low Surrogates" #xDC00 #xDFFF) - ;;("Private Use Area" #xE000 #xF8FF) - ;;("CJK Compatibility Ideographs" #xF900 #xFAFF) - ("Alphabetic Presentation Forms" #xFB00 #xFB4F) - ("Arabic Presentation Forms-A" #xFB50 #xFDFF) - ("Variation Selectors" #xFE00 #xFE0F) - ("Combining Half Marks" #xFE20 #xFE2F) - ("CJK Compatibility Forms" #xFE30 #xFE4F) - ("Small Form Variants" #xFE50 #xFE6F) - ("Arabic Presentation Forms-B" #xFE70 #xFEFF) - ("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF) - ("Specials" #xFFF0 #xFFFF) - ("Old Italic" #x10300 #x1032F) - ("Gothic" #x10330 #x1034F) - ("Deseret" #x10400 #x1044F) - ("Byzantine Musical Symbols" #x1D000 #x1D0FF) - ("Musical Symbols" #x1D100 #x1D1FF) - ("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF) - ;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF) - ;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F) - ("Tags" #xE0000 #xE007F) - ;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF) - ;;("Supplementary Private Use Area-B" #x100000 #x10FFFF) - ) - "List of Unicode blocks. -For each block there is a list (NAME FIRST LAST), where -NAME is a string giving the official name of the block, -FIRST is the first code-point and LAST is the last code-point. -Blocks containing only characters with algorithmic names or no names -are omitted.") - -(defun nxml-unicode-block-char-name-set (name) - "Return a symbol for a block whose official Unicode name is NAME. -The symbol is generated by downcasing and replacing each space -by a hyphen." - (intern (replace-regexp-in-string " " "-" (downcase name)))) - -;; This is intended to be a superset of the coverage -;; of existing standard entity sets. -(defvar nxml-enabled-unicode-blocks-default - '(basic-latin - latin-1-supplement - latin-extended-a - latin-extended-b - ipa-extensions - spacing-modifier-letters - combining-diacritical-marks - greek-and-coptic - cyrillic - general-punctuation - superscripts-and-subscripts - currency-symbols - combining-diacritical-marks-for-symbols - letterlike-symbols - number-forms - arrows - mathematical-operators - miscellaneous-technical - control-pictures - optical-character-recognition - enclosed-alphanumerics - box-drawing - block-elements - geometric-shapes - miscellaneous-symbols - dingbats - miscellaneous-mathematical-symbols-a - supplemental-arrows-a - supplemental-arrows-b - miscellaneous-mathematical-symbols-b - supplemental-mathematical-operators - cjk-symbols-and-punctuation - alphabetic-presentation-forms - variation-selectors - small-form-variants - specials - mathematical-alphanumeric-symbols) - "Default value for `nxml-enabled-unicode-blocks'.") - -(mapc (lambda (block) - (nxml-autoload-char-name-set - (nxml-unicode-block-char-name-set (car block)) - (expand-file-name - (format "nxml/%05X-%05X" - (nth 1 block) - (nth 2 block)) - data-directory))) - nxml-unicode-blocks) - -;; Internal flag to control whether customize reloads the character tables. -;; Should be set the first time the -(defvar nxml-internal-unicode-char-name-sets-enabled nil) - -(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default - "List of Unicode blocks for which Unicode character names are enabled. -Each block is identified by a symbol derived from the name -of the block by downcasing and replacing each space by a hyphen." - :group 'nxml - :set (lambda (sym value) - (set-default 'nxml-enabled-unicode-blocks value) - (when nxml-internal-unicode-char-name-sets-enabled - (nxml-enable-unicode-char-name-sets))) - :type (cons 'set - (mapcar (lambda (block) - `(const :tag ,(format "%s (%04X-%04X)" - (nth 0 block) - (nth 1 block) - (nth 2 block)) - ,(nxml-unicode-block-char-name-set - (nth 0 block)))) - nxml-unicode-blocks))) - -;;;###autoload -(defun nxml-enable-unicode-char-name-sets () - "Enable the use of Unicode standard names for characters. -The Unicode blocks for which names are enabled is controlled by -the variable `nxml-enabled-unicode-blocks'." - (interactive) - (setq nxml-internal-unicode-char-name-sets-enabled t) - (mapc (lambda (block) - (nxml-disable-char-name-set - (nxml-unicode-block-char-name-set (car block)))) - nxml-unicode-blocks) - (mapc (lambda (nameset) - (nxml-enable-char-name-set nameset)) - nxml-enabled-unicode-blocks)) - -(provide 'nxml-uchnm) - -;;; nxml-uchnm.el ends here diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 14b887ea085..282d4952bf7 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -36,20 +36,6 @@ `(nxml-debug "%s: %S" ,name (buffer-substring-no-properties ,start ,end)))) -(defmacro nxml-debug-set-inside (start end) - (when nxml-debug - `(let ((overlay (make-overlay ,start ,end))) - (overlay-put overlay 'face '(:background "red")) - (overlay-put overlay 'nxml-inside-debug t) - (nxml-debug-change "nxml-set-inside" ,start ,end)))) - -(defmacro nxml-debug-clear-inside (start end) - (when nxml-debug - `(cl-loop for overlay in (overlays-in ,start ,end) - if (overlay-get overlay 'nxml-inside-debug) - do (delete-overlay overlay) - finally (nxml-debug-change "nxml-clear-inside" ,start ,end)))) - (defun nxml-make-namespace (str) "Return a symbol for the namespace URI STR. STR must be a string. If STR is the empty string, return nil. diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index 39aee9780ff..ed88dfa98e9 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -1,4 +1,4 @@ -;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas +;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -674,13 +674,7 @@ the primary expression." (substring rng-c-current-token n (- n))))) (defun rng-c-fix-escaped-newlines (str) - (let ((pos 0)) - (while (progn - (let ((n (string-match "\C-@" str pos))) - (and n - (aset str n ?\n) - (setq pos (1+ n))))))) - str) + (subst-char-in-string ?\C-@ ?\n str)) (defun rng-c-parse-identifier-or-keyword () (cond ((rng-c-current-token-ncname-p) diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el index 07166e38fea..a3cb8bc6aa5 100644 --- a/lisp/nxml/rng-dt.el +++ b/lisp/nxml/rng-dt.el @@ -1,4 +1,4 @@ -;;; rng-dt.el --- datatype library interface for RELAX NG +;;; rng-dt.el --- datatype library interface for RELAX NG -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -57,7 +57,7 @@ a datatype library.") (t (rng-dt-error "There is no built-in datatype %s" name)))) -(put (rng-make-datatypes-uri "") 'rng-dt-compile 'rng-dt-builtin-compile) +(put (rng-make-datatypes-uri "") 'rng-dt-compile #'rng-dt-builtin-compile) (provide 'rng-dt) diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index 553d8ca359d..376e9169d37 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el @@ -1,4 +1,4 @@ -;;; rng-loc.el --- locate the schema to use for validation +;;; rng-loc.el --- Locate the schema to use for validation -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -31,10 +31,9 @@ (require 'rng-util) (require 'xmltok) -(defvar rng-current-schema-file-name nil +(defvar-local rng-current-schema-file-name nil "Filename of schema being used for current buffer. It is nil if using a vacuous schema.") -(make-variable-buffer-local 'rng-current-schema-file-name) (defvar rng-schema-locating-files-default (list "schemas.xml" (expand-file-name "schema/schemas.xml" data-directory)) @@ -233,11 +232,11 @@ or nil." rules)))))))) best-so-far)) -(put 'documentElement 'rng-rule-matcher 'rng-match-document-element-rule) -(put 'namespace 'rng-rule-matcher 'rng-match-namespace-rule) -(put 'uri 'rng-rule-matcher 'rng-match-uri-rule) -(put 'transformURI 'rng-rule-matcher 'rng-match-transform-uri-rule) -(put 'default 'rng-rule-matcher 'rng-match-default-rule) +(put 'documentElement 'rng-rule-matcher #'rng-match-document-element-rule) +(put 'namespace 'rng-rule-matcher #'rng-match-namespace-rule) +(put 'uri 'rng-rule-matcher #'rng-match-uri-rule) +(put 'transformURI 'rng-rule-matcher #'rng-match-transform-uri-rule) +(put 'default 'rng-rule-matcher #'rng-match-default-rule) (defun rng-match-document-element-rule (props) (let ((document-element (rng-document-element)) diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index 165ca8930a4..32a041e0c17 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el @@ -1,4 +1,4 @@ -;;; rng-maint.el --- commands for RELAX NG maintainers +;;; rng-maint.el --- commands for RELAX NG maintainers -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el index df9c0192557..d2b629e8d83 100644 --- a/lisp/nxml/rng-match.el +++ b/lisp/nxml/rng-match.el @@ -56,9 +56,8 @@ Used to detect invalid recursive references.") ;;; Inline functions (defsubst rng-update-match-state (new-state) - (if (and (eq new-state rng-not-allowed-ipattern) - (not (eq rng-match-state rng-not-allowed-ipattern))) - nil + (if (eq new-state rng-not-allowed-ipattern) + (eq rng-match-state rng-not-allowed-ipattern) (setq rng-match-state new-state) t)) diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index fe90dffb555..954a1eb9599 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -1,4 +1,4 @@ -;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode +;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -33,6 +33,7 @@ (require 'rng-valid) (require 'nxml-mode) (require 'rng-loc) +(require 'sgml-mode) (defcustom rng-nxml-auto-validate-flag t "Non-nil means automatically turn on validation with nxml-mode." @@ -65,6 +66,9 @@ Complete on start-tag names regardless.") ["Validation" rng-validate-mode :style toggle :selected rng-validate-mode] + ["Electric Pairs" sgml-electric-tag-pair-mode + :style toggle + :selected sgml-electric-tag-pair-mode] "---" ("Set Schema" ["Automatically" rng-auto-set-schema] @@ -107,25 +111,15 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." 'append) (cond (rng-nxml-auto-validate-flag (rng-validate-mode 1) - (add-hook 'nxml-completion-hook 'rng-complete nil t) - (add-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p nil t)) + (add-hook 'completion-at-point-functions #'rng-completion-at-point nil t) + (add-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p nil t)) (t (rng-validate-mode 0) - (remove-hook 'nxml-completion-hook 'rng-complete t) - (remove-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p t)))) - -(defvar rng-tag-history nil) -(defvar rng-attribute-name-history nil) -(defvar rng-attribute-value-history nil) - -(defvar rng-complete-target-names nil) -(defvar rng-complete-name-attribute-flag nil) -(defvar rng-complete-extra-strings nil) + (remove-hook 'completion-at-point-functions #'rng-completion-at-point t) + (remove-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p t)))) -(defun rng-complete () - "Complete the string before point using the current schema. -Return non-nil if in a context it understands." - (interactive) +(defun rng-completion-at-point () + "Return completion data for the string before point using the current schema." (and rng-validate-mode (let ((lt-pos (save-excursion (search-backward "<" nil t))) xmltok-dtd) @@ -145,53 +139,48 @@ Return non-nil if in a context it understands." t)) (defun rng-complete-tag (lt-pos) - (let (rng-complete-extra-strings) - (when (and (= lt-pos (1- (point))) - rng-complete-end-tags-after-< - rng-open-elements - (not (eq (car rng-open-elements) t)) - (or rng-collecting-text - (rng-match-save - (rng-match-end-tag)))) - (setq rng-complete-extra-strings - (cons (concat "/" - (if (caar rng-open-elements) - (concat (caar rng-open-elements) - ":" - (cdar rng-open-elements)) - (cdar rng-open-elements))) - rng-complete-extra-strings))) + (let ((extra-strings + (when (and (= lt-pos (1- (point))) + rng-complete-end-tags-after-< + rng-open-elements + (not (eq (car rng-open-elements) t)) + (or rng-collecting-text + (rng-match-save + (rng-match-end-tag)))) + (list (concat "/" + (if (caar rng-open-elements) + (concat (caar rng-open-elements) + ":" + (cdar rng-open-elements)) + (cdar rng-open-elements))))))) (when (save-excursion (re-search-backward rng-in-start-tag-name-regex lt-pos t)) (and rng-collecting-text (rng-flush-text)) - (let ((completion - (let ((rng-complete-target-names - (rng-match-possible-start-tag-names)) - (rng-complete-name-attribute-flag nil)) - (rng-complete-before-point (1+ lt-pos) - 'rng-complete-qname-function - "Tag: " - nil - 'rng-tag-history))) - name) - (when completion - (cond ((rng-qname-p completion) - (setq name (rng-expand-qname completion - t - 'rng-start-tag-expand-recover)) - (when (and name - (rng-match-start-tag-open name) - (or (not (rng-match-start-tag-close)) - ;; need a namespace decl on the root element - (and (car name) - (not rng-open-elements)))) - ;; attributes are required - (insert " "))) - ((member completion rng-complete-extra-strings) - (insert ">"))))) - t))) + (let ((target-names (rng-match-possible-start-tag-names))) + `(,(1+ lt-pos) + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(apply-partially #'rng-complete-qname-function + target-names nil extra-strings) + :exit-function + ,(lambda (completion status) + (cond + ((not (eq status 'finished)) nil) + ((rng-qname-p completion) + (let ((name (rng-expand-qname completion + t + #'rng-start-tag-expand-recover))) + (when (and name + (rng-match-start-tag-open name) + (or (not (rng-match-start-tag-close)) + ;; need a namespace decl on the root element + (and (car name) + (not rng-open-elements)))) + ;; attributes are required + (insert " ")))) + ((member completion extra-strings) + (insert ">"))))))))) (defconst rng-in-end-tag-name-regex (replace-regexp-in-string @@ -216,29 +205,18 @@ Return non-nil if in a context it understands." (concat (caar rng-open-elements) ":" (cdar rng-open-elements)) - (cdar rng-open-elements))) - (end-tag-name - (buffer-substring-no-properties (+ (match-beginning 0) 2) - (point)))) - (cond ((or (> (length end-tag-name) - (length start-tag-name)) - (not (string= (substring start-tag-name - 0 - (length end-tag-name)) - end-tag-name))) - (message "Expected end-tag %s" - (rng-quote-string - (concat "</" start-tag-name ">"))) - (ding)) - (t - (delete-region (- (point) (length end-tag-name)) - (point)) - (insert start-tag-name ">") - (when (not (or rng-collecting-text - (rng-match-end-tag))) - (message "Element %s is incomplete" - (rng-quote-string start-tag-name)))))))) - t)) + (cdar rng-open-elements)))) + `(,(+ (match-beginning 0) 2) + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(list start-tag-name) ;Sole completion candidate. + :exit-function + ,(lambda (_completion status) + (when (eq status 'finished) + (unless (eq (char-after) ?>) (insert ">")) + (when (not (or rng-collecting-text + (rng-match-end-tag))) + (message "Element \"%s\" is incomplete" + start-tag-name)))))))))) (defconst rng-in-attribute-regex (replace-regexp-in-string @@ -260,22 +238,24 @@ Return non-nil if in a context it understands." rng-undeclared-prefixes) (and (rng-adjust-state-for-attribute lt-pos attribute-start) - (let ((rng-complete-target-names + (let ((target-names (rng-match-possible-attribute-names)) - (rng-complete-extra-strings + (extra-strings (mapcar (lambda (prefix) (if prefix (concat "xmlns:" prefix) "xmlns")) - rng-undeclared-prefixes)) - (rng-complete-name-attribute-flag t)) - (rng-complete-before-point attribute-start - 'rng-complete-qname-function - "Attribute: " - nil - 'rng-attribute-name-history)) - (insert "=\""))) - t)) + rng-undeclared-prefixes))) + `(,attribute-start + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(apply-partially #'rng-complete-qname-function + target-names t extra-strings) + :exit-function + ,(lambda (_completion status) + (when (and (eq status 'finished) + (not (looking-at "="))) + (insert "=\"\"") + (forward-char -1))))))))) (defconst rng-in-attribute-value-regex (replace-regexp-in-string @@ -292,43 +272,40 @@ Return non-nil if in a context it understands." (defun rng-complete-attribute-value (lt-pos) (when (save-excursion (re-search-backward rng-in-attribute-value-regex lt-pos t)) - (let ((name-start (match-beginning 1)) - (name-end (match-end 1)) - (colon (match-beginning 2)) - (value-start (1+ (match-beginning 3)))) + (let* ((name-start (match-beginning 1)) + (name-end (match-end 1)) + (colon (match-beginning 2)) + (value-start (1+ (match-beginning 3))) + (exit-function + (lambda (_completion status) + (when (eq status 'finished) + (let ((delim (char-before value-start))) + (unless (eq (char-after) delim) (insert delim))))))) (and (rng-adjust-state-for-attribute lt-pos name-start) (if (string= (buffer-substring-no-properties name-start (or colon name-end)) "xmlns") - (rng-complete-before-point - value-start - (rng-strings-to-completion-alist - (rng-possible-namespace-uris - (and colon - (buffer-substring-no-properties (1+ colon) name-end)))) - "Namespace URI: " - nil - 'rng-namespace-uri-history) + `(,value-start ,(point) + ,(rng-strings-to-completion-table + (rng-possible-namespace-uris + (and colon + (buffer-substring-no-properties (1+ colon) name-end)))) + :exit-function ,exit-function) (rng-adjust-state-for-attribute-value name-start colon name-end) - (rng-complete-before-point - value-start - (rng-strings-to-completion-alist - (rng-match-possible-value-strings)) - "Value: " - nil - 'rng-attribute-value-history)) - (insert (char-before value-start)))) - t)) + `(,value-start ,(point) + ,(rng-strings-to-completion-table + (rng-match-possible-value-strings)) + :exit-function ,exit-function)))))) (defun rng-possible-namespace-uris (prefix) (let ((ns (if prefix (nxml-ns-get-prefix prefix) (nxml-ns-get-default)))) (if (and ns (memq prefix (nxml-ns-changed-prefixes))) (list (nxml-namespace-name ns)) - (mapcar 'nxml-namespace-name + (mapcar #'nxml-namespace-name (delq nxml-xml-namespace-uri (rng-match-possible-namespace-uris)))))) @@ -349,7 +326,7 @@ Return non-nil if in a context it understands." (recover-fun (funcall recover-fun prefix (cdr qname))))) (cons (and defaultp (nxml-ns-get-default)) (cdr qname))))) -(defun rng-start-tag-expand-recover (prefix local-name) +(defun rng-start-tag-expand-recover (_prefix local-name) (let ((ns (rng-match-infer-start-tag-namespace local-name))) (and ns (cons ns local-name)))) @@ -386,7 +363,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (save-restriction (widen) (nxml-with-invisible-motion - (if (= pos 1) + (if (= pos (point-min)) (rng-set-initial-state) (let ((state (get-text-property (1- pos) 'rng-state))) (cond (state @@ -501,24 +478,21 @@ set `xmltok-dtd'. Returns the position of the end of the token." (and (or (not prefix) ns) (rng-match-attribute-name (cons ns local-name))))) -(defun rng-complete-qname-function (string predicate flag) - (let ((alist (mapcar (lambda (name) (cons name nil)) - (rng-generate-qname-list string)))) - (cond ((not flag) - (try-completion string alist predicate)) - ((eq flag t) - (all-completions string alist predicate)) - ((eq flag 'lambda) - (and (assoc string alist) t))))) - -(defun rng-generate-qname-list (&optional string) +(defun rng-complete-qname-function (candidates attributes-flag extra-strings + string predicate flag) + (complete-with-action flag + (rng-generate-qname-list + string candidates attributes-flag extra-strings) + string predicate)) + +(defun rng-generate-qname-list (&optional string candidates attribute-flag extra-strings) (let ((forced-prefix (and string (string-match ":" string) (> (match-beginning 0) 0) (substring string 0 (match-beginning 0)))) - (namespaces (mapcar 'car rng-complete-target-names)) + (namespaces (mapcar #'car candidates)) ns-prefixes-alist ns-prefixes iter ns prefer) (while namespaces (setq ns (car namespaces)) @@ -526,7 +500,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (setq ns-prefixes-alist (cons (cons ns (nxml-ns-prefixes-for ns - rng-complete-name-attribute-flag)) + attribute-flag)) ns-prefixes-alist))) (setq namespaces (delq ns (cdr namespaces)))) (setq iter ns-prefixes-alist) @@ -546,12 +520,12 @@ set `xmltok-dtd'. Returns the position of the end of the token." (setcdr ns-prefixes (list prefer))) ;; Unless it's an attribute with a non-nil namespace, ;; allow no prefix for this namespace. - (unless rng-complete-name-attribute-flag + (unless attribute-flag (setcdr ns-prefixes (cons nil (cdr ns-prefixes)))))) (setq iter (cdr iter))) (rng-uniquify-equal - (sort (apply 'append - (cons rng-complete-extra-strings + (sort (apply #'append + (cons extra-strings (mapcar (lambda (name) (if (car name) (mapcar (lambda (prefix) @@ -563,7 +537,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (cdr (assoc (car name) ns-prefixes-alist))) (list (cdr name)))) - rng-complete-target-names))) + candidates))) 'string<)))) (defun rng-get-preferred-unused-prefix (ns) @@ -582,10 +556,8 @@ set `xmltok-dtd'. Returns the position of the end of the token." nil)))) prefix)) -(defun rng-strings-to-completion-alist (strings) - (mapcar (lambda (s) (cons s s)) - (rng-uniquify-equal (sort (mapcar 'rng-escape-string strings) - 'string<)))) +(defun rng-strings-to-completion-table (strings) + (mapcar #'rng-escape-string strings)) (provide 'rng-nxml) diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el index cde749db672..3ae4b5cc9c4 100644 --- a/lisp/nxml/rng-parse.el +++ b/lisp/nxml/rng-parse.el @@ -1,4 +1,4 @@ -;;; rng-parse.el --- parse an XML file and validate it against a schema +;;; rng-parse.el --- parse an XML file and validate it against a schema -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el index f358d3c87d4..e847f5e02a8 100644 --- a/lisp/nxml/rng-pttrn.el +++ b/lisp/nxml/rng-pttrn.el @@ -1,4 +1,4 @@ -;;; rng-pttrn.el --- RELAX NG patterns +;;; rng-pttrn.el --- RELAX NG patterns -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index 75cf23f888d..8fc0a01e293 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el @@ -1,4 +1,4 @@ -;;; rng-uri.el --- URI parsing and manipulation +;;; rng-uri.el --- URI parsing and manipulation -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index 4c14e2b6597..c5d4b6567ed 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el @@ -82,69 +82,6 @@ LIST is not modified." (cons item nil)))))))) list))) -(defun rng-complete-before-point (start table prompt &optional predicate hist) - "Complete text between START and point. -Replaces the text between START and point with a string chosen using a -completion table and, when needed, input read from the user with the -minibuffer. -Returns the new string if either a complete and unique completion was -determined automatically or input was read from the user. Otherwise, -returns nil. -TABLE is an alist, a symbol bound to a function or an obarray as with -the function `completing-read'. -PROMPT is the string to prompt with if user input is needed. -PREDICATE is nil or a function as with `completing-read'. -HIST, if non-nil, specifies a history list as with `completing-read'." - (let* ((orig (buffer-substring-no-properties start (point))) - (completion (try-completion orig table predicate))) - (cond ((not completion) - (if (string= orig "") - (message "No completions available") - (message "No completion for %s" (rng-quote-string orig))) - (ding) - nil) - ((eq completion t) orig) - ((not (string= completion orig)) - (delete-region start (point)) - (insert completion) - (cond ((not (rng-completion-exact-p completion table predicate)) - (message "Incomplete") - nil) - ((eq (try-completion completion table predicate) t) - completion) - (t - (message "Complete but not unique") - nil))) - (t - (setq completion - (let ((saved-minibuffer-setup-hook - (default-value 'minibuffer-setup-hook))) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help - t) - (unwind-protect - (completing-read prompt - table - predicate - nil - orig - hist) - (setq-default minibuffer-setup-hook - saved-minibuffer-setup-hook)))) - (delete-region start (point)) - (insert completion) - completion)))) - -(defun rng-completion-exact-p (string table predicate) - (cond ((symbolp table) - (funcall table string predicate 'lambda)) - ((vectorp table) - (intern-soft string table)) - (t (assoc string table)))) - -(defun rng-quote-string (s) - (concat "\"" s "\"")) - (defun rng-escape-string (s) (replace-regexp-in-string "[&\"<>]" (lambda (match) diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 1020cad2089..239b1d11db1 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -1,4 +1,4 @@ -;;; rng-valid.el --- real-time validation of XML using RELAX NG +;;; rng-valid.el --- real-time validation of XML using RELAX NG -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -101,7 +101,7 @@ (defgroup relax-ng nil "Validation of XML using RELAX NG." - :group 'wp + :group 'text :group 'nxml :group 'languages) @@ -430,13 +430,13 @@ The schema is set like `rng-auto-set-schema'." (when (buffer-live-p buffer) ; bug#13999 (with-current-buffer buffer (if rng-validate-mode - (if (let ((rng-validate-display-point (point)) - (rng-validate-display-modified-p (buffer-modified-p))) - (rng-do-some-validation 'rng-validate-while-idle-continue-p)) - (force-mode-line-update) - (rng-validate-done)) - ;; must have done kill-all-local-variables - (rng-kill-timers))))) + (if (let ((rng-validate-display-point (point)) + (rng-validate-display-modified-p (buffer-modified-p))) + (rng-do-some-validation 'rng-validate-while-idle-continue-p)) + (force-mode-line-update) + (rng-validate-done)) + ;; Must have done kill-all-local-variables. + (rng-kill-timers))))) (defun rng-validate-quick-while-idle (buffer) (when (buffer-live-p buffer) ; bug#13999 @@ -709,7 +709,7 @@ Return t if there is work to do, nil otherwise." ;; If we don't do this, then the front delimiter can move ;; past the end delimiter. -(defun rng-error-modified (overlay after-p beg end &optional pre-change-len) +(defun rng-error-modified (overlay after-p _beg _end &optional _pre-change-len) (when (and after-p (overlay-start overlay) ; check not deleted (>= (overlay-start overlay) @@ -1138,9 +1138,8 @@ as empty-element." (rng-match-start-tag-open required) (rng-match-after) (rng-match-start-tag-open name)) - (rng-mark-invalid (concat "Missing element " - (rng-quote-string - (rng-name-to-string required))) + (rng-mark-invalid (format "Missing element \"%s\"" + (rng-name-to-string required)) xmltok-start (1+ xmltok-start))) ((and (rng-match-optionalize-elements) @@ -1177,16 +1176,14 @@ as empty-element." (cond ((not required-attributes) "Required attributes missing") ((not (cdr required-attributes)) - (concat "Missing attribute " - (rng-quote-string - (rng-name-to-string (car required-attributes) t)))) + (format "Missing attribute \"%s\"" + (rng-name-to-string (car required-attributes) t))) (t - (concat "Missing attributes " + (format "Missing attributes \"%s\"" (mapconcat (lambda (nm) - (rng-quote-string - (rng-name-to-string nm t))) + (rng-name-to-string nm t)) required-attributes - ", ")))))) + "\", \"")))))) (defun rng-process-end-tag (&optional partial) (cond ((not rng-open-elements) @@ -1229,8 +1226,7 @@ as empty-element." (defun rng-missing-element-message () (let ((element (rng-match-required-element-name))) (if element - (concat "Missing element " - (rng-quote-string (rng-name-to-string element))) + (format "Missing element \"%s\"" (rng-name-to-string element)) "Required child elements missing"))) (defun rng-recover-mismatched-end-tag () @@ -1258,17 +1254,16 @@ as empty-element." (defun rng-mark-missing-end-tags (missing) (rng-mark-not-well-formed - (format "Missing end-tag%s %s" + (format "Missing end-tag%s \"%s\"" (if (null (cdr missing)) "" "s") (mapconcat (lambda (name) - (rng-quote-string - (if (car name) - (concat (car name) - ":" - (cdr name)) - (cdr name)))) + (if (car name) + (concat (car name) + ":" + (cdr name)) + (cdr name))) missing - ", ")) + "\", \"")) xmltok-start (+ xmltok-start 2))) diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el index 378319851a0..c0989ae1073 100644 --- a/lisp/nxml/rng-xsd.el +++ b/lisp/nxml/rng-xsd.el @@ -1,4 +1,4 @@ -;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG +;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -42,7 +42,7 @@ ;;;###autoload (put 'http://www.w3.org/2001/XMLSchema-datatypes 'rng-dt-compile - 'rng-xsd-compile) + #'rng-xsd-compile) ;;;###autoload (defun rng-xsd-compile (name params) @@ -50,9 +50,9 @@ NAME is a symbol giving the local name of the datatype. PARAMS is a list of pairs (PARAM-NAME . PARAM-VALUE) where PARAM-NAME is a symbol giving the name of the parameter and PARAM-VALUE is a string giving -its value. If NAME or PARAMS are invalid, it calls rng-dt-error +its value. If NAME or PARAMS are invalid, it calls `rng-dt-error' passing it arguments in the same style as format; the value from -rng-dt-error will be returned. Otherwise, it returns a list. The +`rng-dt-error' will be returned. Otherwise, it returns a list. The first member of the list is t if any string is a legal value for the datatype and nil otherwise. The second argument is a symbol; this symbol will be called as a function passing it a string followed by diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 8fc66c99a45..f12905a86d0 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -34,10 +34,7 @@ ;; preceding part of the instance. This allows the instance to be ;; parsed incrementally. The main entry point is `xmltok-forward': ;; this can be called at any point in the instance provided it is -;; between tokens. The other entry point is `xmltok-forward-special' -;; which skips over tokens other comments, processing instructions or -;; CDATA sections (i.e. the constructs in an instance that can contain -;; less than signs that don't start a token). +;; between tokens. ;; ;; This is a non-validating XML 1.0 processor. It does not resolve ;; parameter entities (including the external DTD subset) and it does @@ -262,11 +259,10 @@ and VALUE-END, otherwise a STRING giving the value." (vector message start end)) (defun xmltok-add-error (message &optional start end) - (setq xmltok-errors - (cons (xmltok-make-error message - (or start xmltok-start) - (or end (point))) - xmltok-errors))) + (push (xmltok-make-error message + (or start xmltok-start) + (or end (point))) + xmltok-errors)) (defun xmltok-forward () (setq xmltok-start (point)) @@ -308,18 +304,6 @@ and VALUE-END, otherwise a STRING giving the value." (goto-char (point-max)) (setq xmltok-type 'data))))) -(defun xmltok-forward-special (bound) - "Scan forward past the first special token starting at or after point. -Return nil if there is no special token that starts before BOUND. -CDATA sections, processing instructions and comments (and indeed -anything starting with < following by ? or !) count as special. -Return the type of the token." - (when (re-search-forward "<[?!]" (1+ bound) t) - (setq xmltok-start (match-beginning 0)) - (goto-char (1+ xmltok-start)) - (let ((case-fold-search nil)) - (xmltok-scan-after-lt)))) - (eval-when-compile ;; A symbolic regexp is represented by a list whose CAR is the string @@ -739,19 +723,10 @@ Return the type of the token." (setq xmltok-type 'processing-instruction)) (defun xmltok-scan-after-comment-open () - (let ((found-- (search-forward "--" nil 'move))) - (setq xmltok-type - (cond ((or (eq (char-after) ?>) (not found--)) - (goto-char (1+ (point))) - 'comment) - (t - ;; just include the <!-- in the token - (goto-char (+ xmltok-start 4)) - ;; Need do this after the goto-char because - ;; marked error should just apply to <!-- - (xmltok-add-error "First following `--' not followed by `>'") - (goto-char (point-max)) - 'comment))))) + (while (and (re-search-forward "--\\(>\\)?" nil 'move) + (not (match-end 1))) + (xmltok-add-error "`--' not followed by `>'" (match-beginning 0))) + (setq xmltok-type 'comment)) (defun xmltok-scan-attributes () (let ((recovering nil) diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index e91e6b77a7d..a3f476d00be 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -1,4 +1,4 @@ -;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps +;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc. @@ -147,7 +147,7 @@ ranges are merged wherever possible." (defun xsdre-range-list-difference (orig subtract) "Return a range-list for the difference of two range-lists." (when orig - (let (new head next first last) + (let (new head first last) (while orig (setq head (car orig)) (setq first (xsdre-range-first head)) @@ -745,7 +745,7 @@ Code is inserted into the current buffer." (save-excursion (goto-char start) (down-list 2) - (while (condition-case err + (while (condition-case nil (progn (forward-sexp) t) diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el deleted file mode 100644 index b9e4e4072e0..00000000000 --- a/lisp/obsolete/awk-mode.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; awk-mode.el --- AWK code editing commands for Emacs - -;; Copyright (C) 1988, 1994, 1996, 2000-2016 Free Software Foundation, -;; Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: unix, languages -;; Obsolete-since: 22.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: - -;; Sets up C-mode with support for awk-style #-comments and a lightly -;; hacked syntax table. - -;;; Code: - -(defvar awk-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) - ;; / can delimit regexes or be a division operator. We assume that it is - ;; more commonly used for regexes and fix the remaining cases with - ;; `font-lock-syntactic-keywords'. - (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) - (modify-syntax-entry ?_ "_" st) - (modify-syntax-entry ?\' "\"" st) - st) - "Syntax table in use in `awk-mode' buffers.") - -;; Regexps written with help from Peter Galbraith <galbraith@mixing.qc.dfo.ca>. -(defconst awk-font-lock-keywords - (eval-when-compile - (list - ;; - ;; Function names. - '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) - ;; - ;; Variable names. - (cons (regexp-opt - '("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO" - "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR" - "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP") 'words) - 'font-lock-variable-name-face) - ;; - ;; Keywords. - (regexp-opt - '("BEGIN" "END" "break" "continue" "delete" "do" "exit" "else" "for" - "getline" "if" "next" "print" "printf" "return" "while") 'words) - ;; - ;; Builtins. - (list (regexp-opt - '("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int" - "length" "log" "match" "rand" "sin" "split" "sprintf" - "sqrt" "srand" "sub" "substr" "system" "time" - "tolower" "toupper") 'words) - 1 'font-lock-builtin-face) - ;; - ;; Operators. Is this too much? - (cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~")) - 'font-lock-constant-face) - )) - "Default expressions to highlight in AWK mode.") - -(require 'syntax) - -(defconst awk-font-lock-syntactic-keywords - ;; `/' is mostly used for /.../ regular expressions, but is also - ;; used as a division operator. Distinguishing between the two is - ;; a pain in the youknowwhat. - ;; '(("\\(^\\|[<=>-+*%/!^,~(?:|&]\\)\\s-*\\(/\\)\\([^/\n\\]\\|\\\\.\\)*\\(/\\)" - ;; (2 "\"") (4 "\""))) - '(("[^<=>-+*%/!^,~(?:|& \t\n\f]\\s-*\\(/\\)" - (1 (unless (nth 3 (syntax-ppss (match-beginning 1))) ".")))) - "Syntactic keywords for `awk-mode'.") - -;; No longer autoloaded since it might clobber the autoload directive in CC Mode. -(define-derived-mode awk-mode c-mode "AWK" - "Major mode for editing AWK code. -This is much like C mode except for the syntax of comments. Its keymap -inherits from C mode's and it has the same variables for customizing -indentation. It has its own abbrev table and its own syntax table. - -Turning on AWK mode runs `awk-mode-hook'." - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "#+ *") - (setq font-lock-defaults '(awk-font-lock-keywords - nil nil ((?_ . "w")) nil - (parse-sexp-lookup-properties . t) - (font-lock-syntactic-keywords - . awk-font-lock-syntactic-keywords)))) - -(provide 'awk-mode) - -;;; awk-mode.el ends here diff --git a/lisp/gs.el b/lisp/obsolete/gs.el index 7ab3d8b3ca5..c4cdcebff8e 100644 --- a/lisp/gs.el +++ b/lisp/obsolete/gs.el @@ -4,6 +4,7 @@ ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal +;; Obsolete-since: 26.1 ;; This file is part of GNU Emacs. @@ -22,7 +23,9 @@ ;;; Commentary: -;; This code is experimental. Don't use it. +;; This code is experimental. Don't use it. Try imagemagick images instead. +;; When this file is removed from Emacs, associated code in image.c +;; can be removed too (HAVE_GHOSTSCRIPT). ;;; Code: diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el deleted file mode 100644 index 7bec92c2bd0..00000000000 --- a/lisp/obsolete/iso-acc.el +++ /dev/null @@ -1,489 +0,0 @@ -;;; iso-acc.el --- minor mode providing electric accent keys - -;; Copyright (C) 1993-1994, 1996, 2001-2016 Free Software Foundation, -;; Inc. - -;; Author: Johan Vromans -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.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: - -;; Function `iso-accents-mode' activates a minor mode in which -;; typewriter "dead keys" are emulated. The purpose of this emulation -;; is to provide a simple means for inserting accented characters -;; according to the ISO-8859-1...3 character sets. -;; -;; In `iso-accents-mode', pseudo accent characters are used to -;; introduce accented keys. The pseudo-accent characters are: -;; -;; ' (minute) -> acute accent -;; ` (backtick) -> grave accent -;; " (second) -> diaeresis -;; ^ (caret) -> circumflex -;; ~ (tilde) -> tilde over the character -;; / (slash) -> slash through the character. -;; Also: /A is A-with-ring and /E is AE ligature. -;; These two are enabled only if you set iso-accents-enable -;; to include them: -;; . (period) -> dot over the character (some languages only) -;; , (cedilla) -> cedilla under the character (some languages only) -;; -;; The action taken depends on the key that follows the pseudo accent. -;; In general: -;; -;; pseudo-accent + appropriate letter -> accented letter -;; pseudo-accent + space -> pseudo-accent (except comma and period) -;; pseudo-accent + pseudo-accent -> accent (if available) -;; pseudo-accent + other -> pseudo-accent + other -;; -;; If the pseudo-accent is followed by anything else than a -;; self-insert-command, the dead-key code is terminated, the -;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this. -;; -;; Function `iso-accents-mode' can be used to enable the iso accents -;; minor mode, or disable it. - -;; If you want only some of these characters to serve as accents, -;; add a language to `iso-languages' which specifies the accent characters -;; that you want, then select the language with `iso-accents-customize'. - -;;; Code: - -(provide 'iso-acc) - -(defgroup iso-acc nil - "Minor mode providing electric accent keys." - :prefix "iso-accents-" - :group 'i18n) - -(defcustom iso-accents-insert-offset nonascii-insert-offset - "Offset added by ISO Accents mode to character codes 0200 and above." - :type 'integer - :group 'iso-acc) - -(defvar iso-languages - '(("catalan" - ;; Note this includes some extra characters used in Spanish, - ;; on the idea that someone who uses Catalan is likely to use Spanish - ;; as well. - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?O . ?\322) - (?a . ?\340) (?e . ?\350) (?o . ?\362) - (?\ . ?`)) - (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) - (?\ . ?\")) - (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\ . ?\~))) - - ("esperanto" - (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306) - (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376) - (?^ . ?^) (?\ . ?^)) - (?~ (?U . ?\335) (?u . ?\375) (?\ . ?~))) - - ("french" - (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?u . ?\371) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?\ . ?^)) - (?\" (?E . ?\313) (?I . ?\317) - (?e . ?\353) (?i . ?\357) - (?\ . ?\")) - (?~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) - (?\ . ?~)) - (?, (?C . ?\307) (?c . ?\347) (?\ . ?\,))) - - ("german" - (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\ . ?\"))) - - ("irish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?'))) - - ("portuguese" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?c . ?\347) - (?\ . ?')) - (?` (?A . ?\300) (?a . ?\340) - (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) - (?a . ?\342) (?e . ?\352) (?o . ?\364) - (?\ . ?^)) - (?\" (?U . ?\334) (?u . ?\374) - (?\ . ?\")) - (?~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) - (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361) - (?\ . ?~)) - (?, (?c . ?\347) (?C . ?\307) (?, . ?,))) - - ("spanish" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?\ . ?')) - (?\" (?U . ?\334) (?u . ?\374) (?\ . ?\")) - (?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241) - (?? . ?\277) (?\ . ?\~))) - - ("latin-1" - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) - (?u . ?\372) (?y . ?\375) (?' . ?\264) - (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333) - (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337) - (?u . ?\374) (?y . ?\377) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) - (?o . ?\365) (?t . ?\376) - (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277) - (?\~ . ?\270) (?\ . ?~)) - (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346) - (?o . ?\370) - (?/ . ?\260) (?\ . ?/))) - - ("latin-2" latin-iso8859-2 - (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315) - (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246) - (?U . ?\332) (?Y . ?\335) (?Z . ?\254) - (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355) - (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266) - (?u . ?\372) (?y . ?\375) (?z . ?\274) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252) - (?T . ?\336) (?Z . ?\257) - (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272) - (?t . ?\376) (?z . ?\277) - (?` . ?\252) - (?. . ?\377) (?\ . ?`)) - (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324) - (?a . ?\342) (?i . ?\356) (?o . ?\364) - (?^ . ?^) ; no special code? - (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374) - (?\" . ?\250) - (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322) - (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333) - (?Z . ?\256) - (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362) - (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373) - (?z . ?\276) - (?v . ?\242) ; v accent - (?\~ . ?\242) ; v accent - (?\. . ?\270) ; cedilla accent - (?\ . ?~))) - - ("latin-3" latin-iso8859-3 - (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332) - (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372) - (?' . ?\264) (?\ . ?')) - (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331) - (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371) - (?` . ?`) (?\ . ?`)) - (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330) (?H . ?\246) - (?I . ?\316) (?J . ?\254) (?O . ?\324) (?S . ?\336) (?U . ?\333) - (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266) - (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373) - (?^ . ?^) (?\ . ?^)) - (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334) - (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374) - (?s . ?\337) - (?\" . ?\250) (?\ . ?\")) - (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325) - (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365) - (?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273) - (?U . ?\335) (?u . ?\375) (?` . ?\242) - (?~ . ?\270) (?\ . ?~)) - (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277) - (?r . ?\256) - (?. . ?\377) (?# . ?\243) (?$ . ?\244) - (?/ . ?\260) (?\ . ?/)) - (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257) - (?c . ?\345) (?g . ?\365) (?z . ?\277)))) - "List of language-specific customizations for the ISO Accents mode. - -Each element of the list is of the form - - (LANGUAGE [CHARSET] - (PSEUDO-ACCENT MAPPINGS) - (PSEUDO-ACCENT MAPPINGS) - ...) - -LANGUAGE is a string naming the language. -CHARSET (which may be omitted) is the symbol name - of the character set used in this language. - If CHARSET is omitted, latin-iso8859-1 is the default. -PSEUDO-ACCENT is a char specifying an accent key. -MAPPINGS are cons cells of the form (CHAR . ISO-CHAR). - -The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped -to ISO-CHAR on input.") - -(defvar iso-language nil - "Language for which ISO Accents mode is currently customized. -Change it with the `iso-accents-customize' function.") - -(defvar iso-accents-list nil - "Association list for ISO accent combinations, for the chosen language.") - -(defcustom iso-accents-mode nil - "Non-nil enables ISO Accents mode. -Setting this variable makes it local to the current buffer. -See the function `iso-accents-mode'." - :type 'boolean - :group 'iso-acc) -(make-variable-buffer-local 'iso-accents-mode) - -(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/) - "List of accent keys that become prefixes in ISO Accents mode. -The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported -accent keys. If you set this variable to a list in which some of those -characters are missing, the missing ones do not act as accents. - -Note that if you specify a language with `iso-accents-customize', -that can also turn off certain prefixes (whichever ones are not needed in -the language you choose)." - :type '(repeat character) - :group 'iso-acc) - -(defun iso-accents-accent-key (prompt) - "Modify the following character by adding an accent to it." - ;; Pick up the accent character. - (if (and iso-accents-mode - (memq last-input-event iso-accents-enable)) - (iso-accents-compose prompt) - (vector last-input-event))) - - -;; The iso-accents-compose function is called deep inside Emacs' read -;; key sequence machinery, so the call to read-event below actually -;; recurses into that machinery. Doing that does not cause any -;; problem on its own, but read-event will have marked the window's -;; display matrix to be accurate -- which is broken by the subsequent -;; call to delete-region. Therefore, we must call force-window-update -;; after delete-region to explicitly clear the accurate state of the -;; window's display matrix. - -(defun iso-accents-compose (prompt) - (let* ((first-char last-input-event) - (list (assq first-char iso-accents-list)) - ;; Wait for the second key and look up the combination. - (second-char (if (or prompt - (not (eq (key-binding "a") - 'self-insert-command)) - ;; Not at start of a key sequence. - (> (length (this-single-command-keys)) 1) - ;; Called from anything but the command loop. - this-command) - (progn - (message "%s%c" - (or prompt "Compose with ") - first-char) - (read-event)) - (insert first-char) - (prog1 (read-event) - (delete-region (1- (point)) (point)) - ;; Display is no longer up-to-date. - (force-window-update (selected-window))))) - (entry (cdr (assq second-char list)))) - (if entry - ;; Found it: return the mapped char - (vector - (if (and enable-multibyte-characters - (>= entry ?\200)) - (+ iso-accents-insert-offset entry) - entry)) - ;; Otherwise, advance and schedule the second key for execution. - (push second-char unread-command-events) - (vector first-char)))) - -;; It is a matter of taste if you want the minor mode indicated -;; in the mode line... -;; If so, uncomment the next four lines. -;; (or (assq 'iso-accents-mode minor-mode-alist) -;; (setq minor-mode-alist -;; (append minor-mode-alist -;; '((iso-accents-mode " ISO-Acc"))))) - -;;;###autoload -(defun iso-accents-mode (&optional arg) - "Toggle ISO Accents mode, in which accents modify the following letter. -This permits easy insertion of accented characters according to ISO-8859-1. -When Iso-accents mode is enabled, accent character keys -\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following -letter key so that it inserts an ISO accented letter. - -You can customize ISO Accents mode to a particular language -with the command `iso-accents-customize'. - -Special combinations: ~c gives a c with cedilla, -~d gives an Icelandic eth (d with dash). -~t gives an Icelandic thorn. -\"s gives German sharp s. -/a gives a with ring. -/e gives an a-e ligature. -~< and ~> give guillemots. -~! gives an inverted exclamation mark. -~? gives an inverted question mark. - -With an argument, a positive argument enables ISO Accents mode, -and a negative argument disables it." - - (interactive "P") - - (if (if arg - ;; Negative arg means switch it off. - (<= (prefix-numeric-value arg) 0) - ;; No arg means toggle. - iso-accents-mode) - (setq iso-accents-mode nil) - - ;; Enable electric accents. - (setq iso-accents-mode t))) - -(defun iso-accents-customize (language) - "Customize the ISO accents machinery for a particular language. -It selects the customization based on the specifications in the -`iso-languages' variable." - (interactive (list (completing-read "Language: " iso-languages nil t))) - (let ((table (cdr (assoc language iso-languages))) - all-accents tail) - (if (not table) - (error "Unknown language `%s'" language) - (setq iso-accents-insert-offset (- (make-char (if (symbolp (car table)) - (car table) - 'latin-iso8859-1)) - 128)) - (if (symbolp (car table)) - (setq table (cdr table))) - (setq iso-language language - iso-accents-list table) - (if key-translation-map - (substitute-key-definition - 'iso-accents-accent-key nil key-translation-map) - (setq key-translation-map (make-sparse-keymap))) - ;; Set up translations for all the characters that are used as - ;; accent prefixes in this language. - (setq tail iso-accents-list) - (while tail - (define-key key-translation-map (vector (car (car tail))) - 'iso-accents-accent-key) - (setq tail (cdr tail)))))) - -(defun iso-accentuate (start end) - "Convert two-character sequences in region into accented characters. -Noninteractively, this operates on text from START to END. -This uses the same conversion that ISO Accents mode uses for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (forward-char 1) - (let (entry) - (while (< (point) end) - (if (and (memq (preceding-char) iso-accents-enable) - (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list))))) - (progn - (forward-char -1) - (delete-char 2) - (insert entry) - (setq end (1- end))) - (forward-char 1))))))) - -(defun iso-accent-rassoc-unit (value alist) - (let (elt acc) - (while (and alist (not elt)) - (setq acc (car (car alist)) - elt (car (rassq value (cdr (car alist)))) - alist (cdr alist))) - (if elt - (cons acc elt)))) - -(defun iso-unaccentuate (start end) - "Convert accented characters in the region into two-character sequences. -Noninteractively, this operates on text from START to END. -This uses the opposite of the conversion done by ISO Accents mode for type-in." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (car entry) (cdr entry)) - (setq end (1+ end))) - (forward-char 1))))))) - -(defun iso-deaccentuate (start end) - "Convert accented characters in the region into unaccented characters. -Noninteractively, this operates on text from START to END." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let (entry) - (while (< (point) end) - (if (and (> (following-char) 127) - (setq entry (iso-accent-rassoc-unit (following-char) - iso-accents-list))) - (progn - (delete-char 1) - (insert (cdr entry))) - (forward-char 1))))))) - -;; Set up the default settings. -(iso-accents-customize "latin-1") - -;; Use Iso-Accents mode in the minibuffer -;; if it was in use in the previous buffer. -(defun iso-acc-minibuf-setup () - (setq iso-accents-mode - (with-current-buffer (window-buffer minibuffer-scroll-window) - iso-accents-mode))) - -(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup) - -;;; iso-acc.el ends here diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el deleted file mode 100644 index dcb9e3d3072..00000000000 --- a/lisp/obsolete/iso-insert.el +++ /dev/null @@ -1,630 +0,0 @@ -;;; iso-insert.el --- insert functions for ISO 8859/1 - -;; Copyright (C) 1987, 1994, 2001-2016 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.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: - -;; Provides keys for inserting ISO Latin-1 characters. They use the -;; prefix key C-x 8. Type C-x 8 C-h for a list. - -;;; Code: - -(defun insert-no-break-space () - (interactive "*") - (insert ?\ ) -) - -(defun insert-inverted-exclamation-mark () - (interactive "*") - (insert ?\¡) -) - -(defun insert-cent-sign () - (interactive "*") - (insert ?\¢) -) - -(defun insert-pound-sign () - (interactive "*") - (insert ?\£) -) - -(defun insert-general-currency-sign () - (interactive "*") - (insert ?\¤) -) - -(defun insert-yen-sign () - (interactive "*") - (insert ?\¥) -) - -(defun insert-broken-vertical-line () - (interactive "*") - (insert ?\¦) -) - -(defun insert-section-sign () - (interactive "*") - (insert ?\§) -) - -(defun insert-diaeresis () - (interactive "*") - (insert ?\¨) -) - -(defun insert-copyright-sign () - (interactive "*") - (insert ?\©) -) - -(defun insert-ordinal-indicator-feminine () - (interactive "*") - (insert ?\ª) -) - -(defun insert-angle-quotation-mark-left () - (interactive "*") - (insert ?\«) -) - -(defun insert-not-sign () - (interactive "*") - (insert ?\¬) -) - -(defun insert-soft-hyphen () - (interactive "*") - (insert ?\) -) - -(defun insert-registered-sign () - (interactive "*") - (insert ?\®) -) - -(defun insert-macron () - (interactive "*") - (insert ?\¯) -) - -(defun insert-degree-sign () - (interactive "*") - (insert ?\°) -) - -(defun insert-plus-or-minus-sign () - (interactive "*") - (insert ?\±) -) - -(defun insert-superscript-two () - (interactive "*") - (insert ?\²) -) - -(defun insert-superscript-three () - (interactive "*") - (insert ?\³) -) - -(defun insert-acute-accent () - (interactive "*") - (insert ?\´) -) - -(defun insert-micro-sign () - (interactive "*") - (insert ?\µ) -) - -(defun insert-pilcrow () - (interactive "*") - (insert ?\¶) -) - -(defun insert-middle-dot () - (interactive "*") - (insert ?\·) -) - -(defun insert-cedilla () - (interactive "*") - (insert ?\¸) -) - -(defun insert-superscript-one () - (interactive "*") - (insert ?\¹) -) - -(defun insert-ordinal-indicator-masculine () - (interactive "*") - (insert ?\º) -) - -(defun insert-angle-quotation-mark-right () - (interactive "*") - (insert ?\») -) - -(defun insert-fraction-one-quarter () - (interactive "*") - (insert ?\¼) -) - -(defun insert-fraction-one-half () - (interactive "*") - (insert ?\½) -) - -(defun insert-fraction-three-quarters () - (interactive "*") - (insert ?\¾) -) - -(defun insert-inverted-question-mark () - (interactive "*") - (insert ?\¿) -) - -(defun insert-A-grave () - (interactive "*") - (insert ?\À) -) - -(defun insert-A-acute () - (interactive "*") - (insert ?\Á) -) - -(defun insert-A-circumflex () - (interactive "*") - (insert ?\Â) -) - -(defun insert-A-tilde () - (interactive "*") - (insert ?\Ã) -) - -(defun insert-A-umlaut () - (interactive "*") - (insert ?\Ä) -) - -(defun insert-A-ring () - (interactive "*") - (insert ?\Å) -) - -(defun insert-AE () - (interactive "*") - (insert ?\Æ) -) - -(defun insert-C-cedilla () - (interactive "*") - (insert ?\Ç) -) - -(defun insert-E-grave () - (interactive "*") - (insert ?\È) -) - -(defun insert-E-acute () - (interactive "*") - (insert ?\É) -) - -(defun insert-E-circumflex () - (interactive "*") - (insert ?\Ê) -) - -(defun insert-E-umlaut () - (interactive "*") - (insert ?\Ë) -) - -(defun insert-I-grave () - (interactive "*") - (insert ?\Ì) -) - -(defun insert-I-acute () - (interactive "*") - (insert ?\Í) -) - -(defun insert-I-circumflex () - (interactive "*") - (insert ?\Î) -) - -(defun insert-I-umlaut () - (interactive "*") - (insert ?\Ï) -) - -(defun insert-D-stroke () - (interactive "*") - (insert ?\Ð) -) - -(defun insert-N-tilde () - (interactive "*") - (insert ?\Ñ) -) - -(defun insert-O-grave () - (interactive "*") - (insert ?\Ò) -) - -(defun insert-O-acute () - (interactive "*") - (insert ?\Ó) -) - -(defun insert-O-circumflex () - (interactive "*") - (insert ?\Ô) -) - -(defun insert-O-tilde () - (interactive "*") - (insert ?\Õ) -) - -(defun insert-O-umlaut () - (interactive "*") - (insert ?\Ö) -) - -(defun insert-multiplication-sign () - (interactive "*") - (insert ?\×) -) - -(defun insert-O-slash () - (interactive "*") - (insert ?\Ø) -) - -(defun insert-U-grave () - (interactive "*") - (insert ?\Ù) -) - -(defun insert-U-acute () - (interactive "*") - (insert ?\Ú) -) - -(defun insert-U-circumflex () - (interactive "*") - (insert ?\Û) -) - -(defun insert-U-umlaut () - (interactive "*") - (insert ?\Ü) -) - -(defun insert-Y-acute () - (interactive "*") - (insert ?\Ý) -) - -(defun insert-THORN () - (interactive "*") - (insert ?\Þ) -) - -(defun insert-ss () - (interactive "*") - (insert ?\ß) -) - -(defun insert-a-grave () - (interactive "*") - (insert ?\à) -) - -(defun insert-a-acute () - (interactive "*") - (insert ?\á) -) - -(defun insert-a-circumflex () - (interactive "*") - (insert ?\â) -) - -(defun insert-a-tilde () - (interactive "*") - (insert ?\ã) -) - -(defun insert-a-umlaut () - (interactive "*") - (insert ?\ä) -) - -(defun insert-a-ring () - (interactive "*") - (insert ?\å) -) - -(defun insert-ae () - (interactive "*") - (insert ?\æ) -) - -(defun insert-c-cedilla () - (interactive "*") - (insert ?\ç) -) - -(defun insert-e-grave () - (interactive "*") - (insert ?\è) -) - -(defun insert-e-acute () - (interactive "*") - (insert ?\é) -) - -(defun insert-e-circumflex () - (interactive "*") - (insert ?\ê) -) - -(defun insert-e-umlaut () - (interactive "*") - (insert ?\ë) -) - -(defun insert-i-grave () - (interactive "*") - (insert ?\ì) -) - -(defun insert-i-acute () - (interactive "*") - (insert ?\í) -) - -(defun insert-i-circumflex () - (interactive "*") - (insert ?\î) -) - -(defun insert-i-umlaut () - (interactive "*") - (insert ?\ï) -) - -(defun insert-d-stroke () - (interactive "*") - (insert ?\ð) -) - -(defun insert-n-tilde () - (interactive "*") - (insert ?\ñ) -) - -(defun insert-o-grave () - (interactive "*") - (insert ?\ò) -) - -(defun insert-o-acute () - (interactive "*") - (insert ?\ó) -) - -(defun insert-o-circumflex () - (interactive "*") - (insert ?\ô) -) - -(defun insert-o-tilde () - (interactive "*") - (insert ?\õ) -) - -(defun insert-o-umlaut () - (interactive "*") - (insert ?\ö) -) - -(defun insert-division-sign () - (interactive "*") - (insert ?\÷) -) - -(defun insert-o-slash () - (interactive "*") - (insert ?\ø) -) - -(defun insert-u-grave () - (interactive "*") - (insert ?\ù) -) - -(defun insert-u-acute () - (interactive "*") - (insert ?\ú) -) - -(defun insert-u-circumflex () - (interactive "*") - (insert ?\û) -) - -(defun insert-u-umlaut () - (interactive "*") - (insert ?\ü) -) - -(defun insert-y-acute () - (interactive "*") - (insert ?\ý) -) - -(defun insert-thorn () - (interactive "*") - (insert ?\þ) -) - -(defun insert-y-umlaut () - (interactive "*") - (insert ?\ÿ) -) - -(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.") -(if 8859-1-map nil - (setq 8859-1-map (make-keymap)) - (define-key 8859-1-map " " 'insert-no-break-space) - (define-key 8859-1-map "!" 'insert-inverted-exclamation-mark) - (define-key 8859-1-map "\"" (make-sparse-keymap)) - (define-key 8859-1-map "\"\"" 'insert-diaeresis) - (define-key 8859-1-map "\"A" 'insert-A-umlaut) - (define-key 8859-1-map "\"E" 'insert-E-umlaut) - (define-key 8859-1-map "\"I" 'insert-I-umlaut) - (define-key 8859-1-map "\"O" 'insert-O-umlaut) - (define-key 8859-1-map "\"U" 'insert-U-umlaut) - (define-key 8859-1-map "\"a" 'insert-a-umlaut) - (define-key 8859-1-map "\"e" 'insert-e-umlaut) - (define-key 8859-1-map "\"i" 'insert-i-umlaut) - (define-key 8859-1-map "\"o" 'insert-o-umlaut) - (define-key 8859-1-map "\"u" 'insert-u-umlaut) - (define-key 8859-1-map "\"y" 'insert-y-umlaut) - (define-key 8859-1-map "'" (make-sparse-keymap)) - (define-key 8859-1-map "''" 'insert-acute-accent) - (define-key 8859-1-map "'A" 'insert-A-acute) - (define-key 8859-1-map "'E" 'insert-E-acute) - (define-key 8859-1-map "'I" 'insert-I-acute) - (define-key 8859-1-map "'O" 'insert-O-acute) - (define-key 8859-1-map "'U" 'insert-U-acute) - (define-key 8859-1-map "'Y" 'insert-Y-acute) - (define-key 8859-1-map "'a" 'insert-a-acute) - (define-key 8859-1-map "'e" 'insert-e-acute) - (define-key 8859-1-map "'i" 'insert-i-acute) - (define-key 8859-1-map "'o" 'insert-o-acute) - (define-key 8859-1-map "'u" 'insert-u-acute) - (define-key 8859-1-map "'y" 'insert-y-acute) - (define-key 8859-1-map "$" 'insert-general-currency-sign) - (define-key 8859-1-map "+" 'insert-plus-or-minus-sign) - (define-key 8859-1-map "," (make-sparse-keymap)) - (define-key 8859-1-map ",," 'insert-cedilla) - (define-key 8859-1-map ",C" 'insert-C-cedilla) - (define-key 8859-1-map ",c" 'insert-c-cedilla) - (define-key 8859-1-map "-" 'insert-soft-hyphen) - (define-key 8859-1-map "." 'insert-middle-dot) - (define-key 8859-1-map "/" (make-sparse-keymap)) - (define-key 8859-1-map "//" 'insert-division-sign) - (define-key 8859-1-map "/O" 'insert-O-slash) - (define-key 8859-1-map "/o" 'insert-o-slash) - (define-key 8859-1-map "1" (make-sparse-keymap)) - (define-key 8859-1-map "1/" (make-sparse-keymap)) - (define-key 8859-1-map "1/2" 'insert-fraction-one-half) - (define-key 8859-1-map "1/4" 'insert-fraction-one-quarter) - (define-key 8859-1-map "3" (make-sparse-keymap)) - (define-key 8859-1-map "3/" (make-sparse-keymap)) - (define-key 8859-1-map "3/4" 'insert-fraction-three-quarters) - (define-key 8859-1-map "<" 'insert-angle-quotation-mark-left) - (define-key 8859-1-map "=" 'insert-macron) - (define-key 8859-1-map ">" 'insert-angle-quotation-mark-right) - (define-key 8859-1-map "?" 'insert-inverted-question-mark) - (define-key 8859-1-map "A" 'insert-A-ring) - (define-key 8859-1-map "E" 'insert-AE) - (define-key 8859-1-map "C" 'insert-copyright-sign) - (define-key 8859-1-map "D" 'insert-D-stroke) - (define-key 8859-1-map "L" 'insert-pound-sign) - (define-key 8859-1-map "P" 'insert-pilcrow) - (define-key 8859-1-map "R" 'insert-registered-sign) - (define-key 8859-1-map "S" 'insert-section-sign) - (define-key 8859-1-map "T" 'insert-THORN) - (define-key 8859-1-map "Y" 'insert-yen-sign) - (define-key 8859-1-map "^" (make-sparse-keymap)) - (define-key 8859-1-map "^1" 'insert-superscript-one) - (define-key 8859-1-map "^2" 'insert-superscript-two) - (define-key 8859-1-map "^3" 'insert-superscript-three) - (define-key 8859-1-map "^A" 'insert-A-circumflex) - (define-key 8859-1-map "^E" 'insert-E-circumflex) - (define-key 8859-1-map "^I" 'insert-I-circumflex) - (define-key 8859-1-map "^O" 'insert-O-circumflex) - (define-key 8859-1-map "^U" 'insert-U-circumflex) - (define-key 8859-1-map "^a" 'insert-a-circumflex) - (define-key 8859-1-map "^e" 'insert-e-circumflex) - (define-key 8859-1-map "^i" 'insert-i-circumflex) - (define-key 8859-1-map "^o" 'insert-o-circumflex) - (define-key 8859-1-map "^u" 'insert-u-circumflex) - (define-key 8859-1-map "_" (make-sparse-keymap)) - (define-key 8859-1-map "_a" 'insert-ordinal-indicator-feminine) - (define-key 8859-1-map "_o" 'insert-ordinal-indicator-masculine) - (define-key 8859-1-map "`" (make-sparse-keymap)) - (define-key 8859-1-map "`A" 'insert-A-grave) - (define-key 8859-1-map "`E" 'insert-E-grave) - (define-key 8859-1-map "`I" 'insert-I-grave) - (define-key 8859-1-map "`O" 'insert-O-grave) - (define-key 8859-1-map "`U" 'insert-U-grave) - (define-key 8859-1-map "`a" 'insert-a-grave) - (define-key 8859-1-map "`e" 'insert-e-grave) - (define-key 8859-1-map "`i" 'insert-i-grave) - (define-key 8859-1-map "`o" 'insert-o-grave) - (define-key 8859-1-map "`u" 'insert-u-grave) - (define-key 8859-1-map "a" 'insert-a-ring) - (define-key 8859-1-map "e" 'insert-ae) - (define-key 8859-1-map "c" 'insert-cent-sign) - (define-key 8859-1-map "d" 'insert-d-stroke) - (define-key 8859-1-map "o" 'insert-degree-sign) - (define-key 8859-1-map "s" 'insert-ss) - (define-key 8859-1-map "t" 'insert-thorn) - (define-key 8859-1-map "u" 'insert-micro-sign) - (define-key 8859-1-map "x" 'insert-multiplication-sign) - (define-key 8859-1-map "|" 'insert-broken-vertical-line) - (define-key 8859-1-map "~" (make-sparse-keymap)) - (define-key 8859-1-map "~A" 'insert-A-tilde) - (define-key 8859-1-map "~N" 'insert-N-tilde) - (define-key 8859-1-map "~O" 'insert-O-tilde) - (define-key 8859-1-map "~a" 'insert-a-tilde) - (define-key 8859-1-map "~n" 'insert-n-tilde) - (define-key 8859-1-map "~o" 'insert-o-tilde) - (define-key 8859-1-map "~~" 'insert-not-sign) - (if (not (lookup-key global-map "\C-x8")) - (define-key global-map "\C-x8" 8859-1-map)) -) -(defalias '8859-1-map 8859-1-map) - -(provide 'iso-insert) - -;;; iso-insert.el ends here diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el deleted file mode 100644 index bae69d2e785..00000000000 --- a/lisp/obsolete/iso-swed.el +++ /dev/null @@ -1,150 +0,0 @@ -;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys - -;; Copyright (C) 1987, 2001-2016 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.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: - -;; Written by Howard Gayle. See case-table.el for details. - -;;; Code: - -;; This code sets up to display ISO 8859/1 characters on -;; terminals that have ASCII in the G0 set and a Swedish/Finnish -;; version of ISO 646 in the G1 set. The G1 set differs from -;; ASCII as follows: -;; -;; ASCII G1 -;; $ general currency sign -;; @ capital E with acute accent -;; [ capital A with diaeresis or umlaut mark -;; \ capital O with diaeresis or umlaut mark -;; ] capital A with ring -;; ^ capital U with diaeresis or umlaut mark -;; ` small e with acute accent -;; { small a with diaeresis or umlaut mark -;; | small o with diaeresis or umlaut mark -;; } small a with ring -;; ~ small u with diaeresis or umlaut mark - -(require 'disp-table) - -(standard-display-ascii 160 "{_}") ; NBSP (no-break space) -(standard-display-ascii 161 "{!}") ; inverted exclamation mark -(standard-display-ascii 162 "{c}") ; cent sign -(standard-display-ascii 163 "{GBP}") ; pound sign -(standard-display-g1 164 ?$) ; general currency sign -(standard-display-ascii 165 "{JPY}") ; yen sign -(standard-display-ascii 166 "{|}") ; broken vertical line -(standard-display-ascii 167 "{S}") ; section sign -(standard-display-ascii 168 "{\"}") ; diaeresis -(standard-display-ascii 169 "{C}") ; copyright sign -(standard-display-ascii 170 "{_a}") ; ordinal indicator, feminine -(standard-display-ascii 171 "{<<}") ; left angle quotation mark -(standard-display-ascii 172 "{~}") ; not sign -(standard-display-ascii 173 "{-}") ; soft hyphen -(standard-display-ascii 174 "{R}") ; registered sign -(standard-display-ascii 175 "{=}") ; macron -(standard-display-ascii 176 "{o}") ; degree sign -(standard-display-ascii 177 "{+-}") ; plus or minus sign -(standard-display-ascii 178 "{2}") ; superscript two -(standard-display-ascii 179 "{3}") ; superscript three -(standard-display-ascii 180 "{'}") ; acute accent -(standard-display-ascii 181 "{u}") ; micro sign -(standard-display-ascii 182 "{P}") ; pilcrow -(standard-display-ascii 183 "{.}") ; middle dot -(standard-display-ascii 184 "{,}") ; cedilla -(standard-display-ascii 185 "{1}") ; superscript one -(standard-display-ascii 186 "{_o}") ; ordinal indicator, masculine -(standard-display-ascii 187 "{>>}") ; right angle quotation mark -(standard-display-ascii 188 "{1/4}") ; fraction one-quarter -(standard-display-ascii 189 "{1/2}") ; fraction one-half -(standard-display-ascii 190 "{3/4}") ; fraction three-quarters -(standard-display-ascii 191 "{?}") ; inverted question mark -(standard-display-ascii 192 "{`A}") ; A with grave accent -(standard-display-ascii 193 "{'A}") ; A with acute accent -(standard-display-ascii 194 "{^A}") ; A with circumflex accent -(standard-display-ascii 195 "{~A}") ; A with tilde -(standard-display-g1 196 ?[) ; A with diaeresis or umlaut mark -(standard-display-g1 197 ?]) ; A with ring -(standard-display-ascii 198 "{AE}") ; AE diphthong -(standard-display-ascii 199 "{,C}") ; C with cedilla -(standard-display-ascii 200 "{`E}") ; E with grave accent -(standard-display-g1 201 ?@) ; E with acute accent -(standard-display-ascii 202 "{^E}") ; E with circumflex accent -(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark -(standard-display-ascii 204 "{`I}") ; I with grave accent -(standard-display-ascii 205 "{'I}") ; I with acute accent -(standard-display-ascii 206 "{^I}") ; I with circumflex accent -(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark -(standard-display-ascii 208 "{-D}") ; D with stroke, Icelandic eth -(standard-display-ascii 209 "{~N}") ; N with tilde -(standard-display-ascii 210 "{`O}") ; O with grave accent -(standard-display-ascii 211 "{'O}") ; O with acute accent -(standard-display-ascii 212 "{^O}") ; O with circumflex accent -(standard-display-ascii 213 "{~O}") ; O with tilde -(standard-display-g1 214 ?\\) ; O with diaeresis or umlaut mark -(standard-display-ascii 215 "{x}") ; multiplication sign -(standard-display-ascii 216 "{/O}") ; O with slash -(standard-display-ascii 217 "{`U}") ; U with grave accent -(standard-display-ascii 218 "{'U}") ; U with acute accent -(standard-display-ascii 219 "{^U}") ; U with circumflex accent -(standard-display-g1 220 ?^) ; U with diaeresis or umlaut mark -(standard-display-ascii 221 "{'Y}") ; Y with acute accent -(standard-display-ascii 222 "{TH}") ; capital thorn, Icelandic -(standard-display-ascii 223 "{ss}") ; small sharp s, German -(standard-display-ascii 224 "{`a}") ; a with grave accent -(standard-display-ascii 225 "{'a}") ; a with acute accent -(standard-display-ascii 226 "{^a}") ; a with circumflex accent -(standard-display-ascii 227 "{~a}") ; a with tilde -(standard-display-g1 228 ?{) ; a with diaeresis or umlaut mark -(standard-display-g1 229 ?}) ; a with ring -(standard-display-ascii 230 "{ae}") ; ae diphthong -(standard-display-ascii 231 "{,c}") ; c with cedilla -(standard-display-ascii 232 "{`e}") ; e with grave accent -(standard-display-g1 233 ?`) ; e with acute accent -(standard-display-ascii 234 "{^e}") ; e with circumflex accent -(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark -(standard-display-ascii 236 "{`i}") ; i with grave accent -(standard-display-ascii 237 "{'i}") ; i with acute accent -(standard-display-ascii 238 "{^i}") ; i with circumflex accent -(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark -(standard-display-ascii 240 "{-d}") ; d with stroke, Icelandic eth -(standard-display-ascii 241 "{~n}") ; n with tilde -(standard-display-ascii 242 "{`o}") ; o with grave accent -(standard-display-ascii 243 "{'o}") ; o with acute accent -(standard-display-ascii 244 "{^o}") ; o with circumflex accent -(standard-display-ascii 245 "{~o}") ; o with tilde -(standard-display-g1 246 ?|) ; o with diaeresis or umlaut mark -(standard-display-ascii 247 "{/}") ; division sign -(standard-display-ascii 248 "{/o}") ; o with slash -(standard-display-ascii 249 "{`u}") ; u with grave accent -(standard-display-ascii 250 "{'u}") ; u with acute accent -(standard-display-ascii 251 "{^u}") ; u with circumflex accent -(standard-display-g1 252 ?~) ; u with diaeresis or umlaut mark -(standard-display-ascii 253 "{'y}") ; y with acute accent -(standard-display-ascii 254 "{th}") ; small thorn, Icelandic -(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark - -(provide 'iso-swed) - -;;; iso-swed.el ends here diff --git a/lisp/obsolete/keyswap.el b/lisp/obsolete/keyswap.el deleted file mode 100644 index ee3ba108093..00000000000 --- a/lisp/obsolete/keyswap.el +++ /dev/null @@ -1,40 +0,0 @@ -;;; keyswap.el --- swap BS and DEL keys - -;; Copyright (C) 1992, 2001-2016 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond <esr@snark.thyrsus.com> -;; Keywords: terminals -;; Obsolete-since: 22.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 package is meant to be called by other terminal packages. - -;;; Code: - -(let ((the-table (make-string 128 0))) - (let ((i 0)) - (while (< i 128) - (aset the-table i i) - (setq i (1+ i)))) - ;; Swap ^H and DEL - (aset the-table ?\177 ?\^h) - (aset the-table ?\^h ?\177) - (setq keyboard-translate-table the-table)) - -;;; keyswap.el ends here 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/obsolete/resume.el b/lisp/obsolete/resume.el deleted file mode 100644 index b7f699db415..00000000000 --- a/lisp/obsolete/resume.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; resume.el --- process command line args from within a suspended Emacs job - -;; Copyright (C) 1992, 2001-2016 Free Software Foundation, Inc. - -;; Author: Joe Wells <jbw@bucsf.bu.edu> -;; Adapted-By: ESR -;; Keywords: processes -;; Obsolete-since: 23.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: - -;; The purpose of this library is to handle command line arguments -;; when you resume an existing Emacs job. - -;; In order to use it, you must put this code in your .emacs file. - -;; (add-hook 'suspend-hook 'resume-suspend-hook) -;; (add-hook 'suspend-resume-hook 'resume-process-args) - -;; You can't get the benefit of this library by using the `emacs' command, -;; since that always starts a new Emacs job. Instead you must use a -;; command called `edit' which knows how to resume an existing Emacs job -;; if you have one, or start a new Emacs job if you don't have one. - -;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH), -;; or etc/emacs.bash if you use BASH. You would normally do this in your -;; login script. - -;; Stephan Gildea suggested bug fix (gildea@bbn.com). -;; Ideas from Michael DeCorte and other people. - -;;; Code: - -(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args") - "This file is where arguments are placed for a suspended Emacs job.") - -(defvar resume-emacs-args-buffer " *Command Line Args*" - "Buffer that is used by `resume-process-args'.") - -(defun resume-process-args () - "Handler for command line args given when Emacs is resumed." - (let ((start-buffer (current-buffer)) - (args-buffer (get-buffer-create resume-emacs-args-buffer)) - length args - (command-line-default-directory default-directory)) - (unwind-protect - (progn - (set-buffer args-buffer) - (erase-buffer) - ;; get the contents of resume-emacs-args-file - (condition-case () - (let ((result (insert-file-contents resume-emacs-args-file))) - (setq length (car (cdr result)))) - ;; the file doesn't exist, ergo no arguments - (file-error - (erase-buffer) - (setq length 0))) - (if (<= length 0) - (setq args nil) - ;; get the arguments from the buffer - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") - (let ((begin (point))) - (skip-chars-forward "^ \t\n") - (setq args (cons (buffer-substring begin (point)) args))) - (skip-chars-forward " \t\n")) - ;; arguments are now in reverse order - (setq args (nreverse args)) - ;; make sure they're not read again - (erase-buffer)) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file) - ;; if nothing was in buffer, args will be null - (or (null args) - (setq command-line-default-directory - (file-name-as-directory (car args)) - args (cdr args))) - ;; actually process the arguments - (command-line-1 args)) - ;; If the command line args don't result in a find-file, the - ;; buffer will be left in args-buffer. So we change back to the - ;; original buffer. The reason I don't just use - ;; (let ((default-directory foo)) - ;; (command-line-1 args)) - ;; in the context of the original buffer is because let does not - ;; work properly with buffer-local variables. - (if (eq (current-buffer) args-buffer) - (set-buffer start-buffer))))) - -;;;###autoload -(defun resume-suspend-hook () - "Clear out the file used for transmitting args when Emacs resumes." - (with-current-buffer (get-buffer-create resume-emacs-args-buffer) - (erase-buffer) - (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file))) - -(defun resume-write-buffer-to-file (buffer file) - "Writes the contents of BUFFER into FILE, if permissions allow." - (if (not (file-writable-p file)) - (error "No permission to write file %s" file)) - (with-current-buffer buffer - (clear-visited-file-modtime) - (save-restriction - (widen) - (write-region (point-min) (point-max) file nil 'quiet)) - (set-buffer-modified-p nil))) - -(provide 'resume) - -;;; resume.el ends here diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el deleted file mode 100644 index c354e65b9d2..00000000000 --- a/lisp/obsolete/scribe.el +++ /dev/null @@ -1,329 +0,0 @@ -;;; scribe.el --- scribe mode, and its idiosyncratic commands - -;; Copyright (C) 1985, 2001-2016 Free Software Foundation, Inc. - -;; Author: William Sommerfeld -;; (according to ack.texi) -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp -;; Obsolete-since: 22.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: - -;; A major mode for editing source in written for the Scribe text formatter. -;; Knows about Scribe syntax and standard layout rules. The command to -;; run Scribe on a buffer is bogus; someone interested should fix it. - -;;; Code: - -(defvar compile-command) - -(defgroup scribe nil - "Scribe mode." - :prefix "scribe-" - :group 'wp) - -(defvar scribe-mode-syntax-table nil - "Syntax table used while in scribe mode.") - -(defvar scribe-mode-abbrev-table nil - "Abbrev table used while in scribe mode.") - -(defcustom scribe-fancy-paragraphs nil - "Non-nil makes Scribe mode use a different style of paragraph separation." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-quote nil - "Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context." - :type 'boolean - :group 'scribe) - -(defcustom scribe-electric-parenthesis nil - "Non-nil makes parenthesis char ( (]}> ) automatically insert its close -if typed after an @Command form." - :type 'boolean - :group 'scribe) - -(defconst scribe-open-parentheses "[({<" - "Open parenthesis characters for Scribe.") - -(defconst scribe-close-parentheses "])}>" - "Close parenthesis characters for Scribe. -These should match up with `scribe-open-parenthesis'.") - -(if (null scribe-mode-syntax-table) - (let ((st (syntax-table))) - (unwind-protect - (progn - (setq scribe-mode-syntax-table (copy-syntax-table - text-mode-syntax-table)) - (set-syntax-table scribe-mode-syntax-table) - (modify-syntax-entry ?\" " ") - (modify-syntax-entry ?\\ " ") - (modify-syntax-entry ?@ "w ") - (modify-syntax-entry ?< "(> ") - (modify-syntax-entry ?> ")< ") - (modify-syntax-entry ?[ "(] ") - (modify-syntax-entry ?] ")[ ") - (modify-syntax-entry ?{ "(} ") - (modify-syntax-entry ?} "){ ") - (modify-syntax-entry ?' "w ")) - (set-syntax-table st)))) - -(defvar scribe-mode-map nil) - -(if scribe-mode-map - nil - (setq scribe-mode-map (make-sparse-keymap)) - (define-key scribe-mode-map "\t" 'scribe-tab) - (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop) - (define-key scribe-mode-map "\es" 'center-line) - (define-key scribe-mode-map "\e}" 'up-list) - (define-key scribe-mode-map "\eS" 'center-paragraph) - (define-key scribe-mode-map "\"" 'scribe-insert-quote) - (define-key scribe-mode-map "(" 'scribe-parenthesis) - (define-key scribe-mode-map "[" 'scribe-parenthesis) - (define-key scribe-mode-map "{" 'scribe-parenthesis) - (define-key scribe-mode-map "<" 'scribe-parenthesis) - (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter) - (define-key scribe-mode-map "\C-c\C-t" 'scribe-section) - (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection) - (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment) - (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be) - (define-key scribe-mode-map "\C-c[" 'scribe-begin) - (define-key scribe-mode-map "\C-c]" 'scribe-end) - (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word) - (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word) - (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word)) - -;;;###autoload -(define-derived-mode scribe-mode text-mode "Scribe" - "Major mode for editing files of Scribe (a text formatter) source. -Scribe-mode is similar to text-mode, with a few extra commands added. -\\{scribe-mode-map} - -Interesting variables: - -`scribe-fancy-paragraphs' - Non-nil makes Scribe mode use a different style of paragraph separation. - -`scribe-electric-quote' - Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context. - -`scribe-electric-parenthesis' - Non-nil makes an open-parenthesis char (one of `([<{') - automatically insert its close if typed after an @Command form." - (set (make-local-variable 'comment-start) "@Comment[") - (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]")) - (set (make-local-variable 'comment-column) 0) - (set (make-local-variable 'comment-end) "]") - (set (make-local-variable 'paragraph-start) - (concat "\\([\n\f]\\)\\|\\(@\\w+[" - scribe-open-parentheses - "].*[" - scribe-close-parentheses - "]$\\)")) - (set (make-local-variable 'paragraph-separate) - (if scribe-fancy-paragraphs paragraph-start "$")) - (set (make-local-variable 'sentence-end) - "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") - (set (make-local-variable 'compile-command) - (concat "scribe " - (if buffer-file-name - (shell-quote-argument (buffer-file-name)))))) - -(defun scribe-tab () - (interactive) - (insert "@\\")) - -;; This algorithm could probably be improved somewhat. -;; Right now, it loses seriously... - -(defun scribe () - "Run Scribe on the current buffer." - (interactive) - (call-interactively 'compile)) - -(defun scribe-envelop-word (string count) - "Surround current word with Scribe construct @STRING[...]. -COUNT specifies how many words to surround. A negative count means -to skip backward." - (let ((spos (point)) (epos (point)) (ccoun 0) noparens) - (if (not (zerop count)) - (progn (if (= (char-syntax (preceding-char)) ?w) - (forward-sexp (min -1 count))) - (setq spos (point)) - (if (looking-at (concat "@\\w[" scribe-open-parentheses "]")) - (forward-char 2) - (goto-char epos) - (skip-chars-backward "\\W") - (forward-char -1)) - (forward-sexp (max count 1)) - (setq epos (point)))) - (goto-char spos) - (while (and (< ccoun (length scribe-open-parentheses)) - (save-excursion - (or (search-forward (char-to-string - (aref scribe-open-parentheses ccoun)) - epos t) - (search-forward (char-to-string - (aref scribe-close-parentheses ccoun)) - epos t))) - (setq ccoun (1+ ccoun)))) - (if (>= ccoun (length scribe-open-parentheses)) - (progn (goto-char epos) - (insert "@end(" string ")") - (goto-char spos) - (insert "@begin(" string ")")) - (goto-char epos) - (insert (aref scribe-close-parentheses ccoun)) - (goto-char spos) - (insert "@" string (aref scribe-open-parentheses ccoun)) - (goto-char epos) - (forward-char 3) - (skip-chars-forward scribe-close-parentheses)))) - -(defun scribe-underline-word (count) - "Underline COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "u" count)) - -(defun scribe-bold-word (count) - "Boldface COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "b" count)) - -(defun scribe-italicize-word (count) - "Italicize COUNT words around point by means of Scribe constructs." - (interactive "p") - (scribe-envelop-word "i" count)) - -(defun scribe-begin () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Begin" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-end () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "End" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-chapter () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Chapter" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-section () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "Section" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-subsection () - (interactive) - (insert "\n") - (forward-char -1) - (scribe-envelop-word "SubSection" 0) - (re-search-forward (concat "[" scribe-open-parentheses "]"))) - -(defun scribe-bracket-region-be (env min max) - (interactive "sEnvironment: \nr") - (save-excursion - (goto-char max) - (insert "@end(" env ")\n") - (goto-char min) - (insert "@begin(" env ")\n"))) - -(defun scribe-insert-environment (env) - (interactive "sEnvironment: ") - (scribe-bracket-region-be env (point) (point)) - (forward-line 1) - (insert ?\n) - (forward-char -1)) - -(defun scribe-insert-quote (count) - "Insert \\=`\\=`, \\='\\=' or \" according to preceding character. -If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according -to preceding character. With numeric arg N, always insert N \" characters. -Else just insert \"." - (interactive "P") - (if (or count (not scribe-electric-quote)) - (self-insert-command (prefix-numeric-value count)) - (let (lastfore lastback lastquote) - (insert - (cond - ((= (preceding-char) ?\\) ?\") - ((bobp) "``") - (t - (setq lastfore (save-excursion (and (search-backward - "``" (- (point) 1000) t) - (point))) - lastback (save-excursion (and (search-backward - "''" (- (point) 1000) t) - (point))) - lastquote (save-excursion (and (search-backward - "\"" (- (point) 100) t) - (point)))) - (if (not lastquote) - (cond ((not lastfore) "``") - ((not lastback) "''") - ((> lastfore lastback) "''") - (t "``")) - (cond ((and (not lastback) (not lastfore)) "\"") - ((and lastback (not lastfore) (> lastquote lastback)) "\"") - ((and lastback (not lastfore) (> lastback lastquote)) "``") - ((and lastfore (not lastback) (> lastquote lastfore)) "\"") - ((and lastfore (not lastback) (> lastfore lastquote)) "''") - ((and (> lastquote lastfore) (> lastquote lastback)) "\"") - ((> lastfore lastback) "''") - (t "``"))))))))) - -(defun scribe-parenthesis (count) - "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis -character inserts the following close parenthesis character if the -preceding text is of the form @Command." - (interactive "P") - (self-insert-command (prefix-numeric-value count)) - (let (at-command paren-char point-save) - (if (or count (not scribe-electric-parenthesis)) - nil - (save-excursion - (forward-char -1) - (setq point-save (point)) - (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses)) - (setq at-command (and (equal (following-char) ?@) - (/= (point) (1- point-save))))) - (if (and at-command - (setq paren-char - (string-match (regexp-quote - (char-to-string (preceding-char))) - scribe-open-parentheses))) - (save-excursion - (insert (aref scribe-close-parentheses paren-char))))))) - -(provide 'scribe) - -;;; scribe.el ends here diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el deleted file mode 100644 index 03047e9aba3..00000000000 --- a/lisp/obsolete/spell.el +++ /dev/null @@ -1,171 +0,0 @@ -;;; spell.el --- spelling correction interface for Emacs - -;; Copyright (C) 1985, 2001-2016 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: wp, unix -;; Obsolete-since: 23.1 -;; (not in obsolete/ directory then, but all functions marked obsolete) - -;; 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 mode provides an Emacs interface to the UNIX spell(1) program. -;; Entry points are `spell-buffer', `spell-word', `spell-region' and -;; `spell-string'. - -;; See also ispell.el for an interface to the ispell program. - -;;; Code: - -(defgroup spell nil - "Interface to the UNIX spell(1) program." - :prefix "spell-" - :group 'applications) - -(defcustom spell-command "spell" - "Command to run the spell program." - :type 'string - :group 'spell) - -(defcustom spell-filter nil - "Filter function to process text before passing it to spell program. -This function might remove text-processor commands. -nil means don't alter the text before checking it." - :type '(choice (const nil) function) - :group 'spell) - -;;;###autoload -(put 'spell-filter 'risky-local-variable t) - -;;;###autoload -(defun spell-buffer () - "Check spelling of every word in the buffer. -For each incorrect word, you are asked for the correct spelling -and then put into a query-replace to fix some or all occurrences. -If you do not want to change a word, just give the same word -as its \"correct\" spelling; then the query replace is skipped." - (interactive) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region (point-min) (point-max) "buffer"))) -;;;###autoload -(make-obsolete 'spell-buffer 'ispell-buffer "23.1") - -;;;###autoload -(defun spell-word () - "Check spelling of word at or before point. -If it is not correct, ask user for the correct spelling -and `query-replace' the entire buffer to substitute it." - (interactive) - (let (beg end spell-filter) - (save-excursion - (if (not (looking-at "\\<")) - (forward-word -1)) - (setq beg (point)) - (forward-word 1) - (setq end (point))) - ;; Don't warn about spell-region being obsolete. - (with-no-warnings - (spell-region beg end (buffer-substring beg end))))) -;;;###autoload -(make-obsolete 'spell-word 'ispell-word "23.1") - -;;;###autoload -(defun spell-region (start end &optional description) - "Like `spell-buffer' but applies only to region. -Used in a program, applies from START to END. -DESCRIPTION is an optional string naming the unit being checked: -for example, \"word\"." - (interactive "r") - (let ((filter spell-filter) - (buf (get-buffer-create " *temp*"))) - (with-current-buffer buf - (widen) - (erase-buffer)) - (message "Checking spelling of %s..." (or description "region")) - (if (and (null filter) (= ?\n (char-after (1- end)))) - (if (string= "spell" spell-command) - (call-process-region start end "spell" nil buf) - (call-process-region start end shell-file-name - nil buf nil "-c" spell-command)) - (let ((oldbuf (current-buffer))) - (with-current-buffer buf - (insert-buffer-substring oldbuf start end) - (or (bolp) (insert ?\n)) - (if filter (funcall filter)) - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" t buf) - (call-process-region (point-min) (point-max) shell-file-name - t buf nil "-c" spell-command))))) - (message "Checking spelling of %s...%s" - (or description "region") - (if (with-current-buffer buf - (> (buffer-size) 0)) - "not correct" - "correct")) - (let (word newword - (case-fold-search t) - (case-replace t)) - (while (with-current-buffer buf - (> (buffer-size) 0)) - (with-current-buffer buf - (goto-char (point-min)) - (setq word (downcase - (buffer-substring (point) - (progn (end-of-line) (point))))) - (forward-char 1) - (delete-region (point-min) (point)) - (setq newword - (read-string (concat "`" word - "' not recognized; edit a replacement: ") - word)) - (flush-lines (concat "^" (regexp-quote word) "$"))) - (if (not (equal word newword)) - (progn - (goto-char (point-min)) - (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b") - newword))))))) -;;;###autoload -(make-obsolete 'spell-region 'ispell-region "23.1") - -;;;###autoload -(defun spell-string (string) - "Check spelling of string supplied as argument." - (interactive "sSpell string: ") - (with-temp-buffer - (widen) - (erase-buffer) - (insert string "\n") - (if (string= "spell" spell-command) - (call-process-region (point-min) (point-max) "spell" - t t) - (call-process-region (point-min) (point-max) shell-file-name - t t nil "-c" spell-command)) - (if (= 0 (buffer-size)) - (message "%s is correct" string) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match " ")) - (message "%sincorrect" (buffer-substring 1 (point-max)))))) -;;;###autoload -(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'." - "23.1") - -(provide 'spell) - -;;; spell.el ends here diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el deleted file mode 100644 index 38dce00a456..00000000000 --- a/lisp/obsolete/swedish.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; swedish.el --- miscellaneous functions for dealing with Swedish - -;; Copyright (C) 1988, 2001-2016 Free Software Foundation, Inc. - -;; Author: Howard Gayle -;; Maintainer: emacs-devel@gnu.org -;; Keywords: i18n -;; Obsolete-since: 22.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: - -;; Fixme: Is this actually used? if so, it should be in language, -;; possibly as a feature property of Swedish, probably defining a -;; `swascii' coding system. - -;;; Code: - -;; Written by Howard Gayle. See case-table.el for details. - -;; See iso-swed.el for a description of the character set. - -(defvar mail-send-hook) -(defvar news-group-hook-alist) -(defvar news-inews-hook) - -(defvar swedish-re - "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]" - "Regular expression for common Swedish words.") - -(defvar swascii-to-8859-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string ?\[ 196) - (aset string ?\] 197) - (aset string ?\\ 214) - (aset string ?^ 220) - (aset string ?\{ 228) - (aset string ?\} 229) - (aset string ?\` 233) - (aset string ?\| 246) - (aset string ?~ 252) - string) - "Trans table from SWASCII to 8859.") - -; $ is not converted because it almost always means US -; dollars, not general currency sign. @ is not converted -; because it is more likely to be an at sign in a mail address -; than an E with acute accent. - -(defun swascii-to-8859-buffer () - "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. -Works even on read-only buffers. `$' and `@' are not converted." - (interactive) - (let ((buffer-read-only nil)) - (translate-region (point-min) (point-max) swascii-to-8859-trans))) - -(defun swascii-to-8859-buffer-maybe () - "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. -Leaves point just after the word that looks Swedish." - (interactive) - (let ((case-fold-search t)) - (if (re-search-forward swedish-re nil t) - (swascii-to-8859-buffer)))) - -(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe) - -(setq news-group-hook-alist - (append '(("^swnet." . swascii-to-8859-buffer-maybe)) - (bound-and-true-p news-group-hook-alist))) - -(defvar 8859-to-swascii-trans - (let ((string (make-string 256 ? )) - (i 0)) - (while (< i 256) - (aset string i i) - (setq i (1+ i))) - (aset string 164 ?$) - (aset string 196 ?\[) - (aset string 197 ?\]) - (aset string 201 ?@) - (aset string 214 ?\\) - (aset string 220 ?^) - (aset string 228 ?\{) - (aset string 229 ?\}) - (aset string 233 ?\`) - (aset string 246 ?\|) - (aset string 252 ?~) - string) - "8859 to SWASCII trans table.") - -(defun 8859-to-swascii-buffer () - "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii." - (interactive "*") - (translate-region (point-min) (point-max) 8859-to-swascii-trans)) - -(setq mail-send-hook '8859-to-swascii-buffer) -(setq news-inews-hook '8859-to-swascii-buffer) - -;; It's not clear what purpose is served by a separate -;; Swedish mode that differs from Text mode only in having -;; a separate abbrev table. Nothing says that the abbrevs you -;; define in Text mode have to be English! - -;(defvar swedish-mode-abbrev-table nil -; "Abbrev table used while in swedish mode.") -;(define-abbrev-table 'swedish-mode-abbrev-table ()) - -;(defun swedish-mode () -; "Major mode for editing Swedish text intended for humans to -;read. Special commands:\\{text-mode-map} -;Turning on swedish-mode calls the value of the variable -;text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (setq mode-name "Swedish") -; (setq major-mode 'swedish-mode) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (run-mode-hooks 'text-mode-hook)) - -;(defun indented-swedish-mode () -; "Major mode for editing indented Swedish text intended for -;humans to read.\\{indented-text-mode-map} -;Turning on indented-swedish-mode calls the value of the -;variable text-mode-hook, if that value is non-nil." -; (interactive) -; (kill-all-local-variables) -; (use-local-map text-mode-map) -; (define-abbrev-table 'swedish-mode-abbrev-table ()) -; (setq local-abbrev-table swedish-mode-abbrev-table) -; (set-syntax-table text-mode-syntax-table) -; (make-local-variable 'indent-line-function) -; (setq indent-line-function 'indent-relative-maybe) -; (use-local-map indented-text-mode-map) -; (setq mode-name "Indented Swedish") -; (setq major-mode 'indented-swedish-mode) -; (run-mode-hooks 'text-mode-hook)) - -(provide 'swedish) - -;;; swedish.el ends here diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el deleted file mode 100644 index c2eab2c260a..00000000000 --- a/lisp/obsolete/sym-comp.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; sym-comp.el --- mode-dependent symbol completion - -;; Copyright (C) 2004, 2008-2016 Free Software Foundation, Inc. - -;; Author: Dave Love <fx@gnu.org> -;; Keywords: extensions -;; URL: http://www.loveshack.ukfsn.org/emacs -;; Obsolete-since: 23.2 - -;; 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 defines `symbol-complete', which is a generalization of the -;; old `lisp-complete-symbol'. It provides the following hooks to -;; allow major modes to set up completion appropriate for the mode: -;; `symbol-completion-symbol-function', -;; `symbol-completion-completions-function', -;; `symbol-completion-predicate-function', -;; `symbol-completion-transform-function'. Typically it is only -;; necessary for a mode to set -;; `symbol-completion-completions-function' locally and to bind -;; `symbol-complete' appropriately. - -;; It's unfortunate that there doesn't seem to be a good way of -;; combining this with `complete-symbol'. - -;; There is also `symbol-completion-try-complete', for use with -;; Hippie-exp. - -;;; Code: - -;;;; Mode-dependent symbol completion. - -(defun symbol-completion-symbol () - "Default `symbol-completion-symbol-function'. -Uses `current-word' with the buffer narrowed to the part before -point." - (save-restriction - ;; Narrow in case point is in the middle of a symbol -- we want - ;; just the preceding part. - (narrow-to-region (point-min) (point)) - (current-word))) - -(defvar symbol-completion-symbol-function 'symbol-completion-symbol - "Function to return a partial symbol before point for completion. -The value it returns should be a string (or nil). -Major modes may set this locally if the default isn't appropriate. - -Beware: the length of the string STR returned need to be equal to the length -of text before point that's subject to completion. Typically, this amounts -to saying that STR is equal to -\(buffer-substring (- (point) (length STR)) (point)).") - -(defvar symbol-completion-completions-function nil - "Function to return possible symbol completions. -It takes an argument which is the string to be completed and -returns a value suitable for the second argument of -`try-completion'. This value need not use the argument, i.e. it -may be all possible completions, such as `obarray' in the case of -Emacs Lisp. - -Major modes may set this locally to allow them to support -`symbol-complete'. See also `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function'.") - -(defvar symbol-completion-predicate-function nil - "If non-nil, function to return a predicate for selecting symbol completions. -The function gets two args, the positions of the beginning and -end of the symbol to be completed. - -Major modes may set this locally if the default isn't -appropriate. This is a function returning a predicate so that -the predicate can be context-dependent, e.g. to select only -function names if point is at a function call position. The -function's args may be useful for determining the context.") - -(defvar symbol-completion-transform-function nil - "If non-nil, function to transform symbols in the symbol-completion buffer. -E.g., for Lisp, it may annotate the symbol as being a function, -not a variable. - -The function takes the symbol name as argument. If it needs to -annotate this, it should return a value suitable as an element of -the list passed to `display-completion-list'. - -The predicate being used for selecting completions (from -`symbol-completion-predicate-function') is available -dynamically-bound as `symbol-completion-predicate' in case the -transform needs it.") - -(defvar symbol-completion-predicate) - -;;;###autoload -(defun symbol-complete (&optional predicate) - "Perform completion of the symbol preceding point. -This is done in a way appropriate to the current major mode, -perhaps by interrogating an inferior interpreter. Compare -`complete-symbol'. -If no characters can be completed, display a list of possible completions. -Repeating the command at that point scrolls the list. - -When called from a program, optional arg PREDICATE is a predicate -determining which symbols are considered. - -This function requires `symbol-completion-completions-function' -to be set buffer-locally. Variables `symbol-completion-symbol-function', -`symbol-completion-predicate-function' and -`symbol-completion-transform-function' are also consulted." - (interactive) - ;; Fixme: Punt to `complete-symbol' in this case? - (unless (functionp symbol-completion-completions-function) - (error "symbol-completion-completions-function not defined")) - (let* ((pattern (or (funcall symbol-completion-symbol-function) - (error "No preceding symbol to complete"))) - ;; FIXME: We assume below that `pattern' holds the text just - ;; before point. This is a problem in the way - ;; symbol-completion-symbol-function was defined. - (predicate (or predicate - (if symbol-completion-predicate-function - (funcall symbol-completion-predicate-function - (- (point) (length pattern)) - (point))))) - (completions (funcall symbol-completion-completions-function - pattern)) - ;; In case the transform needs to access it. - (symbol-completion-predicate predicate) - (completion-extra-properties - (if (functionp symbol-completion-transform-function) - '(:annotation-function - (lambda (str) - (car-safe (cdr-safe - (funcall symbol-completion-transform-function - str)))))))) - (completion-in-region (- (point) (length pattern)) (point) - completions predicate))) - -(defvar he-search-string) -(defvar he-tried-table) -(defvar he-expand-list) -(declare-function he-init-string "hippie-exp" (beg end)) -(declare-function he-string-member "hippie-exp" (str lst &optional trans-case)) -(declare-function he-substitute-string "hippie-exp" (str &optional trans-case)) -(declare-function he-reset-string "hippie-exp" ()) - -;;;###autoload -(defun symbol-completion-try-complete (old) - "Completion function for use with `hippie-expand'. -Uses `symbol-completion-symbol-function' and -`symbol-completion-completions-function'. It is intended to be -used something like this in a major mode which provides symbol -completion: - - (if (featurep \\='hippie-exp) - (set (make-local-variable \\='hippie-expand-try-functions-list) - (cons \\='symbol-completion-try-complete - hippie-expand-try-functions-list)))" - (when (and symbol-completion-symbol-function - symbol-completion-completions-function) - (unless old - (let ((symbol (funcall symbol-completion-symbol-function))) - (he-init-string (- (point) (length symbol)) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (push he-search-string he-tried-table)) - (setq he-expand-list - (and symbol - (funcall symbol-completion-completions-function symbol))))) - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (pop he-expand-list)) - (if he-expand-list - (progn - (he-substitute-string (pop he-expand-list)) - t) - (if old (he-reset-string)) - nil))) - -;;; Emacs Lisp symbol completion. - -(defun lisp-completion-symbol () - "`symbol-completion-symbol-function' for Lisp." - (let ((end (point)) - (beg (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point))))) - (buffer-substring-no-properties beg end))) - -(defun lisp-completion-predicate (beg end) - "`symbol-completion-predicate-function' for Lisp." - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - ;To avoid interned symbols with - ;no slots. -- fx - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; parenthesis we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp)))) - -(defun lisp-symbol-completion-transform () - "`symbol-completion-transform-function' for Lisp." - (lambda (elt) - (if (and (not (eq 'fboundp symbol-completion-predicate)) - (fboundp (intern elt))) - (list elt " <f>") - elt))) - -(provide 'sym-comp) - -;;; sym-comp.el ends here diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 2ef70b630bd..caa461d7714 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -5285,7 +5285,7 @@ * ox-html.el (org-html-link): Don't skip the link description when it matches the name of the headline it targets. - * ox-ascii.el (ascii): Remove inexistant function. + * ox-ascii.el (ascii): Remove nonexistent function. * ox-icalendar.el (icalendar): Ignore footnotes. (org-icalendar--combine-files): Small refactoring. @@ -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 ff83162a2d8..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) @@ -309,6 +305,8 @@ name of the code block." org-confirm-babel-evaluate))) (code-block (if ,info (format " %s " ,lang) " ")) (block-name (if ,name (format " (%s) " ,name) " "))) + ;; Silence byte-compiler is `body' doesn't use those vars. + (ignore noeval query) ,@body))) (defsubst org-babel-check-evaluate (info) @@ -546,6 +544,8 @@ multiple blocks are being executed (e.g., in chained execution through use of the :var header argument) this marker points to the outer-most code block.") +(defvar *this*) + ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params) "Execute the current source code block. @@ -589,7 +589,8 @@ block." (end-of-line 1) (forward-char 1) (let ((result (org-babel-read-result))) (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) result))) + "%" "%%" (format "%S" result))) + result))) ((org-babel-confirm-evaluate (let ((i info)) (setf (nth 2 i) merged-params) i)) (let* ((lang (nth 0 info)) @@ -685,7 +686,7 @@ org-babel-expand-body:lang function." "\n"))) ;;;###autoload -(defun org-babel-expand-src-block (&optional arg info params) +(defun org-babel-expand-src-block (&optional _arg info params) "Expand the current source code block. Expand according to the source code block's header arguments and pop open the results in a preview buffer." @@ -739,8 +740,7 @@ arguments and pop open the results in a preview buffer." (let ((results (copy-sequence original))) (dolist (new-list others) (dolist (arg-pair new-list) - (let ((header (car arg-pair)) - (args (cdr arg-pair))) + (let ((header (car arg-pair))) (setq results (cons arg-pair (org-remove-if (lambda (pair) (equal header (car pair))) @@ -827,7 +827,7 @@ arguments and pop open the results in a preview buffer." (add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) ;;;###autoload -(defun org-babel-load-in-session (&optional arg info) +(defun org-babel-load-in-session (&optional _arg info) "Load the body of the current source-code block. Evaluate the header arguments for the source block before entering the session. After loading the body this pops open the @@ -896,7 +896,7 @@ with a prefix argument then this is passed on to (defvar org-src-window-setup) ;;;###autoload -(defun org-babel-switch-to-session-with-code (&optional arg info) +(defun org-babel-switch-to-session-with-code (&optional arg _info) "Switch to code buffer and display session." (interactive "P") (let ((swap-windows @@ -1021,7 +1021,13 @@ end-body --------- point at the end of the body" (body (match-string 5)) (beg-body (match-beginning 5)) (end-body (match-end 5))) - ,@body + ;; Silence byte-compiler in case `body' doesn't use all + ;; those variables. + (ignore full-block beg-block end-block lang + beg-lang end-lang switches beg-switches + end-switches header-args beg-header-args + end-header-args body beg-body end-body) + ,@body (goto-char end-block))))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) @@ -1532,7 +1538,7 @@ Note: this function removes any hlines in TABLE." (rownames (funcall (lambda () (let ((tp table)) (mapcar - (lambda (row) + (lambda (_row) (prog1 (pop (car tp)) (setq tp (cdr tp)))) @@ -1686,7 +1692,7 @@ NAME, or nil if no such block exists. Set match data according to org-babel-named-src-block-regexp." (save-excursion (let ((case-fold-search t) - (regexp (org-babel-named-src-block-regexp-for-name name)) msg) + (regexp (org-babel-named-src-block-regexp-for-name name))) (goto-char (point-min)) (when (or (re-search-forward regexp nil t) (re-search-backward regexp nil t)) @@ -1724,7 +1730,8 @@ buffer or nil if no such result exists." (catch 'is-a-code-block (when (re-search-forward (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) + "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") + nil t) (when (and (string= "name" (downcase (match-string 1))) (or (beginning-of-line 1) (looking-at org-babel-src-block-regexp) @@ -2658,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)) @@ -2673,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-src.el b/lisp/org/org-src.el index 8e06aaa04c6..f0d393f8e8b 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -232,6 +232,8 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") (defvar org-edit-src-code-timer nil) +(defvar org-inhibit-startup) + (defun org-edit-src-code (&optional context code edit-buffer-name) "Edit the source CODE block at point. The code is copied to a separate buffer and the appropriate mode @@ -265,7 +267,7 @@ the display of windows containing the Org buffer and the code buffer." ;; just one empty line, i.e. beg == end. (end (copy-marker (make-marker) t)) (allow-write-back-p (null code)) - block-nindent total-nindent ovl lang lang-f single lfmt buffer msg + block-nindent total-nindent ovl lang lang-f single buffer msg begline markline markcol line col transmitted-variables) (setq beg (move-marker beg (nth 0 info)) end (move-marker end (nth 1 info)) @@ -471,7 +473,6 @@ the fragment in the Org-mode buffer." (org-mode-p (derived-mode-p 'org-mode)) (beg (make-marker)) (end (make-marker)) - (preserve-indentation org-src-preserve-indentation) block-nindent ovl beg1 end1 code begline buffer) (beginning-of-line 1) (if (looking-at "[ \t]*[^:\n \t]") @@ -928,6 +929,8 @@ fontification of code blocks see `org-src-fontify-block' and '(font-lock-fontified t fontified t font-lock-multiline t)) (set-buffer-modified-p modified))))) +(defvar org-src-fontify-natively) + (defun org-src-fontify-block () "Fontify code block at point." (interactive) 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 eb01426533d..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. @@ -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 @@ -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)) @@ -22673,8 +22673,10 @@ When optional argument END is non-nil, use end of date-range or time-range, if possible. 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." +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 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 f94dbb954a3..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. 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/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index f84a1ceba41..e4e8f3a2c53 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -329,6 +329,42 @@ nil 'identity)))) ;;;###autoload + +(defun pcomplete/find () + "Completion for the GNU find utility." + (let ((prec (pcomplete-arg 'last -1))) + (cond ((and (pcomplete-match "^-" 'last) + (string= "find" prec)) + (pcomplete-opt "HLPDO")) + ((pcomplete-match "^-" 'last) + (while (pcomplete-here + '("-amin" "-anewer" "-atime" "-cmin" "-cnewer" "-context" + "-ctime" "-daystart" "-delete" "-depth" "-empty" "-exec" + "-execdir" "-executable" "-false" "-fls" "-follow" + "-fprint" "-fprint0" "-fprintf" "-fstype" "-gid" "-group" + "-help" "-ignore_readdir_race" "-ilname" "-iname" + "-inum" "-ipath" "-iregex" "-iwholename" + "-links" "-lname" "-ls" "-maxdepth" + "-mindepth" "-mmin" "-mount" "-mtime" + "-name" "-newer" "-nogroup" "-noignore_readdir_race" + "-noleaf" "-nouser" "-nowarn" "-ok" + "-okdir" "-path" "-perm" "-print" + "-print0" "-printf" "-prune" "-quit" + "-readable" "-regex" "-regextype" "-samefile" + "-size" "-true" "-type" "-uid" + "-used" "-user" "-version" "-warn" + "-wholename" "-writable" "-xdev" "-xtype")))) + ((string= "-type" prec) + (while (pcomplete-here (list "b" "c" "d" "p" "f" "l" "s" "D")))) + ((string= "-xtype" prec) + (while (pcomplete-here (list "b" "c" "d" "p" "f" "l" "s")))) + ((or (string= prec "-exec") + (string= prec "-execdir")) + (while (pcomplete-here* (funcall pcomplete-command-completion-function) + (pcomplete-arg 'last) t)))) + (while (pcomplete-here (pcomplete-dirs) nil 'identity)))) + +;;;###autoload (defalias 'pcomplete/gdb 'pcomplete/xargs) ;;; pcmpl-gnu.el ends here 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/fortune.el b/lisp/play/fortune.el index 25fa3f66ef1..4871c459023 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -303,6 +303,19 @@ specifies the file to choose the fortune from." fortune-program-options) (list fort-file))))))) ;;;###autoload +(defun fortune-message (&optional file) + "Display a fortune cookie to the mini-buffer. +If called with a prefix, it has the same behavior as `fortune'. +Optional FILE is a fortune file from which a cookie will be selected." + (interactive (list (if current-prefix-arg + (fortune-ask-file) + fortune-file))) + (with-temp-buffer + (let ((fortune-buffer-name (current-buffer))) + (fortune-in-buffer t file) + (message "%s" (buffer-string))))) + +;;;###autoload (defun fortune (&optional file) "Display a fortune cookie. If called with a prefix asks for the FILE to choose the fortune from, diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 243f0190ee0..371c7133c74 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -144,7 +144,6 @@ (defvar snake-velocity-x 1) (defvar snake-velocity-y 0) (defvar snake-positions nil) -(defvar snake-cycle 0) (defvar snake-score 0) (defvar snake-paused nil) (defvar snake-moved-p nil) @@ -164,7 +163,6 @@ and then start moving it leftwards.") (make-variable-buffer-local 'snake-velocity-x) (make-variable-buffer-local 'snake-velocity-y) (make-variable-buffer-local 'snake-positions) -(make-variable-buffer-local 'snake-cycle) (make-variable-buffer-local 'snake-score) (make-variable-buffer-local 'snake-paused) (make-variable-buffer-local 'snake-moved-p) @@ -237,7 +235,6 @@ and then start moving it leftwards.") snake-velocity-x snake-initial-velocity-x snake-velocity-y snake-initial-velocity-y snake-positions nil - snake-cycle 1 snake-score 0 snake-paused nil snake-moved-p nil @@ -251,6 +248,14 @@ and then start moving it leftwards.") (cl-incf y snake-velocity-y))) (snake-update-score)) +(defun snake-set-dot () + (let ((x (random snake-width)) + (y (random snake-height))) + (while (not (= (gamegrid-get-cell x y) snake-blank)) + (setq x (random snake-width)) + (setq y (random snake-height))) + (gamegrid-set-cell x y snake-dot))) + (defun snake-update-game (snake-buffer) "Called on each clock tick. Advances the snake one square, testing for collision. @@ -268,23 +273,20 @@ Argument SNAKE-BUFFER is the name of the buffer." (cond ((= c snake-dot) (cl-incf snake-length) (cl-incf snake-score) - (snake-update-score)) + (snake-update-score) + (snake-set-dot)) (t (let* ((last-cons (nthcdr (- snake-length 2) snake-positions)) (tail-pos (cadr last-cons)) (x0 (aref tail-pos 0)) (y0 (aref tail-pos 1))) - (gamegrid-set-cell x0 y0 - (if (= (% snake-cycle 5) 0) - snake-dot - snake-blank)) - (cl-incf snake-cycle) + (gamegrid-set-cell x0 y0 snake-blank) (setcdr last-cons nil)))) (gamegrid-set-cell x y snake-snake) (setq snake-positions (cons (vector x y) snake-positions)) - (setq snake-moved-p nil))))) + (setq snake-moved-p nil))))) (defun snake-update-velocity () (unless snake-moved-p @@ -339,6 +341,7 @@ Argument SNAKE-BUFFER is the name of the buffer." "Start a new game of Snake." (interactive) (snake-reset-game) + (snake-set-dot) (use-local-map snake-mode-map) (gamegrid-start-timer snake-tick-period 'snake-update-game)) diff --git a/lisp/gnus/plstore.el b/lisp/plstore.el index e327bbd4846..01bdd144ac0 100644 --- a/lisp/gnus/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) @@ -422,7 +424,7 @@ SECRET-KEYS is a plist containing secret data." ((listp plstore-encrypt-to) plstore-encrypt-to) ((stringp plstore-encrypt-to) (list plstore-encrypt-to)))) cipher) - (epg-context-set-armor context t) + (setf (epg-context-armor context) t) (epg-context-set-passphrase-callback context (cons #'plstore-passphrase-callback-function @@ -554,18 +556,6 @@ If no one is selected, symmetric encryption will be performed. " (plstore-mode-original) (plstore-mode-decoded))) -(eval-when-compile - (defmacro plstore-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p))))) - ;;;###autoload (define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE" "Major mode for editing PLSTORE files." @@ -573,7 +563,7 @@ If no one is selected, symmetric encryption will be performed. " (add-hook 'write-contents-functions #'plstore--write-contents-functions) (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display) ;; to create a new file with plstore-mode, mark it as already decoded - (if (plstore-called-interactively-p 'any) + (if (called-interactively-p 'any) (setq plstore-encoded t) (plstore-mode-decoded))) diff --git a/lisp/printing.el b/lisp/printing.el index 72f825fcb89..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) diff --git a/lisp/proced.el b/lisp/proced.el index 91b50cea340..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)")) @@ -644,6 +641,10 @@ mode line, using \"+\" or \"-\" for ascending or descending sort order. Type \\[proced-toggle-tree] to toggle whether the listing is displayed as process tree. +Type \\[proced-toggle-auto-update] to automatically update the +process list. The time interval for updates can be configured +via `proced-auto-update-interval'. + An existing Proced listing can be refined by typing \\[proced-refine]. Refining an existing listing does not update the variable `proced-filter'. diff --git a/lisp/profiler.el b/lisp/profiler.el index 3bee3c561a7..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) 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-cmds.el b/lisp/progmodes/cc-cmds.el index 59f2729c43d..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 @@ -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)) @@ -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)) @@ -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 251e338c944..f1943a82163 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -206,7 +206,7 @@ This variant works around bugs in `eval-when-compile' in various (eval-and-compile (defmacro c--macroexpand-all (form &optional environment) ;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3. - (if (eq c--mapcan-status 'cl-mapcan) + (if (fboundp 'macroexpand-all) `(macroexpand-all ,form ,environment) `(cl-macroexpand-all ,form ,environment))) @@ -493,19 +493,21 @@ must not be within a `c-save-buffer-state', since the user then wouldn't be able to undo them. The return value is the value of the last form in BODY." - `(let* ((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - before-change-functions after-change-functions - deactivate-mark - buffer-file-name buffer-file-truename ; Prevent primitives checking - ; for file modification - ,@varlist) - (unwind-protect - (progn ,@body) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) -(put 'c-save-buffer-state 'lisp-indent-function 1) + (declare (debug t) (indent 1)) + (if (fboundp 'with-silent-modifications) + `(with-silent-modifications (let* ,varlist ,@body)) + `(let* ((modified (buffer-modified-p)) (buffer-undo-list t) + (inhibit-read-only t) (inhibit-point-motion-hooks t) + before-change-functions after-change-functions + deactivate-mark + buffer-file-name buffer-file-truename ; Prevent primitives checking + ; for file modification + ,@varlist) + (unwind-protect + (progn ,@body) + (and (not modified) + (buffer-modified-p) + (set-buffer-modified-p nil)))))) (defmacro c-tentative-buffer-changes (&rest body) "Eval BODY and optionally restore the buffer contents to the state it @@ -640,13 +642,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))) @@ -661,13 +664,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 @@ -676,13 +674,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, @@ -723,12 +716,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, @@ -737,12 +726,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, @@ -751,12 +736,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, @@ -765,13 +746,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. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index eb015acf320..5a26c0f2770 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)))) @@ -1543,7 +1599,7 @@ comment at the start of cc-engine.el for more info." ;; two newlines with horizontal whitespace between them. ;; ;; The reason to include the first following char is to cope with -;; "rung positions" that doesn't have any ordinary whitespace. If +;; "rung positions" that don't have any ordinary whitespace. If ;; `c-is-sws' is put on a token character it does not have ;; `c-in-sws' set simultaneously. That's the only case when that ;; can occur, and the reason for not extending the `c-in-sws' @@ -1714,7 +1770,9 @@ comment at the start of cc-engine.el for more info." ;; if it's anything that can't start syntactic ws, so we can bail out ;; early in the majority of cases when there just are a few ws chars. (skip-chars-forward " \t\n\r\f\v") - (when (looking-at c-syntactic-ws-start) + (when (or (looking-at c-syntactic-ws-start) + (and c-opt-cpp-prefix + (looking-at c-noise-macro-name-re))) (setq rung-end-pos (min (1+ (point)) (point-max))) (if (setq rung-is-marked (text-property-any rung-pos rung-end-pos @@ -1733,6 +1791,10 @@ comment at the start of cc-engine.el for more info." (with-silent-modifications (while (progn + ;; In the following while form, we move over a "ladder" and + ;; following simple WS each time round the loop, appending the WS + ;; onto the ladder, joining adjacent ladders, and terminating when + ;; there is no more WS or we reach EOB. (while (when (and rung-is-marked (get-text-property (point) 'c-in-sws)) @@ -1776,6 +1838,7 @@ comment at the start of cc-engine.el for more info." (setq rung-pos (point) last-put-in-sws-pos rung-pos))) + ;; Now move over any comments (x)or a CPP construct. (setq simple-ws-end (point)) (c-forward-comments) @@ -1801,6 +1864,13 @@ comment at the start of cc-engine.el for more info." (forward-line 1) (setq safe-start t) ;; Don't cache at eob in case the buffer is narrowed. + (not (eobp))) + + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-name-re)) + ;; Skip over a noise macro. + (goto-char (match-end 1)) + (setq safe-start t) (not (eobp))))) ;; We've searched over a piece of non-white syntactic ws. See if this @@ -1907,8 +1977,11 @@ comment at the start of cc-engine.el for more info." (when (and (not (bobp)) (save-excursion (backward-char) - (looking-at c-syntactic-ws-end))) - + (or (looking-at c-syntactic-ws-end) + (and c-opt-cpp-prefix + (looking-at c-symbol-char-key) + (progn (c-beginning-of-current-token) + (looking-at c-noise-macro-name-re)))))) ;; Try to find a rung position in the simple ws preceding point, so that ;; we can get a cache hit even if the last bit of the simple ws has ;; changed recently. @@ -1927,6 +2000,9 @@ comment at the start of cc-engine.el for more info." (with-silent-modifications (while (progn + ;; Each time round the next while form, we move back over a ladder + ;; and append any simple WS preceding it, if possible joining with + ;; the previous ladder. (while (when (and rung-is-marked (not (bobp)) @@ -2035,6 +2111,15 @@ comment at the start of cc-engine.el for more info." ;; narrowed out, and we can't risk marking the simple ws ;; at the end of it. (goto-char next-rung-pos) + t) + + ((and c-opt-cpp-prefix + (save-excursion + (and (< (skip-syntax-backward "w_") 0) + (progn (setq next-rung-pos (point)) + (looking-at c-noise-macro-name-re))))) + ;; Skipped over a noise macro + (goto-char next-rung-pos) t))) ;; We've searched over a piece of non-white syntactic ws. See if this @@ -2198,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. @@ -2222,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 @@ -2314,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 @@ -2670,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) @@ -3249,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 @@ -3521,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) @@ -3548,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)) @@ -4025,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 @@ -4088,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 @@ -4236,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 @@ -4546,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)) @@ -4569,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) @@ -4615,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) @@ -4679,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 @@ -4832,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 @@ -4895,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 @@ -4917,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) @@ -5015,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' @@ -5065,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. @@ -5322,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) @@ -5577,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 @@ -5600,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 <...> @@ -5697,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. @@ -5811,13 +6673,16 @@ comment at the start of cc-engine.el for more info." `(c-forward-type) `(c-forward-name))) nil - (and (looking-at c-keywords-regexp) - (c-forward-keyword-clause 1)))) + (cond ((looking-at c-keywords-regexp) + (c-forward-keyword-clause 1)) + ((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 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))) + ,(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) @@ -5835,6 +6700,17 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (c-forward-keyword-prefixed-id ,type))))) +(defun c-forward-noise-clause () + ;; Point is at a c-noise-macro-with-parens-names macro identifier. Go + ;; forward over this name, any parenthesis expression which follows it, and + ;; any syntactic WS, ending up at the next token. If there is an unbalanced + ;; paren expression, leave point at it. Always Return t. + (c-forward-token-2) + (if (and (eq (char-after) ?\() + (c-go-list-forward)) + (c-forward-syntactic-ws)) + t) + (defun c-forward-keyword-clause (match) ;; Submatch MATCH in the current match data is assumed to surround a ;; token. If it's a keyword, move over it and any immediately @@ -5984,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) @@ -6030,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-strictly) - (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 '<' @@ -6372,9 +7250,7 @@ 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) - (c-last-identifier-range)) + (when (let (c-last-identifier-range) (c-forward-<>-arglist nil)) (c-forward-syntactic-ws) @@ -6468,6 +7344,17 @@ comment at the start of cc-engine.el for more info." ; "typedef". (goto-char (match-end 1)) (c-forward-syntactic-ws) + + (while (cond + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((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)) (setq name-res (c-forward-name)) @@ -6605,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 @@ -6694,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 ":" @@ -6704,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) @@ -6716,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)) @@ -6727,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 @@ -6740,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))) @@ -6762,7 +7685,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 (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) ?:) @@ -6778,7 +7701,7 @@ 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) @@ -6839,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 @@ -6861,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) @@ -6875,31 +7800,41 @@ comment at the start of cc-engine.el for more info." ;; of the while. These are, e.g. "*" in "int *foo" or "(" and ;; "*" in "int (*foo) (void)" (Note similar code in ;; `c-forward-decl-or-cast-1'.) - (while (and (looking-at c-type-decl-prefix-key) - (if (and (c-major-mode-is 'c++-mode) - (match-beginning 3)) - ;; If the third submatch matches in C++ then - ;; we're looking at an identifier that's a - ;; prefix only if it specifies a member pointer. - (progn - (setq id-start (point)) - (c-forward-name) - (if (looking-at "\\(::\\)") - ;; We only check for a trailing "::" and - ;; let the "*" that should follow be - ;; matched in the next round. - t - ;; It turned out to be the real identifier, - ;; so flag that and stop. - (setq got-identifier t) - nil)) - t)) - (if (eq (char-after) ?\() - (progn - (setq paren-depth (1+ paren-depth)) - (forward-char)) - (goto-char (match-end 1))) - (c-forward-syntactic-ws)) + (while + (cond + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((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) + (match-beginning 3)) + ;; If the third submatch matches in C++ then + ;; we're looking at an identifier that's a + ;; prefix only if it specifies a member pointer. + (progn + (setq id-start (point)) + (c-forward-name) + (if (looking-at "\\(::\\)") + ;; We only check for a trailing "::" and + ;; let the "*" that should follow be + ;; matched in the next round. + t + ;; It turned out to be the real identifier, + ;; so flag that and stop. + (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)) + (forward-char)) + (goto-char (match-end 1))) + (c-forward-syntactic-ws) + t))) ;; If we haven't passed the identifier already, do it now. (unless got-identifier @@ -6924,9 +7859,13 @@ comment at the start of cc-engine.el for more info." ;; Skip over any trailing bit, such as "__attribute__". (progn - (when (looking-at c-decl-hangon-key) - (c-forward-keyword-clause 1)) - (<= (point) limit)) + (while (cond + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)))) + (<= (point) limit)) ;; Search syntactically to the end of the declarator (";", ;; ",", a closing paren, eob etc) or to the beginning of an @@ -6943,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))) @@ -6957,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 ... @@ -6990,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 @@ -6998,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 @@ -7015,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 @@ -7090,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)) @@ -7105,18 +8068,25 @@ comment at the start of cc-engine.el for more info." ;; macros like __INLINE__, so we recognize both types and known ;; specifiers after them too. (while - (let* ((start (point)) kwd-sym kwd-clause-end found-type) + (let* ((start (point)) kwd-sym kwd-clause-end found-type noise-start) + (cond ;; Look for a specifier keyword clause. - (when (or (looking-at c-prefix-spec-kwds-re) ;FIXME!!! includes auto - (and (c-major-mode-is 'java-mode) - (looking-at "@[A-Za-z0-9]+"))) - (if (save-match-data (looking-at c-typedef-key)) - (setq at-typedef t)) + ((or (looking-at c-prefix-spec-kwds-re) + (and (c-major-mode-is 'java-mode) + (looking-at "@[A-Za-z0-9]+"))) + (save-match-data + (if (looking-at c-typedef-key) + (setq at-typedef t))) (setq kwd-sym (c-keyword-sym (match-string 1))) (save-excursion (c-forward-keyword-clause 1) (setq kwd-clause-end (point)))) + ((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)))) (when (setq found-type (c-forward-type t)) ; brace-block-too ;; Found a known or possible type or a prefix of a known type. @@ -7154,16 +8124,17 @@ comment at the start of cc-engine.el for more info." backup-at-type-decl nil backup-maybe-typeless nil)) - (if kwd-sym + (if (or kwd-sym noise-start) (progn ;; Handle known specifier keywords and ;; `c-decl-hangon-kwds' which can occur after known ;; types. - (if (c-keyword-member kwd-sym 'c-decl-hangon-kwds) - ;; It's a hang-on keyword that can occur anywhere. + (if (or (c-keyword-member kwd-sym 'c-decl-hangon-kwds) + noise-start) + ;; It's a hang-on keyword or noise clause that can occur + ;; anywhere. (progn - (setq at-decl-or-cast t) (if at-type ;; Move the identifier start position if ;; we've passed a type. @@ -7215,8 +8186,12 @@ comment at the start of cc-engine.el for more info." ;; If a known type was found, we still need to skip over any ;; hangon keyword clauses after it. Otherwise it has already ;; been done in the loop above. - (while (looking-at c-decl-hangon-key) - (c-forward-keyword-clause 1)) + (while + (cond ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)))) (setq id-start (point))) ((eq at-type 'prefix) @@ -7297,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) @@ -7308,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)) @@ -7331,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) @@ -7340,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)) @@ -7412,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 @@ -7421,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 @@ -7454,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. @@ -7542,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 @@ -7592,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 @@ -7600,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) @@ -7696,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 @@ -7714,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) @@ -7837,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. @@ -8272,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 @@ -8598,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("))) @@ -8773,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 @@ -8879,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 @@ -8945,7 +10022,10 @@ comment at the start of cc-engine.el for more info." ((and (eql (char-after) ?:) (save-excursion (c-backward-syntactic-ws) - (c-on-identifier))) + (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) @@ -8986,6 +10066,12 @@ comment at the start of cc-engine.el for more info." t) ((looking-at c-after-brace-list-key) t) ((looking-at c-brace-list-key) nil) + ((eq (char-after) ?\() + (and (eq (c-backward-token-2) 0) + (or (looking-at c-decl-hangon-key) + (and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re))))) + ((and c-recognize-<>-arglists (eq (char-after) ?<) (looking-at "\\s(")) @@ -8994,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. @@ -9013,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)) @@ -9029,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., `({ })', @@ -9231,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)) @@ -9274,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)))) @@ -9288,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) @@ -9313,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)))) @@ -9341,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".) @@ -9710,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 @@ -9746,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' @@ -9973,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 @@ -10245,32 +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 (looking-at c-specifier-key) - (goto-char (match-end 1)) - (c-forward-syntactic-ws indent-point)) - (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, @@ -10300,9 +11538,12 @@ comment at the start of cc-engine.el for more info." (t (save-excursion (c-beginning-of-decl-1 lim) - (while (looking-at c-specifier-key) - (goto-char (match-end 1)) - (c-forward-syntactic-ws indent-point)) + (while (cond + ((looking-at c-specifier-key) + (c-forward-keyword-clause 1)) + ((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, ;; 2007-11-09) @@ -10933,9 +12174,12 @@ comment at the start of cc-engine.el for more info." (c-beginning-of-statement-1 (c-safe-position (1- containing-sexp) paren-state)) (c-forward-token-2 0) - (while (looking-at c-specifier-key) - (goto-char (match-end 1)) - (c-forward-syntactic-ws)) + (while (cond + ((looking-at c-specifier-key) + (c-forward-keyword-clause 1)) + ((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)))) ;; CASE 9B: brace-list-close brace diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index d8643677192..c213f1f198e 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 @@ -987,7 +992,7 @@ casts and declarations are fontified. Used on level 2 and higher." (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'.) @@ -997,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. @@ -1021,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 @@ -1162,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 @@ -1194,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)) @@ -1216,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) ?\() @@ -1238,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) ?<)) @@ -1263,6 +1311,13 @@ casts and declarations are fontified. Used on level 2 and higher." ;; multiline declaration. (c-put-char-property (1- match-pos) 'c-type 'c-decl-arg-start)) + ;; Got an open paren preceded by an arith operator. + ((and (eq (char-before match-pos) ?\() + (save-excursion + (and (zerop (c-backward-token-2 2)) + (looking-at c-arithmetic-op-regexp)))) + (setq context nil + c-restricted-<>-arglists nil)) (t (setq context 'arglist c-restricted-<>-arglists t)))) @@ -1283,182 +1338,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. @@ -1488,6 +1493,22 @@ casts and declarations are fontified. Used on level 2 and higher." nil))) +(defun c-font-lock-enum-body (limit) + ;; Fontify the identifiers of each enum we find by searching forward. + ;; + ;; 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". + (while (search-forward-regexp c-enum-clause-introduction-re limit t) + (when (save-excursion + (backward-char) + (c-backward-over-enum-header)) + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t nil t))) + nil) + (defun c-font-lock-enum-tail (limit) ;; Fontify an enum's identifiers when POINT is within the enum's brace ;; block. @@ -1512,9 +1533,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 @@ -1527,7 +1591,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) @@ -1535,15 +1599,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 @@ -1572,7 +1779,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)) @@ -1594,7 +1801,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)) @@ -1606,7 +1813,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)) @@ -1648,6 +1855,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 @@ -1658,6 +1869,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). @@ -1699,10 +1913,18 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." (unless (c-skip-comments-and-strings limit) (c-forward-syntactic-ws) ;; Handle prefix declaration specifiers. - (when (or (looking-at c-prefix-spec-kwds-re) - (and (c-major-mode-is 'java-mode) - (looking-at "@[A-Za-z0-9]+"))) - (c-forward-keyword-clause 1)) + (while + (or + (when (or (looking-at c-prefix-spec-kwds-re) + (and (c-major-mode-is 'java-mode) + (looking-at "@[A-Za-z0-9]+"))) + (c-forward-keyword-clause 1) + t) + (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) `(when (and (c-forward-type) (eq (char-after) ?=)) @@ -1814,29 +2036,14 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." generic casts and declarations are fontified. Used on level 2 and higher." - t `(,@(when (c-lang-const c-brace-id-list-kwds) + t `(,@(when (c-lang-const c-brace-list-decl-kwds) ;; Fontify the remaining identifiers inside an enum list when we start ;; inside it. `(c-font-lock-enum-tail ;; Fontify the identifiers inside enum lists. (The enum type ;; name is handled by `c-simple-decl-matchers' or ;; `c-complex-decl-matchers' below. - (,(c-make-font-lock-search-function - (concat - "\\<\\(" - (c-make-keywords-re nil (c-lang-const c-brace-id-list-kwds)) - "\\)\\>" - ;; Disallow various common punctuation chars that can't come - ;; before the '{' of the enum list, to avoid searching too far. - "[^][{}();/#=]*" - "{") - '((c-font-lock-declarators limit t nil) - (save-match-data - (goto-char (match-end 0)) - (c-put-char-property (1- (point)) 'c-type - 'c-decl-id-start) - (c-forward-syntactic-ws)) - (goto-char (match-end 0))))))) + c-font-lock-enum-body)) ;; Fontify labels after goto etc. ,@(when (c-lang-const c-before-label-kwds) @@ -2229,7 +2436,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) @@ -2401,10 +2608,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 dd1bccf3d96..e80dc922e5a 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) @@ -619,6 +637,11 @@ This is of the form that fits inside [ ] in a regexp." objc (concat c-alnum "_$@")) (c-lang-defvar c-symbol-chars (c-lang-const c-symbol-chars)) +(c-lang-defconst c-symbol-char-key + "Regexp matching a sequence of at least one identifier character." + t (concat "[" (c-lang-const c-symbol-chars) "]+")) +(c-lang-defvar c-symbol-char-key (c-lang-const c-symbol-char-key)) + (c-lang-defconst c-symbol-key "Regexp matching identifiers and keywords (with submatch 0). Assumed to match if `c-symbol-start' matches on the same position." @@ -1225,6 +1248,22 @@ operators." (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) +(c-lang-defconst c-arithmetic-operators + "List of all arithmetic operators, including \"+=\", etc." + ;; Note: in the following, there are too many operators for AWK and IDL. + t (append (c-lang-const c-assignment-operators) + '("+" "-" "*" "/" "%" + "<<" ">>" + "<" ">" "<=" ">=" + "==" "!=" + "&" "^" "|" + "&&" "||"))) + +(c-lang-defconst c-arithmetic-op-regexp + t (c-make-keywords-re nil + (c-lang-const c-arithmetic-operators))) +(c-lang-defvar c-arithmetic-op-regexp (c-lang-const c-arithmetic-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. @@ -1310,6 +1349,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 @@ -1325,6 +1372,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. @@ -1716,6 +1790,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))) @@ -1778,7 +1862,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 @@ -1807,6 +1891,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. @@ -1980,8 +2076,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. @@ -2249,7 +2345,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 @@ -2297,6 +2398,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 @@ -2496,6 +2606,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 @@ -2918,6 +3063,10 @@ Identifier syntax is in effect when this is matched \(see "\\)" "\\([^=]\\|$\\)") c++ (concat "\\(" + "&&" + "\\|" + "\\.\\.\\." + "\\|" "[*(&]" "\\|" (c-lang-const c-type-decl-prefix-key) @@ -2935,6 +3084,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 @@ -3064,7 +3235,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 '((?{ . ?}) (?\[ . ?\]) (?< . ?>))) @@ -3076,6 +3247,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 @@ -3114,6 +3292,24 @@ the invalidity of the putative template construct." c++ "[<;{},>()]") (c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re)) +(c-lang-defconst c-enum-clause-introduction-re + ;; A regexp loosely matching the start of an enum clause, starting at the + ;; keyword itself, and extending up to the "{". It may match text which + ;; isn't such a construct; more accurate tests will rule these out when + ;; needed. + t (if (c-lang-const c-brace-list-decl-kwds) + (concat + "\\<\\(" + (c-make-keywords-re nil (c-lang-const c-brace-list-decl-kwds)) + "\\)\\>" + ;; Disallow various common punctuation chars that can't come + ;; before the '{' of the enum list, to avoid searching too far. + "[^][{};/#=]*" + "{") + "\\<\\>")) +(c-lang-defvar c-enum-clause-introduction-re + (c-lang-const c-enum-clause-introduction-re)) + (c-lang-defconst c-enums-contain-decls "Non-nil means that an enum structure can contain declarations." t nil @@ -3213,8 +3409,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 738870b727a..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. @@ -141,7 +154,18 @@ ;; derived-mode-ex.el>. (defun c-leave-cc-mode-mode () - (setq c-buffer-is-cc-mode nil)) + (when c-buffer-is-cc-mode + (save-restriction + (widen) + (c-save-buffer-state () + (c-clear-char-properties (point-min) (point-max) 'category) + (c-clear-char-properties (point-min) (point-max) 'syntax-table) + (c-clear-char-properties (point-min) (point-max) 'c-is-sws) + (c-clear-char-properties (point-min) (point-max) 'c-in-sws) + (c-clear-char-properties (point-min) (point-max) 'c-type) + (if (c-major-mode-is 'awk-mode) + (c-clear-char-properties (point-min) (point-max) 'c-awk-NL-prop)))) + (setq c-buffer-is-cc-mode nil))) (defun c-init-language-vars-for (mode) "Initialize the language variables for one of the language modes @@ -468,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 @@ -528,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) @@ -641,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. @@ -674,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]") @@ -842,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 @@ -862,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 @@ -873,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 @@ -940,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). @@ -969,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. @@ -988,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) @@ -1007,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 @@ -1016,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 @@ -1130,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) @@ -1181,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) @@ -1219,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 @@ -1233,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 @@ -1446,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 @@ -1476,18 +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-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++ @@ -1531,18 +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-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 @@ -1584,18 +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-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 @@ -1645,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 @@ -1694,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 @@ -1746,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 @@ -1775,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) @@ -1810,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 b46b9b82704..7a6f4baaa73 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -247,7 +247,7 @@ See `c-offsets-alist'." ;;; 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 @@ -260,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\". @@ -277,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 @@ -286,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 @@ -308,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 @@ -317,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'. @@ -333,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 @@ -352,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: @@ -367,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) @@ -391,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) @@ -465,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 @@ -488,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 @@ -507,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. @@ -564,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. @@ -634,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 @@ -654,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: @@ -751,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). @@ -815,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). @@ -838,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 @@ -855,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 @@ -865,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 @@ -874,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 @@ -884,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) @@ -901,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 @@ -931,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 @@ -953,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." @@ -961,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: @@ -981,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 @@ -990,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 @@ -1001,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 @@ -1411,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 @@ -1442,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 @@ -1499,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 @@ -1513,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." @@ -1632,12 +1634,53 @@ names).")) :type 'c-extra-types-widget :group 'c) - -;; Non-customizable variables, still part of the interface to CC Mode -;; The following two are preparations for Emacs 25.2 (2016-05-09): +(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 +like \"????\" which are syntactic noise. Such a macro/extension is complete in +itself, never having parentheses. All these names must be syntactically valid +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 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__\") +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 + ;; `c-noise-macro-name-re' and `c-noise-macro-with-parens-name-re'. + (setq c-noise-macro-with-parens-name-re + (cond ((null c-noise-macro-with-parens-names) "\\<\\>") + ((consp c-noise-macro-with-parens-names) + (concat (regexp-opt c-noise-macro-with-parens-names t) + "\\([^[:alnum:]_$]\\|$\\)")) + ((stringp c-noise-macro-with-parens-names) + (copy-sequence c-noise-macro-with-parens-names)) + (t (error "c-make-noise-macro-regexps: \ +c-noise-macro-with-parens-names is invalid: %s" c-noise-macro-with-parens-names)))) + (setq c-noise-macro-name-re + (cond ((null c-noise-macro-names) "\\<\\>") + ((consp c-noise-macro-names) + (concat (regexp-opt c-noise-macro-names t) + "\\([^[:alnum:]_$]\\|$\\)")) + ((stringp c-noise-macro-names) + (copy-sequence c-noise-macro-names)) + (t (error "c-make-noise-macro-regexps: \ +c-noise-macro-names is invalid: %s" c-noise-macro-names))))) + +;; Non-customizable variables, still part of the interface to CC Mode (defvar c-macro-with-semi-re nil ;; Regular expression which matches a (#define'd) symbol whose expansion ;; ends with a semicolon. @@ -1659,10 +1702,7 @@ 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) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f060b571b7c..7f20e79a263 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -130,7 +130,7 @@ and a string describing how the process finished.") (defvar compilation-num-errors-found) ;; If you make any changes to `compilation-error-regexp-alist-alist', -;; be sure to run the ERT test in test/automated/compile-tests.el. +;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el. ;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit (defvar compilation-error-regexp-alist-alist @@ -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)) @@ -223,6 +230,13 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) nil 1 nil 2 0 (2 (compilation-face '(3)))) + (clang-include + ,(rx bol "In file included from " + (group (+ (not (any ?\n ?:)))) ?: + (group (+ (any (?0 . ?9)))) ?: + eol) + 1 2 nil 0) + (gcc-include "^\\(?:In file included \\| \\|\t\\)from \ \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\ diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 83eded136eb..1138b4d39af 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4,7 +4,7 @@ ;; Author: Ilya Zakharevich ;; Bob Olson -;; Maintainer: Ilya Zakharevich <ilyaz@cpan.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, Perl ;; This file is part of GNU Emacs. @@ -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) @@ -1126,7 +1126,28 @@ versions of Emacs." ;; expansion manually. Any other suggestions? (require 'cl)) -(defvar cperl-mode-abbrev-table nil +(define-abbrev-table 'cperl-mode-abbrev-table + '( + ("if" "if" cperl-electric-keyword :system t) + ("elsif" "elsif" cperl-electric-keyword :system t) + ("while" "while" cperl-electric-keyword :system t) + ("until" "until" cperl-electric-keyword :system t) + ("unless" "unless" cperl-electric-keyword :system t) + ("else" "else" cperl-electric-else :system t) + ("continue" "continue" cperl-electric-else :system t) + ("for" "for" cperl-electric-keyword :system t) + ("foreach" "foreach" cperl-electric-keyword :system t) + ("formy" "formy" cperl-electric-keyword :system t) + ("foreachmy" "foreachmy" cperl-electric-keyword :system t) + ("do" "do" cperl-electric-keyword :system t) + ("=pod" "=pod" cperl-electric-pod :system t) + ("=over" "=over" cperl-electric-pod :system t) + ("=head1" "=head1" cperl-electric-pod :system t) + ("=head2" "=head2" cperl-electric-pod :system t) + ("pod" "pod" cperl-electric-pod :system t) + ("over" "over" cperl-electric-pod :system t) + ("head1" "head1" cperl-electric-pod :system t) + ("head2" "head2" cperl-electric-pod :system t)) "Abbrev table in use in CPerl mode buffers.") (add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))) @@ -1708,29 +1729,6 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command [(control c) (control h) f]))) - (let ((prev-a-c abbrevs-changed)) - (define-abbrev-table 'cperl-mode-abbrev-table '( - ("if" "if" cperl-electric-keyword 0) - ("elsif" "elsif" cperl-electric-keyword 0) - ("while" "while" cperl-electric-keyword 0) - ("until" "until" cperl-electric-keyword 0) - ("unless" "unless" cperl-electric-keyword 0) - ("else" "else" cperl-electric-else 0) - ("continue" "continue" cperl-electric-else 0) - ("for" "for" cperl-electric-keyword 0) - ("foreach" "foreach" cperl-electric-keyword 0) - ("formy" "formy" cperl-electric-keyword 0) - ("foreachmy" "foreachmy" cperl-electric-keyword 0) - ("do" "do" cperl-electric-keyword 0) - ("=pod" "=pod" cperl-electric-pod 0) - ("=over" "=over" cperl-electric-pod 0) - ("=head1" "=head1" cperl-electric-pod 0) - ("=head2" "=head2" cperl-electric-pod 0) - ("pod" "pod" cperl-electric-pod 0) - ("over" "over" cperl-electric-pod 0) - ("head1" "head1" cperl-electric-pod 0) - ("head2" "head2" cperl-electric-pod 0))) - (setq abbrevs-changed prev-a-c)) (setq local-abbrev-table cperl-mode-abbrev-table) (if (cperl-val 'cperl-electric-keywords) (abbrev-mode 1)) @@ -8578,7 +8576,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 d02951dcf62..d6f26795132 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -245,11 +245,8 @@ Blank lines separate paragraphs. Semicolons start comments. ;; Font-locking support. (defun elisp--font-lock-flush-elisp-buffers (&optional file) - ;; FIXME: Aren't we only ever called from after-load-functions? - ;; Don't flush during load unless called from after-load-functions. - ;; In that case, FILE is non-nil. It's somehow strange that - ;; load-in-progress is t when an after-load-function is called since - ;; that should run *after* the load... + ;; We're only ever called from after-load-functions, load-in-progress can + ;; still be t in case of nested loads. (when (or (not load-in-progress) file) ;; FIXME: If the loaded file did not define any macros, there shouldn't ;; be any need to font-lock-flush all the Elisp buffers. @@ -721,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 @@ -1061,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'. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d37ab8a9817..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)))) @@ -1921,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))) @@ -1945,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)) @@ -2107,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))) 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 978b81699fc..4f8709a21d7 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1976,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 @@ -2492,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 @@ -2518,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 @@ -2650,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 f04a7226d18..5112c6bd638 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -227,6 +227,22 @@ to determine whether cdr should not be excluded." (const :tag "No ignored files" nil)) :group 'grep) +(defcustom grep-save-buffers 'ask + "If non-nil, save buffers before running the grep commands. +If `ask', ask before saving. If a function, call it with no arguments +with each buffer current, as a predicate to determine whether that +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 "26.1" + :type '(choice + (const :tag "Ask before saving" ask) + (const :tag "Don't save buffers" nil) + function + (other :tag "Save all buffers" t)) + :group 'grep) + (defcustom grep-error-screen-columns nil "If non-nil, column numbers in grep hits are screen columns. See `compilation-error-screen-columns'" @@ -527,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 @@ -621,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" @@ -639,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)))))))) @@ -728,6 +744,12 @@ This function is called from `compilation-filter-hook'." grep-error-screen-columns) (add-hook 'compilation-filter-hook 'grep-filter nil t)) +(defun grep--save-buffers () + (when grep-save-buffers + (save-some-buffers (and (not (eq grep-save-buffers 'ask)) + (not (functionp grep-save-buffers))) + (and (functionp grep-save-buffers) + grep-save-buffers)))) ;;;###autoload (defun grep (command-args) @@ -759,6 +781,7 @@ list is empty)." 'grep-history (if current-prefix-arg nil default)))))) + (grep--save-buffers) ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. (compilation-start (if (and grep-use-null-device null-device) @@ -952,6 +975,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (let ((default-directory dir)) ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. + (grep--save-buffers) (compilation-start (if (and grep-use-null-device null-device) (concat command " " null-device) command) @@ -1014,6 +1038,7 @@ to specify a command to run." (read-from-minibuffer "Confirm: " command nil nil 'grep-find-history)) (add-to-history 'grep-find-history command)) + (grep--save-buffers) (let ((default-directory dir)) (compilation-start command 'grep-mode)) ;; Set default-directory if we started rgrep in the *grep* buffer. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 0ac48f5f527..0bdafdbac6e 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1188,36 +1188,30 @@ containing the executable being debugged." ;; correct line number, but life's too short. ;; d.love@dl.ac.uk (Dave Love) can be blamed for this -(defvar gud-irix-p - (and (string-match "^mips-[^-]*-irix" system-configuration) - (not (string-match "irix[6-9]\\.[1-9]" system-configuration))) +(defvar gud-irix-p nil "Non-nil to assume the interface appropriate for IRIX dbx. This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides a better solution in 6.1 upwards.") -(defvar gud-dbx-use-stopformat-p - (string-match "irix[6-9]\\.[1-9]" system-configuration) +(defvar gud-dbx-use-stopformat-p nil "Non-nil to use the dbx feature present at least from Irix 6.1 whereby $stopformat=1 produces an output format compatible with `gud-dbx-marker-filter'.") -;; [Irix dbx seems to be a moving target. The dbx output changed +;; [Irix dbx seemed to be a moving target. The dbx output changed ;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, ;; the output from `up' is no longer spotted by gud (and it's probably ;; not distinctive enough to try to match it -- use C-<, C-> ;; exclusively) . For 5.3 and 6.0, the $curline variable changed to ;; `long long'(why?!), so the printf stuff needed changing. The line ;; number was cast to `long' as a compromise between the new `long -;; long' and the original `int'. This is reported not to work in 6.2, +;; long' and the original `int'. This was reported not to work in 6.2, ;; so it's changed back to int -- don't make your sources too long. -;; From Irix6.1 (but not 6.0?) dbx supports an undocumented feature +;; From Irix6.1 (but not 6.0?) dbx supported an undocumented feature ;; whereby `set $stopformat=1' reportedly produces output compatible ;; with `gud-dbx-marker-filter', which we prefer. ;; The process filter is also somewhat ;; unreliable, sometimes not spotting the markers; I don't know -;; whether there's anything that can be done about that. It would be -;; much better if SGI could be persuaded to (re?)instate the MIPS -;; -emacs flag for gdb-like output (which ought to be possible as most -;; of the communication I've had over it has been from sgi.com).] +;; whether there's anything that can be done about that.] ;; this filter is influenced by the xdb one rather than the gdb one (defun gud-irixdbx-marker-filter (string) @@ -1959,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 () @@ -2573,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. @@ -2630,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. @@ -2864,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 6b5f51a3fbd..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: diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index e5460009a56..cabdf45458a 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -351,6 +351,10 @@ Use the command `hs-minor-mode' to toggle or set this variable.") (define-key map "\C-c@\C-\M-s" 'hs-show-all) (define-key map "\C-c@\C-l" 'hs-hide-level) (define-key map "\C-c@\C-c" 'hs-toggle-hiding) + (define-key map "\C-c@\C-a" 'hs-show-all) + (define-key map "\C-c@\C-t" 'hs-hide-all) + (define-key map "\C-c@\C-d" 'hs-hide-block) + (define-key map "\C-c@\C-e" 'hs-toggle-hiding) (define-key map [(shift mouse-2)] 'hs-mouse-toggle-hiding) map) "Keymap for hideshow minor mode.") diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9aa459d1bc7..e385e91f756 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 @@ -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 @@ -2254,7 +2255,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 @@ -3501,6 +3502,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))) @@ -3723,9 +3725,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) @@ -3738,7 +3740,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/octave.el b/lisp/progmodes/octave.el index f309565acff..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))) @@ -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/prog-mode.el b/lisp/progmodes/prog-mode.el index 3f25a0c0647..718b33932ed 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -49,6 +49,53 @@ map) "Keymap used for programming modes.") +(defvar prog-indentation-context nil + "When non-nil, provides context for indenting embedded code chunks. + +There are languages where part of the code is actually written in +a sub language, e.g., a Yacc/Bison or ANTLR grammar also consists +of plain C code. This variable enables the major mode of the +main language to use the indentation engine of the sub-mode for +lines in code chunks written in the sub-mode's language. + +When a major mode of such a main language decides to delegate the +indentation of a line/region to the indentation engine of the sub +mode, it should bind this variable to non-nil around the call. + +The non-nil value should be a list of the form: + + (FIRST-COLUMN (START . END) PREVIOUS-CHUNKS) + +FIRST-COLUMN is the column the indentation engine of the sub-mode +should use for top-level language constructs inside the code +chunk (instead of 0). + +START and END specify the region of the code chunk. END can be +nil, which stands for the value of `point-max'. The function +`prog-widen' uses this to restore restrictions imposed by the +sub-mode's indentation engine. + +PREVIOUS-CHUNKS, if non-nil, provides the indentation engine of +the sub-mode with the virtual context of the code chunk. Valid +values are: + + - A string containing text which the indentation engine can + consider as standing in front of the code chunk. To cache the + string's calculated syntactic information for repeated calls + with the same string, the sub-mode can add text-properties to + the string. + + A typical use case is for grammars with code chunks which are + to be indented like function bodies -- the string would contain + the corresponding function preamble. + + - A function, to be called with the start position of the current + chunk. It should return either the region of the previous chunk + as (PREV-START . PREV-END), or nil if there is no previous chunk. + + A typical use case are literate programming sources -- the + function would successively return the previous code chunks.") + (defun prog-indent-sexp (&optional defun) "Indent the expression after point. When interactively called with prefix, indent the enclosing defun @@ -62,6 +109,27 @@ instead." (end (progn (forward-sexp 1) (point)))) (indent-region start end nil)))) +(defun prog-first-column () + "Return the indentation column normally used for top-level constructs." + (or (car prog-indentation-context) 0)) + +(defun prog-widen () + "Remove restrictions (narrowing) from current code chunk or buffer. +This function should be used instead of `widen' in any function used +by the indentation engine to make it respect the value of +`prog-indentation-context'. + +This function (like `widen') is useful inside a +`save-restriction' to make the indentation correctly work when +narrowing is in effect." + (let ((chunk (cadr prog-indentation-context))) + (if chunk + ;; No call to `widen' is necessary here, as narrow-to-region + ;; changes (not just narrows) the existing restrictions + (narrow-to-region (car chunk) (or (cdr chunk) (point-max))) + (widen)))) + + (defvar-local prettify-symbols-alist nil "Alist of symbol prettifications. Each element looks like (SYMBOL . CHARACTER), where the symbol diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 212a5fa69ab..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" @@ -3329,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! @@ -3368,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))] @@ -3380,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)] @@ -3418,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] @@ -3435,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 2fc0d29ec9b..3b0694541b1 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -113,7 +113,7 @@ When the figure is finished these values should be replaced." (defcustom ps-mode-print-function (lambda () (let ((lpr-switches nil) - (lpr-command (if (memq system-type '(usg-unix-v hpux irix)) + (lpr-command (if (memq system-type '(usg-unix-v hpux)) "lp" "lpr"))) (lpr-buffer))) "Lisp function to print current buffer as PostScript." diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d0d4a7f766e..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 @@ -283,6 +283,18 @@ :version "24.3" :link '(emacs-commentary-link "python")) + +;;; 24.x Compat + + +(unless (fboundp 'prog-widen) + (defun prog-widen () + (widen))) + +(unless (fboundp 'prog-first-column) + (defun prog-first-column () + 0)) + ;;; Bindings @@ -318,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) @@ -549,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 @@ -759,7 +781,7 @@ work on `python-indent-calculate-indentation' instead." (interactive) (save-excursion (save-restriction - (widen) + (prog-widen) (goto-char (point-min)) (let ((block-end)) (while (and (not block-end) @@ -858,7 +880,7 @@ keyword - Point is on a line starting a dedenter block. - START is the position where the dedenter block starts." (save-restriction - (widen) + (prog-widen) (let ((ppss (save-excursion (beginning-of-line) (syntax-ppss)))) @@ -1005,10 +1027,10 @@ current context or a list of integers. The latter case is only happening for :at-dedenter-block-start context since the possibilities can be narrowed to specific indentation points." (save-restriction - (widen) + (prog-widen) (save-excursion (pcase (python-indent-context) - (`(:no-indent . ,_) 0) + (`(:no-indent . ,_) (prog-first-column)) ; usually 0 (`(,(or :after-line :after-comment :inside-string @@ -1046,7 +1068,7 @@ possibilities can be narrowed to specific indentation points." (let ((opening-block-start-points (python-info-dedenter-opening-block-positions))) (if (not opening-block-start-points) - 0 ; if not found default to first column + (prog-first-column) ; if not found default to first column (mapcar (lambda (pos) (save-excursion (goto-char pos) @@ -1064,7 +1086,7 @@ integers. Levels are returned in ascending order, and in the case INDENTATION is a list, this order is enforced." (if (listp indentation) (sort (copy-sequence indentation) #'<) - (nconc (number-sequence 0 (1- indentation) + (nconc (number-sequence (prog-first-column) (1- indentation) python-indent-offset) (list indentation)))) @@ -1089,7 +1111,7 @@ minimum." (python-indent--previous-level levels (current-indentation)) (if levels (apply #'max levels) - 0)))) + (prog-first-column))))) (defun python-indent-line (&optional previous) "Internal implementation of `python-indent-line-function'. @@ -2042,8 +2064,8 @@ virtualenv." (defun python-shell-calculate-pythonpath () "Calculate the PYTHONPATH using `python-shell-extra-pythonpaths'." (let ((pythonpath - (tramp-compat-split-string - (or (getenv "PYTHONPATH") "") path-separator))) + (split-string + (or (getenv "PYTHONPATH") "") path-separator 'omit))) (python-shell--add-to-path-with-priority pythonpath python-shell-extra-pythonpaths) (mapconcat 'identity pythonpath path-separator))) @@ -2114,7 +2136,7 @@ appends `python-shell-remote-exec-path' instead of `exec-path'." (md5 tramp-end-of-output))) unset vars item) (while env - (setq item (tramp-compat-split-string (car 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) @@ -2357,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 @@ -3128,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 @@ -4018,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 @@ -4038,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: " @@ -4346,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 @@ -4513,7 +4539,7 @@ Optional argument INCLUDE-TYPE indicates to include the type of the defun. This function can be used as the value of `add-log-current-defun-function' since it returns nil if point is not inside a defun." (save-restriction - (widen) + (prog-widen) (save-excursion (end-of-line 1) (let ((names) @@ -4696,7 +4722,7 @@ likely an invalid python file." (let ((point (python-info-dedenter-opening-block-position))) (when point (save-restriction - (widen) + (prog-widen) (message "Closes %s" (save-excursion (goto-char point) (buffer-substring @@ -4717,7 +4743,7 @@ statement." With optional argument LINE-NUMBER, check that line instead." (save-excursion (save-restriction - (widen) + (prog-widen) (when line-number (python-util-goto-line line-number)) (while (and (not (eobp)) @@ -4733,7 +4759,7 @@ With optional argument LINE-NUMBER, check that line instead." Optional argument LINE-NUMBER forces the line number to check against." (save-excursion (save-restriction - (widen) + (prog-widen) (when line-number (python-util-goto-line line-number)) (when (python-info-line-ends-backslash-p) @@ -4750,7 +4776,7 @@ When current line is continuation of another return the point where the continued line ends." (save-excursion (save-restriction - (widen) + (prog-widen) (let* ((context-type (progn (back-to-indentation) (python-syntax-context-type))) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index d75edbc84ef..e7b37acc3de 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -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 diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 27ce60bde44..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,18 +151,19 @@ (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)) (defvar scheme-mode-line-process "") (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)) @@ -270,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.") @@ -300,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+\\)" @@ -327,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.") @@ -393,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) @@ -415,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 @@ -467,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 @@ -475,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 @@ -546,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 0040adc2c2b..a2c869de879 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 @@ -1662,7 +1660,12 @@ with your script for an edit-interpret-debug cycle." (setq-local skeleton-filter-function 'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp - (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) + (concat + "^\\(" + "\\(function[ \t]\\)?[ \t]*[[:alnum:]]+[ \t]*([ \t]*)" + "\\|" + "function[ \t]+[[:alnum:]]+[ \t]*\\(([ \t]*)\\)?" + "\\)[ \t]*")) (setq-local add-log-current-defun-function #'sh-current-defun-name) (add-hook 'completion-at-point-functions #'sh-completion-at-point-function nil t) @@ -1680,6 +1683,7 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]bash\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") + ((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") (t sh-shell-file)) nil nil) @@ -2430,8 +2434,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 @@ -2900,7 +2904,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)) @@ -3106,8 +3110,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/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/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 8e0133006d6..4e9b43ba0d4 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-09-18-314cf1d-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.") @@ -230,10 +230,9 @@ STRING should be given if the last search was by `string-match' on STRING." `(customize ,var)) ) - (unless (boundp 'inhibit-point-motion-hooks) - (defvar inhibit-point-motion-hooks nil)) - (unless (boundp 'deactivate-mark) - (defvar deactivate-mark nil)) + (defvar inhibit-modification-hooks) + (defvar inhibit-point-motion-hooks) + (defvar deactivate-mark) ) ;; ;; OK, do this stuff if we are NOT XEmacs: @@ -327,6 +326,14 @@ wherever possible, since it is slow." (not (null pos))))))) (eval-and-compile + (cond + ((fboundp 'restore-buffer-modified-p) + ;; Faster, as does not update mode line when nothing changes + (defalias 'verilog-restore-buffer-modified-p 'restore-buffer-modified-p)) + (t + (defalias 'verilog-restore-buffer-modified-p 'set-buffer-modified-p)))) + +(eval-and-compile ;; Both xemacs and emacs (condition-case nil (require 'diff) ; diff-command and diff-switches @@ -342,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 @@ -741,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'." @@ -827,6 +846,10 @@ Function takes three arguments, the original buffer, the difference buffer, and the point in original buffer with the first difference.") +(defvar verilog-diff-ignore-regexp nil + "Non-nil specifies regexp which `verilog-diff-auto' will ignore. +This is typically nil.") + ;;; Compile support: ;; @@ -1115,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 PARAM=10, the AUTOINST has left the parameter as a -symbolic name. If `verilog-auto-inst-param-value' is set, this will +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. + +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 @@ -1310,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'.") ;; @@ -1353,8 +1416,10 @@ If set will become buffer local.") (define-key map "\M-\C-b" 'electric-verilog-backward-sexp) (define-key map "\M-\C-f" 'electric-verilog-forward-sexp) (define-key map "\M-\r" `electric-verilog-terminate-and-indent) - (define-key map "\M-\t" 'verilog-complete-word) - (define-key map "\M-?" 'verilog-show-completions) + (define-key map "\M-\t" (if (fboundp 'completion-at-point) + 'completion-at-point 'verilog-complete-word)) + (define-key map "\M-?" (if (fboundp 'completion-help-at-point) + 'completion-help-at-point 'verilog-show-completions)) ;; Note \C-c and letter are reserved for users (define-key map "\C-c`" 'verilog-lint-off) (define-key map "\C-c*" 'verilog-delete-auto-star-implicit) @@ -1363,7 +1428,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) @@ -1385,7 +1450,7 @@ If set will become buffer local.") (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" (verilog-easy-menu-filter - '("Verilog" + `("Verilog" ("Choose Compilation Action" ["None" (progn @@ -1477,7 +1542,8 @@ If set will become buffer local.") :help "Take a signal vector on the current line and expand it to multiple lines"] ["Insert begin-end block" verilog-insert-block :help "Insert begin ... end"] - ["Complete word" verilog-complete-word + ["Complete word" ,(if (fboundp 'completion-at-point) + 'completion-at-point 'verilog-complete-word) :help "Complete word at point"] "----" ["Recompute AUTOs" verilog-auto @@ -1740,7 +1806,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)) @@ -1754,7 +1820,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)) @@ -2540,15 +2606,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\\>\\)" ;; )) @@ -2791,10 +2857,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 )) @@ -2937,8 +3005,6 @@ find the errors." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - ;; FIXME: This goes against Emacs conventions. Use "_" syntax instead and - ;; then use regexps with things like "\\_<...\\_>". (modify-syntax-entry ?` "w" table) ; ` is part of definition symbols in Verilog (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\' "." table) @@ -3017,7 +3083,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 @@ -3225,56 +3291,63 @@ A change is considered significant if it affects the buffer text in any way that isn't completely restored again. Any user-visible changes to the buffer must not be within a `verilog-save-buffer-state'." - ;; From c-save-buffer-state - `(let* ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (verilog-no-change-functions t) - before-change-functions - after-change-functions - deactivate-mark - buffer-file-name ; Prevent primitives checking - buffer-file-truename) ; for file modification - (unwind-protect - (progn ,@body) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) + `(let ((inhibit-point-motion-hooks t) + (verilog-no-change-functions t)) + ,(if (fboundp 'with-silent-modifications) + `(with-silent-modifications ,@body) + ;; Backward compatible version of with-silent-modifications + `(let* ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-modification-hooks t) + ;; XEmacs ignores inhibit-modification-hooks. + before-change-functions after-change-functions + deactivate-mark + buffer-file-name ; Prevent primitives checking + buffer-file-truename) ; for file modification + (unwind-protect + (progn ,@body) + (and (not modified) + (buffer-modified-p) + (verilog-restore-buffer-modified-p nil))))))) -(defmacro verilog-save-no-change-functions (&rest body) - "Execute BODY forms, disabling all change hooks in BODY. -For insignificant changes, see instead `verilog-save-buffer-state'." - `(let* ((inhibit-point-motion-hooks t) - (verilog-no-change-functions t) - before-change-functions - after-change-functions) - (progn ,@body))) (defvar verilog-save-font-mod-hooked nil - "Local variable when inside a `verilog-save-font-mods' block.") + "Local variable when inside a `verilog-save-font-no-change-functions' block.") (make-variable-buffer-local 'verilog-save-font-mod-hooked) -(defmacro verilog-save-font-mods (&rest body) - "Execute BODY forms, disabling text modifications to allow performing BODY. +(defmacro verilog-save-font-no-change-functions (&rest body) + "Execute BODY forms, disabling all change hooks in BODY. Includes temporary disabling of `font-lock' to restore the buffer to full text form for parsing. Additional actions may be specified with -`verilog-before-save-font-hook' and `verilog-after-save-font-hook'." - ;; Before version 20, match-string with font-lock returns a - ;; vector that is not equal to the string. IE if on "input" - ;; nil==(equal "input" (progn (looking-at "input") (match-string 0))) - `(let* ((hooked (unless verilog-save-font-mod-hooked - (verilog-run-hooks 'verilog-before-save-font-hook) - t)) - (verilog-save-font-mod-hooked t) - (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode 0) - t))) - (unwind-protect - (progn ,@body) - ;; Unwind forms - (when fontlocked (font-lock-mode t)) - (when hooked (verilog-run-hooks 'verilog-after-save-font-hook))))) +`verilog-before-save-font-hook' and `verilog-after-save-font-hook'. +For insignificant changes, see instead `verilog-save-buffer-state'." + `(if verilog-save-font-mod-hooked ; Short-circuit a recursive call + (progn ,@body) + ;; Before version 20, match-string with font-lock returns a + ;; vector that is not equal to the string. IE if on "input" + ;; nil==(equal "input" (progn (looking-at "input") (match-string 0))) + ;; Therefore we must remove and restore font-lock mode + (verilog-run-hooks 'verilog-before-save-font-hook) + (let* ((verilog-save-font-mod-hooked (- (point-max) (point-min))) + ;; Significant speed savings with no font-lock properties + (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode) + (font-lock-mode 0) + t))) + (run-hook-with-args 'before-change-functions (point-min) (point-max)) + (unwind-protect + ;; Must inhibit and restore hooks before restoring font-lock + (let* ((inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + (verilog-no-change-functions t) + ;; XEmacs and pre-Emacs 21 ignore inhibit-modification-hooks. + before-change-functions after-change-functions) + (progn ,@body)) + ;; Unwind forms + (run-hook-with-args 'after-change-functions (point-min) (point-max) + verilog-save-font-mod-hooked) ; old length + (when fontlocked (font-lock-mode t)) + (verilog-run-hooks 'verilog-after-save-font-hook))))) ;; ;; Comment detection and caching @@ -3558,28 +3631,28 @@ 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 @@ -3736,7 +3809,7 @@ AUTO expansion functions are, in part: Some other functions are: - \\[verilog-complete-word] Complete word with appropriate possibilities. + \\[completion-at-point] Complete word with appropriate possibilities. \\[verilog-mark-defun] Mark function. \\[verilog-beg-of-defun] Move to beginning of current function. \\[verilog-end-of-defun] Move to end of current function. @@ -3850,10 +3923,35 @@ Key bindings specific to `verilog-mode-map' are: verilog-forward-sexp-function) hs-special-modes-alist)))) + (add-hook 'completion-at-point-functions + #'verilog-completion-at-point nil 'local) + ;; Stuff for autos (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: ;; @@ -4521,7 +4619,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) @@ -5647,13 +5745,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\\>") @@ -5781,7 +5883,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 @@ -5803,7 +5905,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\\>") @@ -6255,7 +6357,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 @@ -7102,6 +7204,9 @@ Region is defined by B and EDPOS." Repeated use of \\[verilog-complete-word] will show you all of them. Normally, when there is more than one possible completion, it displays a list of all possible completions.") +(when (boundp 'completion-cycle-threshold) + (make-obsolete-variable + 'verilog-toggle-completions 'completion-cycle-threshold "26.1")) (defvar verilog-type-keywords @@ -7384,21 +7489,33 @@ exact match, nil otherwise." (defvar verilog-last-word-shown nil) (defvar verilog-last-completions nil) +(defun verilog-completion-at-point () + "Used as an element of `completion-at-point-functions'. +\(See also `verilog-type-keywords' and +`verilog-separator-keywords'.)" + (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) + (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) + (verilog-str (buffer-substring b e)) + ;; The following variable is used in verilog-completion + (verilog-buffer-to-use (current-buffer)) + (allcomp (if (and verilog-toggle-completions + (string= verilog-last-word-shown verilog-str)) + verilog-last-completions + (all-completions verilog-str 'verilog-completion)))) + (list b e allcomp))) + (defun verilog-complete-word () "Complete word at current point. \(See also `verilog-toggle-completions', `verilog-type-keywords', and `verilog-separator-keywords'.)" - ;; FIXME: Provide completion-at-point-function. + ;; NOTE: This is just a fallback for Emacs versions lacking + ;; `completion-at-point'. (interactive) - (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) - (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) + (let* ((comp-info (verilog-completion-at-point)) + (b (nth 0 comp-info)) + (e (nth 1 comp-info)) (verilog-str (buffer-substring b e)) - ;; The following variable is used in verilog-completion - (verilog-buffer-to-use (current-buffer)) - (allcomp (if (and verilog-toggle-completions - (string= verilog-last-word-shown verilog-str)) - verilog-last-completions - (all-completions verilog-str 'verilog-completion))) + (allcomp (nth 2 comp-info)) (match (if verilog-toggle-completions "" (try-completion verilog-str (mapcar (lambda (elm) @@ -7446,23 +7563,15 @@ and `verilog-separator-keywords'.)" (defun verilog-show-completions () "Show all possible completions at current point." + ;; NOTE: This is just a fallback for Emacs versions lacking + ;; `completion-help-at-point'. (interactive) - (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) - (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) - (verilog-str (buffer-substring b e)) - ;; The following variable is used in verilog-completion - (verilog-buffer-to-use (current-buffer)) - (allcomp (if (and verilog-toggle-completions - (string= verilog-last-word-shown verilog-str)) - verilog-last-completions - (all-completions verilog-str 'verilog-completion)))) - ;; Show possible completions in a temporary buffer. - (with-output-to-temp-buffer "*Completions*" - (display-completion-list allcomp)) - ;; Wait for a key press. Then delete *Completion* window - (momentary-string-display "" (point)) - (delete-window (get-buffer-window (get-buffer "*Completions*"))))) - + ;; Show possible completions in a temporary buffer. + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (nth 2 (verilog-completion-at-point)))) + ;; Wait for a key press. Then delete *Completion* window + (momentary-string-display "" (point)) + (delete-window (get-buffer-window (get-buffer "*Completions*")))) (defun verilog-get-default-symbol () "Return symbol around current point as a string." @@ -7786,7 +7895,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) @@ -8074,7 +8183,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." (when (and sv-busstring (not (equal sv-busstring (verilog-sig-bits sig)))) (when nil ; Debugging - (message (concat "Warning, can't merge into single bus %s%s" + (message (concat "Warning, can't merge into single bus `%s%s'" ", the AUTOs may be wrong") sv-name bus)) (setq buswarn ", Couldn't Merge")) @@ -8307,7 +8416,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)))) @@ -8377,18 +8487,19 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setcar (cdr (cdr (cdr newsig))) (if (verilog-sig-memory newsig) (concat (verilog-sig-memory newsig) (match-string 1)) - (match-string 1)))) + (match-string-no-properties 1)))) (vec ; Multidimensional (setq multidim (cons vec multidim)) (setq vec (verilog-string-replace-matches - "\\s-+" "" nil nil (match-string 1)))) + "\\s-+" "" nil nil (match-string-no-properties 1)))) (t ; Bit width (setq vec (verilog-string-replace-matches - "\\s-+" "" nil nil (match-string 1)))))) + "\\s-+" "" nil nil (match-string-no-properties 1)))))) ;; 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 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 @@ -8453,7 +8564,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 @@ -8573,21 +8685,31 @@ Return an array of [outputs inouts inputs wire reg assign const]." (defvar sigs-out-unk) (defvar sigs-temp) ;; These are known to be from other packages and may not be defined - (defvar diff-command nil) + (defvar diff-command) ;; There are known to be from newer versions of Emacs - (defvar create-lockfiles)) - -(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim) + (defvar create-lockfiles) + (defvar which-func-modes)) + +(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))) (if vec (setq vec (verilog-symbol-detick-denumber vec))) (if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim))) + (if mem (setq mem (verilog-symbol-detick-denumber mem))) (unless (or (not sig) (equal sig "")) ; Ignore .foo(1'b1) assignments (cond ((or (setq portdata (assoc port (verilog-decls-get-inouts submoddecls))) @@ -8597,11 +8719,10 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + 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))) @@ -8611,7 +8732,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "From " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) ;; Though ok in SV, in V2K code, propagating the @@ -8619,8 +8740,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))) @@ -8630,11 +8750,10 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To " comment) - (verilog-sig-memory portdata) + 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))) @@ -8643,10 +8762,10 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + 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 @@ -8656,20 +8775,20 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + 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 - (setq expr (verilog-string-replace-matches "/\\*\\(\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr)) + (setq expr (verilog-string-replace-matches "/\\*\\(\\.?\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr)) ;; Remove front operators (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) ;; @@ -8681,9 +8800,9 @@ 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) + (let (sig vec multidim mem) ;; Remove leading reduction operators, etc (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) ;;(message "vrsde-ptop: `%s'" expr) @@ -8703,12 +8822,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (when vec (setq multidim (cons vec multidim))) (setq vec (match-string 1 expr) expr (substring expr (match-end 0)))) + ;; Find .[unpacked_memory] or .[unpacked][unpacked]... + (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)))))) + (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) @@ -8717,23 +8841,23 @@ Inserts the list of signals found, using submodi to look up each port." (while (not done) ;; Get port name (cond ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*(\\s-*") - (setq port (match-string 1)) + (setq port (match-string-no-properties 1)) (goto-char (match-end 0))) ;; .\escaped ( ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*(\\s-*") - (setq port (concat (match-string 1) " ")) ; escaped id's need trailing space + (setq port (concat (match-string-no-properties 1) " ")) ; escaped id's need trailing space (goto-char (match-end 0))) ;; .name ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*[,)/]") (verilog-read-sub-decls-sig - submoddecls comment (match-string 1) t ; sig==t for .name - nil nil) ; vec multidim + 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 1) " ") t ; sig==t for .name - nil nil) ; vec multidim + 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 ((looking-at "\\s-*\\.[^(]*(") @@ -8747,28 +8871,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 - (verilog-string-remove-spaces (match-string 1)) ; sig - nil nil)) ; vec multidim + 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 - (verilog-string-remove-spaces (match-string 1)) ; sig - (match-string 2) nil)) ; vec multidim + 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 - (buffer-substring + 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 @@ -8792,7 +8917,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) @@ -8818,13 +8943,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)) @@ -8842,7 +8970,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)) @@ -8856,19 +8984,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)) @@ -8993,7 +9121,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... @@ -9009,7 +9138,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 @@ -9056,7 +9187,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) @@ -9104,7 +9235,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)))) @@ -9282,29 +9413,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) @@ -9372,6 +9517,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: @@ -9793,9 +9945,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 @@ -9894,7 +10051,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (or mif ignore-error (error (concat - "%s: Can't locate %s module definition%s" + "%s: Can't locate `%s' module definition%s" "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t%s") (verilog-point-text) module @@ -9959,9 +10116,9 @@ Cache the output of function so next call may have faster access." (t ;; Read from file ;; Clear then restore any highlighting to make emacs19 happy - (let (func-returns) - (verilog-save-font-mods - (setq func-returns (funcall function))) + (let ((func-returns + (verilog-save-font-no-change-functions + (funcall function)))) ;; Cache for next time (setq verilog-modi-cache-list (cons (list (list modi function) @@ -10003,7 +10160,7 @@ Report errors unless optional IGNORE-ERROR." (let* ((realname (verilog-symbol-detick name t)) (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi))))) (or modport ignore-error - (error "%s: Can't locate %s modport definition%s" + (error "%s: Can't locate `%s' modport definition%s" (verilog-point-text) name (if (not (equal name realname)) (concat " (Expanded macro to " realname ")") @@ -10193,7 +10350,7 @@ When MODI is non-null, also add to modi-cache, for tracking." ((equal direction "parameter") (verilog-modi-cache-add-gparams modi sigs)) (t - (error "Unsupported verilog-insert-definition direction: %s" direction)))) + (error "Unsupported verilog-insert-definition direction: `%s'" direction)))) (or dont-sort (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare))) (while sigs @@ -10215,8 +10372,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")) @@ -10224,7 +10382,7 @@ When MODI is non-null, also add to modi-cache, for tracking." (eval-when-compile (if (not (boundp 'indent-pt)) - (defvar indent-pt nil "Local used by insert-indent"))) + (defvar indent-pt nil "Local used by `verilog-insert-indent'."))) (defun verilog-insert-indent (&rest stuff) "Indent to position stored in local `indent-pt' variable, then insert STUFF. @@ -10510,6 +10668,41 @@ removed." (re-search-backward ",") (delete-char 1)))))) +(defun verilog-delete-auto-buffer () + "Perform `verilog-delete-auto' on the current buffer. +Intended for internal use inside a `verilog-save-font-no-change-functions' block." + ;; Allow user to customize + (verilog-run-hooks 'verilog-before-delete-auto-hook) + + ;; Remove those that have multi-line insertions, possibly with parameters + ;; We allow anything beginning with AUTO, so that users can add their own + ;; patterns + (verilog-auto-re-search-do + (concat "/\\*AUTO[A-Za-z0-9_]+" + ;; Optional parens or quoted parameter or .* for (((...))) + "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" + "\\*/") + 'verilog-delete-autos-lined) + ;; Remove those that are in parenthesis + (verilog-auto-re-search-do + (concat "/\\*" + (eval-when-compile + (verilog-regexp-words + `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" + "AUTOSENSE"))) + "\\*/") + 'verilog-delete-to-paren) + ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments + (verilog-auto-re-search-do "\\.\\*" + 'verilog-delete-auto-star-all) + ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed + (goto-char (point-min)) + (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([ \tLT0-9]*\\| LHS: .*\\)?$" nil t) + (replace-match "")) + + ;; Final customize + (verilog-run-hooks 'verilog-delete-auto-hook)) + (defun verilog-delete-auto () "Delete the automatic outputs, regs, and wires created by \\[verilog-auto]. Use \\[verilog-auto] to re-insert the updated AUTOs. @@ -10520,39 +10713,10 @@ called before and after this function, respectively." (save-excursion (if (buffer-file-name) (find-file-noselect (buffer-file-name))) ; To check we have latest version - (verilog-save-no-change-functions + (verilog-save-font-no-change-functions (verilog-save-scan-cache - ;; Allow user to customize - (verilog-run-hooks 'verilog-before-delete-auto-hook) - - ;; Remove those that have multi-line insertions, possibly with parameters - ;; We allow anything beginning with AUTO, so that users can add their own - ;; patterns - (verilog-auto-re-search-do - (concat "/\\*AUTO[A-Za-z0-9_]+" - ;; Optional parens or quoted parameter or .* for (((...))) - "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" - "\\*/") - 'verilog-delete-autos-lined) - ;; Remove those that are in parenthesis - (verilog-auto-re-search-do - (concat "/\\*" - (eval-when-compile - (verilog-regexp-words - `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" - "AUTOSENSE"))) - "\\*/") - 'verilog-delete-to-paren) - ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments - (verilog-auto-re-search-do "\\.\\*" - 'verilog-delete-auto-star-all) - ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed - (goto-char (point-min)) - (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([ \tLT0-9]*\\| LHS: .*\\)?$" nil t) - (replace-match "")) + (verilog-delete-auto-buffer))))) - ;; Final customize - (verilog-run-hooks 'verilog-delete-auto-hook))))) ;;; Auto inject: ;; @@ -10679,10 +10843,11 @@ Typing \\[verilog-inject-auto] will make this into: ;; Auto diff: ;; -(defun verilog-diff-buffers-p (b1 b2 &optional whitespace) +(defun verilog-diff-buffers-p (b1 b2 &optional whitespace regexp) "Return nil if buffers B1 and B2 have same contents. Else, return point in B1 that first mismatches. -If optional WHITESPACE true, ignore whitespace." +If optional WHITESPACE true, ignore whitespace. +If optional REGEXP, ignore differences matching it." (save-excursion (let* ((case-fold-search nil) ; compare-buffer-substrings cares (p1 (with-current-buffer b1 (goto-char (point-min)))) @@ -10703,6 +10868,15 @@ If optional WHITESPACE true, ignore whitespace." (goto-char p2) (skip-chars-forward " \t\n\r\f\v") (setq p2 (point)))) + (when regexp + (with-current-buffer b1 + (goto-char p1) + (when (looking-at regexp) + (setq p1 (match-end 0)))) + (with-current-buffer b2 + (goto-char p2) + (when (looking-at regexp) + (setq p2 (match-end 0))))) (setq size (min (- maxp1 p1) (- maxp2 p2))) (setq progress (compare-buffer-substrings b2 p2 (+ size p2) b1 p1 (+ size p1))) @@ -10723,7 +10897,7 @@ Ignores WHITESPACE if t, and writes output to stdout if SHOW." ;; call `diff' as `diff' has different calling semantics on different ;; versions of Emacs. (if (not (file-exists-p f1)) - (message "Buffer %s has no associated file on disc" (buffer-name b2)) + (message "Buffer `%s' has no associated file on disk" (buffer-name b2)) (with-temp-buffer "*Verilog-Diff*" (let ((outbuf (current-buffer)) (f2 (make-temp-file "vm-diff-auto-"))) @@ -10750,9 +10924,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 @@ -10791,7 +10965,7 @@ or `diff' in batch mode." ;; Restore name if unwind (with-current-buffer b1 (setq buffer-file-name name1))))) ;; - (setq diffpt (verilog-diff-buffers-p b1 b2 t)) + (setq diffpt (verilog-diff-buffers-p b1 b2 t verilog-diff-ignore-regexp)) (cond ((not diffpt) (unless noninteractive (message "AUTO expansion identical")) (kill-buffer newname)) ; Nice to cleanup after oneself @@ -11054,6 +11228,7 @@ If PAR-VALUES replace final strings with these parameter values." (vl-name (verilog-sig-name port-st)) (vl-width (verilog-sig-width port-st)) (vl-modport (verilog-sig-modport port-st)) + (vl-memory (verilog-sig-memory port-st)) (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) (vl-bits (if (or verilog-auto-inst-vector @@ -11078,15 +11253,25 @@ If PAR-VALUES replace final strings with these parameter values." (concat "\\<" (nth 0 (car check-values)) "\\>") (concat "(" (nth 1 (car check-values)) ")") t t vl-mbits) + vl-memory (when vl-memory + (verilog-string-replace-matches + (concat "\\<" (nth 0 (car check-values)) "\\>") + (concat "(" (nth 1 (car check-values)) ")") + t t vl-memory)) check-values (cdr check-values))) (setq vl-bits (verilog-simplify-range-expression vl-bits) vl-mbits (verilog-simplify-range-expression vl-mbits) + vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory)) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed ;; Default net value if not found - (setq dflt-bits (if (and (verilog-sig-bits port-st) - (or (verilog-sig-multidim port-st) - (verilog-sig-memory port-st))) - (concat "/*" vl-mbits vl-bits "*/") + (setq dflt-bits (if (or (and (verilog-sig-bits port-st) + (verilog-sig-multidim port-st)) + (verilog-sig-memory port-st)) + (concat "/*" vl-mbits vl-bits + ;; .[ used to separate packed from unpacked + (if vl-memory "." "") + (if vl-memory vl-memory "") + "*/") (concat vl-bits)) tpl-net (concat port (if (and vl-modport @@ -11157,7 +11342,7 @@ If PAR-VALUES replace final strings with these parameter values." (for-star (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) verilog-auto-inst-column)) - (verilog-insert " // Implicit .\*\n")) ;For some reason the . or * must be escaped... + (verilog-insert " // Implicit .*\n")) (t (insert "\n"))))) ;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3") @@ -12958,7 +13143,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 @@ -13316,13 +13501,16 @@ Typing \\[verilog-auto] will make this into: (sig-list-all (verilog-decls-get-iovars moddecls)) ;; (undecode-sig (or (assoc undecode-name sig-list-all) - (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name))) + (error "%s: Signal `%s' not found in design" + (verilog-point-text) undecode-name))) (undecode-enum (or (verilog-sig-enum undecode-sig) - (error "%s: Signal %s does not have an enum tag" (verilog-point-text) undecode-name))) + (error "%s: Signal `%s' does not have an enum tag" + (verilog-point-text) undecode-name))) ;; (enum-sigs (verilog-signals-not-in (or (verilog-signals-matching-enum sig-list-consts undecode-enum) - (error "%s: No state definitions for %s" (verilog-point-text) undecode-enum)) + (error "%s: No state definitions for `%s'" + (verilog-point-text) undecode-enum)) nil)) ;; (one-hot (or @@ -13518,120 +13706,115 @@ Wilson Snyder (wsnyder@wsnyder.org)." (unless noninteractive (message "Updating AUTOs...")) (if (fboundp 'dinotrace-unannotate-all) (dinotrace-unannotate-all)) - (verilog-save-font-mods + ;; Disable change hooks for speed + ;; This let can't be part of above let; must restore + ;; after-change-functions before font-lock resumes + (verilog-save-font-no-change-functions (let ((oldbuf (if (not (buffer-modified-p)) - (buffer-string))) - (case-fold-search verilog-case-fold) - ;; Cache directories; we don't write new files, so can't change - (verilog-dir-cache-preserving t) - ;; Cache current module - (verilog-modi-cache-current-enable t) - (verilog-modi-cache-current-max (point-min)) ; IE it's invalid - verilog-modi-cache-current) - (unwind-protect - ;; Disable change hooks for speed - ;; This let can't be part of above let; must restore - ;; after-change-functions before font-lock resumes - (verilog-save-no-change-functions - (verilog-save-scan-cache - (save-excursion - ;; Wipe cache; otherwise if we AUTOed a block above this one, - ;; we'll misremember we have generated IOs, confusing AUTOOUTPUT - (setq verilog-modi-cache-list nil) - ;; Local state - (verilog-read-auto-template-init) - ;; If we're not in verilog-mode, change syntax table so parsing works right - (unless (eq major-mode `verilog-mode) (verilog-mode)) - ;; Allow user to customize - (verilog-run-hooks 'verilog-before-auto-hook) - ;; Try to save the user from needing to revert-file to reread file local-variables - (verilog-auto-reeval-locals) - (verilog-read-auto-lisp-present) - (verilog-read-auto-lisp (point-min) (point-max)) - (verilog-getopt-flags) - ;; From here on out, we can cache anything we read from disk - (verilog-preserve-dir-cache - ;; These two may seem obvious to do always, but on large includes it can be way too slow - (when verilog-auto-read-includes - (verilog-read-includes) - (verilog-read-defines nil nil t)) - ;; Setup variables due to SystemVerilog expansion - (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup) - ;; This particular ordering is important - ;; INST: Lower modules correct, no internal dependencies, FIRST - (verilog-preserve-modi-cache - ;; Clear existing autos else we'll be screwed by existing ones - (verilog-delete-auto) - ;; Injection if appropriate - (when inject - (verilog-inject-inst) - (verilog-inject-sense) - (verilog-inject-arg)) - ;; - ;; Do user inserts first, so their code can insert AUTOs - (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" - 'verilog-auto-insert-lisp) - ;; Expand instances before need the signals the instances input/output - (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) - (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) - (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) - ;; Doesn't matter when done, but combine it with a common changer - (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) - (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) - ;; Must be done before autoin/out as creates a reg - (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) - ;; - ;; first in/outs from other files - (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) - (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) - (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) - (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) - (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) - ;; next in/outs which need previous sucked inputs first - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) - ;; Then tie off those in/outs - (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) - ;; These can be anywhere after AUTOINSERTLISP - (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) - ;; Wires/regs must be after inputs/outputs - (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) - (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) - (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) - (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) - (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) - ;; outputevery needs AUTOOUTPUTs done first - (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) - ;; After we've created all new variables - (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) - ;; Must be after all inputs outputs are generated - (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) - ;; User inserts - (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last) - ;; Fix line numbers (comments only) - (when verilog-auto-inst-template-numbers - (verilog-auto-templated-rel)) - (when verilog-auto-template-warn-unused - (verilog-auto-template-lint)))) - ;; - (verilog-run-hooks 'verilog-auto-hook) - ;; - (when verilog-auto-delete-trailing-whitespace - (verilog-delete-trailing-whitespace)) - ;; - (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)) - ;; - ;; If end result is same as when started, clear modified flag - (cond ((and oldbuf (equal oldbuf (buffer-string))) - (set-buffer-modified-p nil) - (unless noninteractive (message "Updating AUTOs...done (no changes)"))) - (t (unless noninteractive (message "Updating AUTOs...done")))) - ;; End of after-change protection - ))) - ;; Unwind forms - ;; Currently handled in verilog-save-font-mods - )))) + (buffer-string))) + (case-fold-search verilog-case-fold) + ;; Cache directories; we don't write new files, so can't change + (verilog-dir-cache-preserving t) + ;; Cache current module + (verilog-modi-cache-current-enable t) + (verilog-modi-cache-current-max (point-min)) ; IE it's invalid + verilog-modi-cache-current) + (verilog-save-scan-cache + (save-excursion + ;; Wipe cache; otherwise if we AUTOed a block above this one, + ;; we'll misremember we have generated IOs, confusing AUTOOUTPUT + (setq verilog-modi-cache-list nil) + ;; Local state + (verilog-read-auto-template-init) + ;; If we're not in verilog-mode, change syntax table so parsing works right + (unless (eq major-mode `verilog-mode) (verilog-mode)) + ;; Allow user to customize + (verilog-run-hooks 'verilog-before-auto-hook) + ;; Try to save the user from needing to revert-file to reread file local-variables + (verilog-auto-reeval-locals) + (verilog-read-auto-lisp-present) + (verilog-read-auto-lisp (point-min) (point-max)) + (verilog-getopt-flags) + ;; From here on out, we can cache anything we read from disk + (verilog-preserve-dir-cache + ;; These two may seem obvious to do always, but on large includes it can be way too slow + (when verilog-auto-read-includes + (verilog-read-includes) + (verilog-read-defines nil nil t)) + ;; Setup variables due to SystemVerilog expansion + (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup) + ;; This particular ordering is important + ;; INST: Lower modules correct, no internal dependencies, FIRST + (verilog-preserve-modi-cache + ;; Clear existing autos else we'll be screwed by existing ones + (verilog-delete-auto-buffer) + ;; Injection if appropriate + (when inject + (verilog-inject-inst) + (verilog-inject-sense) + (verilog-inject-arg)) + ;; + ;; Do user inserts first, so their code can insert AUTOs + (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" + 'verilog-auto-insert-lisp) + ;; Expand instances before need the signals the instances input/output + (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) + (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) + (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) + ;; Doesn't matter when done, but combine it with a common changer + (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) + (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) + ;; Must be done before autoin/out as creates a reg + (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) + ;; + ;; first in/outs from other files + (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) + (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) + (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) + ;; next in/outs which need previous sucked inputs first + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) + ;; Then tie off those in/outs + (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) + ;; These can be anywhere after AUTOINSERTLISP + (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) + ;; Wires/regs must be after inputs/outputs + (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) + (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) + (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) + (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) + (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) + ;; outputevery needs AUTOOUTPUTs done first + (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) + ;; After we've created all new variables + (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) + ;; Must be after all inputs outputs are generated + (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) + ;; User inserts + (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last) + ;; Fix line numbers (comments only) + (when verilog-auto-inst-template-numbers + (verilog-auto-templated-rel)) + (when verilog-auto-template-warn-unused + (verilog-auto-template-lint)))) + ;; + (verilog-run-hooks 'verilog-auto-hook) + ;; + (when verilog-auto-delete-trailing-whitespace + (verilog-delete-trailing-whitespace)) + ;; + (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)) + ;; + ;; If end result is same as when started, clear modified flag + (cond ((and oldbuf (equal oldbuf (buffer-string))) + (verilog-restore-buffer-modified-p nil) + (unless noninteractive (message "Updating AUTOs...done (no changes)"))) + (t (unless noninteractive (message "Updating AUTOs...done")))) + ;; End of save-cache + ))))) ;;; Skeletons: ;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index d883d4fc4dd..2fc24a8cb3d 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -1,4 +1,4 @@ -;;; which-func.el --- print current function in mode line +;;; which-func.el --- print current function in mode line -*- lexical-binding:t -*- ;; Copyright (C) 1994, 1997-1998, 2001-2016 Free Software Foundation, ;; Inc. @@ -80,7 +80,6 @@ "List of major modes for which Which Function mode should be used. For other modes it is disabled. If this is equal to t, then Which Function mode is enabled in any major mode that supports it." - :group 'which-func :version "24.3" ; explicit list -> t :type '(choice (const :tag "All modes" t) (repeat (symbol :tag "Major mode")))) @@ -91,13 +90,11 @@ This means that Which Function mode won't really do anything until you use Imenu, in these modes. Note that files larger than `which-func-maxout' behave in this way too; Which Function mode doesn't do anything until you use Imenu." - :group 'which-func :type '(repeat (symbol :tag "Major mode"))) (defcustom which-func-maxout 500000 "Don't automatically compute the Imenu menu if buffer is this big or bigger. Zero means compute the Imenu menu regardless of size." - :group 'which-func :type 'integer) (defvar which-func-keymap @@ -137,8 +134,7 @@ Zero means compute the Imenu menu regardless of size." :foreground "Blue1") (t :foreground "LightSkyBlue")) - "Face used to highlight mode line function names." - :group 'which-func) + "Face used to highlight mode line function names.") (defcustom which-func-format `("[" @@ -152,7 +148,6 @@ mouse-3: go to end") "]") "Format for displaying the function in the mode line." :version "24.2" ; added mouse-face; 24point2 is correct - :group 'which-func :type 'sexp) ;;;###autoload (put 'which-func-format 'risky-local-variable t) @@ -193,14 +188,16 @@ This makes a difference only if `which-function-mode' is non-nil.") (add-hook 'find-file-hook 'which-func-ff-hook t) +(defun which-func-try-to-enable () + (unless (or (not which-function-mode) + (local-variable-p 'which-func-mode)) + (setq which-func-mode (or (eq which-func-modes t) + (member major-mode which-func-modes))))) + (defun which-func-ff-hook () "File find hook for Which Function mode. It creates the Imenu index for the buffer, if necessary." - (unless (local-variable-p 'which-func-mode) - (setq which-func-mode - (and which-function-mode - (or (eq which-func-modes t) - (member major-mode which-func-modes))))) + (which-func-try-to-enable) (condition-case err (if (and which-func-mode @@ -239,6 +236,13 @@ It creates the Imenu index for the buffer, if necessary." (defvar which-func-update-timer nil) +(unless (or (assq 'which-func-mode mode-line-misc-info) + (assq 'which-function-mode mode-line-misc-info)) + (add-to-list 'mode-line-misc-info + '(which-function-mode ;Only display if mode is enabled. + (which-func-mode ;Only display if buffer supports it. + ("" which-func-format " "))))) + ;; This is the name people would normally expect. ;;;###autoload (define-minor-mode which-function-mode @@ -254,17 +258,12 @@ in certain major modes." (when (timerp which-func-update-timer) (cancel-timer which-func-update-timer)) (setq which-func-update-timer nil) - (if which-function-mode - ;;Turn it on - (progn - (setq which-func-update-timer - (run-with-idle-timer idle-update-delay t #'which-func-update)) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (unless (local-variable-p 'which-func-mode) - (setq which-func-mode - (or (eq which-func-modes t) - (member major-mode which-func-modes))))))))) + (when which-function-mode + ;;Turn it on. + (setq which-func-update-timer + (run-with-idle-timer idle-update-delay t #'which-func-update)) + (dolist (buf (buffer-list)) + (with-current-buffer buf (which-func-try-to-enable))))) (defvar which-function-imenu-failed nil "Locally t in a buffer if `imenu--make-index-alist' found nothing there.") 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-mule.el b/lisp/ps-mule.el index f8a11544121..f14cd0d81cd 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1232,7 +1232,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (provide 'ps-mule) ;; Local Variables: -;; generated-autoload-file: "ps-print.el" +;; generated-autoload-file: "ps-print-loaddefs.el" ;; End: ;;; ps-mule.el ends here diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 1167b9c0530..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. @@ -1475,6 +1475,8 @@ Please send all bug fixes and enhancements to ;; Load XEmacs/Emacs definitions (require 'ps-def) +;; autoloads for secondary file +(require 'ps-print-loaddefs) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: @@ -1493,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 @@ -5826,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) @@ -5840,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) @@ -5855,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. @@ -6588,79 +6590,6 @@ If FACE is not a valid face name, use default face." (unless noninteractive (add-hook 'kill-emacs-hook #'ps-kill-emacs-check)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; To make this file smaller, some commands go in a separate file. -;; But autoload them here to make the separation invisible. - -;;;### (autoloads nil "ps-mule" "ps-mule.el" "4a263b7a727e853f2e6672922c4e5755") -;;; Generated autoloads from ps-mule.el - -(defvar ps-multibyte-buffer nil "\ -Specifies the multi-byte buffer handling. - -Valid values are: - - nil This is the value to use the default settings; - by default, this only works to print buffers with - only ASCII and Latin characters. But this default - setting can be changed by setting the variable - `ps-mule-font-info-database-default' differently. - The initial value of this variable is - `ps-mule-font-info-database-latin' (see - documentation). - - `non-latin-printer' This is the value to use when you have a Japanese - or Korean PostScript printer and want to print - buffer with ASCII, Latin-1, Japanese (JISX0208 and - JISX0201-Kana) and Korean characters. At present, - it was not tested with the Korean characters - printing. If you have a korean PostScript printer, - please, test it. - - `bdf-font' This is the value to use when you want to print - buffer with BDF fonts. BDF fonts include both latin - and non-latin fonts. BDF (Bitmap Distribution - Format) is a format used for distributing X's font - source file. BDF fonts are included in - `intlfonts-1.2' which is a collection of X11 fonts - for all characters supported by Emacs. In order to - use this value, be sure to have installed - `intlfonts-1.2' and set the variable - `bdf-directory-list' appropriately (see ps-bdf.el for - documentation of this variable). - - `bdf-font-except-latin' This is like `bdf-font' except that it uses - PostScript default fonts to print ASCII and Latin-1 - characters. This is convenient when you want or - need to use both latin and non-latin characters on - the same buffer. See `ps-font-family', - `ps-header-font-family' and `ps-font-info-database'. - -Any other value is treated as nil.") - -(custom-autoload 'ps-multibyte-buffer "ps-mule" t) - -(autoload 'ps-mule-initialize "ps-mule" "\ -Initialize global data for printing multi-byte characters. - -\(fn)" nil nil) - -(autoload 'ps-mule-begin-job "ps-mule" "\ -Start printing job for multi-byte chars between FROM and TO. -It checks if all multi-byte characters in the region are printable or not. - -\(fn FROM TO)" nil nil) - -(autoload 'ps-mule-end-job "ps-mule" "\ -Finish printing job for multi-byte chars. - -\(fn)" nil nil) - -;;;*** - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (provide 'ps-print) ;;; ps-print.el ends here diff --git a/lisp/recentf.el b/lisp/recentf.el index dc9489752fb..e30e6468ebb 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1124,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 diff --git a/lisp/rect.el b/lisp/rect.el index c0031642e0c..f9bebc47fef 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -473,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/gnus/registry.el b/lisp/registry.el index 9e6babcc355..20f8e8df257 100644 --- a/lisp/gnus/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,12 +123,12 @@ :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."))) -(defmethod initialize-instance :BEFORE ((this registry-db) slots) +(cl-defmethod initialize-instance :before ((this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -146,7 +145,7 @@ (cl-remf slots :max-hard) (cl-remf slots :max-soft)))) -(defmethod initialize-instance :AFTER ((this registry-db) slots) +(cl-defmethod initialize-instance :after ((this registry-db) slots) "Set value of data slot of THIS after initialization." (with-slots (data tracker) this (unless (member :data slots) @@ -155,7 +154,7 @@ (unless (member :tracker slots) (setq tracker (make-hash-table :size 100 :rehash-size 2.0))))) -(defmethod registry-lookup ((db registry-db) keys) +(cl-defmethod registry-lookup ((db registry-db) keys) "Search for KEYS in the registry-db THIS. Returns an alist of the key followed by the entry in a list, not a cons cell." (let ((data (oref db data))) @@ -166,20 +165,20 @@ Returns an alist of the key followed by the entry in a list, not a cons cell." (list k (gethash k data)))) keys)))) -(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) +(cl-defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys) "Search for KEYS in the registry-db THIS. 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)))))) -(defmethod registry-lookup-secondary ((db registry-db) tracksym - &optional create) +(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." - (let ((h (gethash tracksym (oref db :tracker)))) +When CREATE is not nil, create the secondary index hash table if needed." + (let ((h (gethash tracksym (oref db tracker)))) (if h h (when create @@ -188,8 +187,8 @@ When CREATE is not nil, create the secondary index hashtable if needed." (oref db tracker)) (gethash tracksym (oref db tracker)))))) -(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val - &optional set) +(cl-defmethod registry-lookup-secondary-value ((db registry-db) tracksym val + &optional set) "Search for TRACKSYM with value VAL in the registry-db THIS. When SET is not nil, set it for VAL (use t for an empty list)." ;; either we're asked for creation or there should be an existing index @@ -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 @@ -220,7 +219,7 @@ When SET is not nil, set it for VAL (use t for an empty list)." (or found (registry--match mode entry (cdr-safe check-list)))))) -(defmethod registry-search ((db registry-db) &rest spec) +(cl-defmethod registry-search ((db registry-db) &rest spec) "Search for SPEC across the registry-db THIS. For example calling with `:member \\='(a 1 2)' will match entry \((a 3 1)). Calling with `:all t' (any non-nil value) will match all. @@ -230,18 +229,18 @@ 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)))) - -(defmethod registry-delete ((db registry-db) keys assert &rest spec) + (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. If KEYS is nil, use SPEC to do a search. Updates the secondary ('tracked') indices as well. @@ -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? @@ -274,27 +272,24 @@ With assert non-nil, errors out if the key does not exist already." (remhash key data))) keys)) -(defmethod registry-size ((db registry-db)) +(cl-defmethod registry-size ((db registry-db)) "Returns the size of the registry-db object THIS. This is the key count of the `data' slot." (hash-table-count (oref db data))) -(defmethod registry-full ((db registry-db)) +(cl-defmethod registry-full ((db registry-db)) "Checks if registry-db THIS is full." (>= (registry-size db) (oref db max-size))) -(defmethod registry-insert ((db registry-db) key entry) +(cl-defmethod registry-insert ((db registry-db) key entry) "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,11 +299,11 @@ 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) -(defmethod registry-reindex ((db registry-db)) +(cl-defmethod registry-reindex ((db registry-db)) "Rebuild the secondary indices of registry-db THIS." (let ((count 0) (expected (* (length (oref db tracked)) (registry-size db)))) @@ -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%%)" @@ -327,7 +322,7 @@ Errors out if the key exists already." (registry-lookup-secondary-value db tr val value-keys)))) (oref db data)))))) -(defmethod registry-prune ((db registry-db) &optional sortfunc) +(cl-defmethod registry-prune ((db registry-db) &optional sortfunc) "Prunes the registry-db object DB. Attempts to prune the number of entries down to \(* @@ -354,7 +349,8 @@ Returns the number of deleted entries." (length (registry-delete db candidates nil))) 0))) -(defmethod registry-collect-prune-candidates ((db registry-db) limit sortfunc) +(cl-defmethod registry-collect-prune-candidates ((db registry-db) + limit sortfunc) "Collects pruning candidates from the registry-db object DB. Proposes only entries without the :precious keys, and attempts to @@ -366,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 eb5e0cfffcb..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,6 +28,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defcustom case-replace t "Non-nil means `query-replace' should preserve case in replacements." :type 'boolean @@ -172,7 +174,7 @@ wants to replace FROM with TO." (propertize "\0" 'display query-replace-from-to-separator 'separator t))) - (query-replace-from-to-history + (minibuffer-history (append (when separator (mapcar (lambda (from-to) @@ -184,7 +186,7 @@ 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 @@ -196,9 +198,9 @@ wants to replace FROM with TO." (setq-local text-property-default-nonsticky (cons '(separator . t) text-property-default-nonsticky))) (if regexp-flag - (read-regexp prompt nil 'query-replace-from-to-history) + (read-regexp prompt nil 'minibuffer-history) (read-from-minibuffer - prompt nil nil nil 'query-replace-from-to-history + prompt nil nil nil nil (car (if regexp-flag regexp-search-ring search-ring)) t))))) (to)) (if (and (zerop (length from)) query-replace-defaults) @@ -1408,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))) @@ -1835,6 +1837,8 @@ C-w to delete match and recursive edit, C-l to clear the screen, redisplay, and offer same replacement again, ! to replace all remaining matches in this buffer with no more questions, ^ to move point back to previous match, +u to undo previous replacement, +U to undo all replacements, E to edit the replacement string. In multi-buffer replacements type `Y' to replace all remaining matches in all remaining buffers with no more questions, @@ -1864,6 +1868,8 @@ in the current buffer." (define-key map "\C-l" 'recenter) (define-key map "!" 'automatic) (define-key map "^" 'backup) + (define-key map "u" 'undo) + (define-key map "U" 'undo-all) (define-key map "\C-h" 'help) (define-key map [f1] 'help) (define-key map [help] 'help) @@ -1889,7 +1895,7 @@ The valid answers include `act', `skip', `act-and-show', `act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up', `scroll-down', `scroll-other-window', `scroll-other-window-down', `edit', `edit-replacement', `delete-and-edit', `automatic', -`backup', `quit', and `help'. +`backup', `undo', `undo-all', `quit', and `help'. This keymap is used by `y-or-n-p' as well as `query-replace'.") @@ -1941,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) @@ -2042,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 @@ -2061,7 +2066,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-adjusted nil) (isearch-nonincremental t) ; don't use lax word mode (isearch-forward (not backward)) @@ -2076,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)) @@ -2091,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)) @@ -2145,6 +2150,10 @@ It must return a string." (noedit nil) (keep-going t) (stack nil) + (search-string-replaced nil) ; last string matching `from-string' + (next-replacement-replaced nil) ; replacement string + ; (substituted regexp) + (last-was-undo) (replace-count 0) (skip-read-only-count 0) (skip-filtered-count 0) @@ -2341,8 +2350,28 @@ It must return a string." (match-beginning 0) (match-end 0) start end search-string regexp-flag delimited-flag case-fold-search backward) - ;; Bind message-log-max so we don't fill up the message log - ;; with a bunch of identical messages. + ;; Obtain the matched groups: needed only when + ;; regexp-flag non nil. + (when (and last-was-undo regexp-flag) + (setq last-was-undo nil + real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (looking-at search-string) + (match-data t real-match-data)))) + ;; Matched string and next-replacement-replaced + ;; stored in stack. + (setq search-string-replaced (buffer-substring-no-properties + (match-beginning 0) + (match-end 0)) + next-replacement-replaced + (query-replace-descr + (save-match-data + (set-match-data real-match-data) + (match-substitute-replacement + next-replacement nocasify literal)))) + ;; Bind message-log-max so we don't fill up the + ;; message log with a bunch of identical messages. (let ((message-log-max nil) (replacement-presentation (if query-replace-show-replacement @@ -2355,8 +2384,8 @@ It must return a string." (query-replace-descr from-string) (query-replace-descr replacement-presentation))) (setq key (read-event)) - ;; Necessary in case something happens during read-event - ;; that clobbers the match data. + ;; Necessary in case something happens during + ;; read-event that clobbers the match data. (set-match-data real-match-data) (setq key (vector key)) (setq def (lookup-key map key)) @@ -2367,7 +2396,8 @@ It must return a string." (concat "Query replacing " (if delimited-flag (or (and (symbolp delimited-flag) - (get delimited-flag 'isearch-message-prefix)) + (get delimited-flag + 'isearch-message-prefix)) "word ") "") (if regexp-flag "regexp " "") (if backward "backward " "") @@ -2394,6 +2424,73 @@ It must return a string." (message "No previous match") (ding 'no-terminate) (sit-for 1))) + ((or (eq def 'undo) (eq def 'undo-all)) + (if (null stack) + (progn + (message "Nothing to undo") + (ding 'no-terminate) + (sit-for 1)) + (let ((stack-idx 0) + (stack-len (length stack)) + (num-replacements 0) + search-string + next-replacement) + (while (and (< stack-idx stack-len) + stack + (null replaced)) + (let* ((elt (nth stack-idx stack))) + (setq + stack-idx (1+ stack-idx) + replaced (nth 1 elt) + ;; Bind swapped values + ;; (search-string <--> replacement) + search-string (nth (if replaced 4 3) elt) + next-replacement (nth (if replaced 3 4) elt) + search-string-replaced search-string + next-replacement-replaced next-replacement) + + (when (and (= stack-idx stack-len) + (null replaced) + (zerop num-replacements)) + (message "Nothing to undo") + (ding 'no-terminate) + (sit-for 1)) + + (when replaced + (setq stack (nthcdr stack-idx stack)) + (goto-char (nth 0 elt)) + (set-match-data (nth 2 elt)) + (setq real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (looking-at search-string) + (match-data t (nth 2 elt))) + noedit + (replace-match-maybe-edit + next-replacement nocasify literal + noedit real-match-data backward) + replace-count (1- replace-count) + real-match-data + (save-excursion + (goto-char (match-beginning 0)) + (looking-at next-replacement) + (match-data t (nth 2 elt)))) + ;; Set replaced nil to keep in loop + (when (eq def 'undo-all) + (setq replaced nil + stack-len (- stack-len stack-idx) + stack-idx 0 + num-replacements + (1+ num-replacements)))))) + (when (and (eq def 'undo-all) + (null (zerop num-replacements))) + (message "Undid %d %s" num-replacements + (if (= num-replacements 1) + "replacement" + "replacements")) + (ding 'no-terminate) + (sit-for 1))) + (setq replaced nil last-was-undo t))) ((eq def 'act) (or replaced (setq noedit @@ -2516,9 +2613,12 @@ It must return a string." (match-beginning 0) (match-end 0) (current-buffer)) - (match-data t))) - stack)))))) - + (match-data t)) + search-string-replaced + next-replacement-replaced) + stack) + (setq next-replacement-replaced nil + search-string-replaced nil)))))) (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s%s" @@ -2544,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/gnus/rtree.el b/lisp/rtree.el index 662e043669a..662e043669a 100644 --- a/lisp/gnus/rtree.el +++ b/lisp/rtree.el 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 ab9f0715fd8..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) @@ -1319,7 +1330,7 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (and locprn (ses--locprn-compiled locprn)))) printer) - (or value ""))) + value)) (if (stringp value) value (or (stringp (car-safe value)) @@ -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 @@ -1539,7 +1550,8 @@ Sets `ses-relocate-return' to `delete' if cell-references were removed." (if (setq rowcol (ses-sym-rowcol formula)) (ses-relocate-symbol formula rowcol startrow startcol rowincr colincr) - formula) ; Pass through as-is. + ;; Constants pass through as-is. + formula) (dolist (cur formula) (setq rowcol (ses-sym-rowcol cur)) (cond @@ -2200,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*) @@ -3221,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 @@ -3463,7 +3485,7 @@ highlighted range in the spreadsheet." (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 + ;; inferred from new name (if (equal new-rowcol rowcol) (put new-name 'ses-cell rowcol) (error "Not a valid name for this cell location")) @@ -3520,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 @@ -3571,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 @@ -3742,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)) @@ -3783,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)) @@ -3804,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)." @@ -3812,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..cabd1e5a474 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))) @@ -586,6 +590,7 @@ buffer." ((string-equal shell "ksh") "echo $PWD ~-") ;; Bypass any aliases. TODO all shells could use this. ((string-equal shell "bash") "command dirs") + ((string-equal shell "zsh") "dirs -l") (t "dirs"))) ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") @@ -710,12 +715,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 c85e2cdb177..b72e75d169b 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 @@ -581,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 @@ -602,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) @@ -1079,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. @@ -1637,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 "")) @@ -1720,7 +1756,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. @@ -2880,6 +2917,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 @@ -2945,20 +2986,47 @@ behavior." (cdr buffer-undo-list)))))) (setq undo-auto--last-boundary-cause 0))))) -;; This function is called also from one place in fileio.c. We call -;; this function, rather than undoable-change because it reduces the -;; number of lisp functions we have to use fboundp for to avoid -;; bootstrap issues. -(defun undo-auto--undoable-change-no-timer () - "Record `current-buffer' as changed." - (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))) - (defun undo-auto--undoable-change () "Called after every undoable buffer change." - (undo-auto--undoable-change-no-timer) + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)) (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 @@ -3176,6 +3244,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. @@ -3236,11 +3351,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\", @@ -3254,9 +3370,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. @@ -3329,6 +3442,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. @@ -3375,13 +3490,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)) @@ -3464,12 +3574,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 @@ -3499,16 +3611,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 @@ -3569,11 +3680,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))) @@ -3585,7 +3695,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. @@ -3604,16 +3717,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 @@ -3625,8 +3736,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)))) @@ -3754,6 +3867,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) @@ -3766,8 +3880,13 @@ support pty association, if PROGRAM is nil." (defun process-menu-delete-process () "Kill process at point in a `list-processes' buffer." (interactive) - (delete-process (tabulated-list-get-id)) - (revert-buffer)) + (let ((pos (point))) + (delete-process (tabulated-list-get-id)) + (revert-buffer) + (goto-char (min pos (point-max))) + (if (eobp) + (forward-line -1) + (beginning-of-line)))) (defun list-processes--refresh () "Recompute the list of processes for the Process List buffer. @@ -3780,6 +3899,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) @@ -3815,7 +3935,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) @@ -4060,7 +4180,8 @@ 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 @@ -5241,6 +5362,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 @@ -5862,7 +5984,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 @@ -5960,7 +6082,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)) @@ -5977,7 +6099,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. @@ -5985,7 +6107,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) @@ -5995,7 +6117,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. @@ -6027,7 +6149,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 @@ -6065,7 +6187,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 @@ -8339,7 +8467,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/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 761e69e03b1..4a04f9c2d1b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -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))))))) @@ -2360,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. @@ -2386,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 efea412af0e..89ceb9ba55f 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. @@ -512,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) @@ -859,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)) @@ -1283,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." @@ -1315,57 +1310,15 @@ is converted into a string by expressing it in decimal." (make-obsolete 'focus-frame "it does nothing." "22.1") (defalias 'unfocus-frame 'ignore "") (make-obsolete 'unfocus-frame "it does nothing." "22.1") -(make-obsolete 'make-variable-frame-local - "explicitly check for a frame-parameter instead." "22.2") + (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (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 - "use (setq-default mode-line-format) or (default-value mode-line-format) instead" - "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") @@ -1548,6 +1501,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")) @@ -1623,7 +1580,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 @@ -1738,6 +1695,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.") @@ -1746,12 +1708,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) @@ -1760,7 +1729,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'. @@ -1903,7 +1878,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) @@ -1914,7 +1889,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))) @@ -2505,26 +2481,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. @@ -3025,6 +3002,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. @@ -3336,6 +3335,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, @@ -3983,7 +3987,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)) @@ -4120,8 +4124,7 @@ 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' (as set up by -e.g. `subword-mode'). It is also not interactive." +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 @@ -4134,8 +4137,7 @@ 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' (as set up by -e.g. `subword-mode'). It is also not interactive." +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 @@ -4331,6 +4333,51 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'sendfunc sendfunc) (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) + + +(defun backtrace--print-frame (evald func args flags) + "Print a trace of a single stack frame to `standard-output'. +EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." + (princ (if (plist-get flags :debug-on-exit) "* " " ")) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (prin1 func) + (if args (prin1 args) (princ "()"))) + (t + (prin1 (cons func args)))) + (princ "\n")) + +(defun backtrace () + "Print a trace of Lisp function calls currently active. +Output stream used is value of `standard-output'." + (let ((print-level (or print-level 8))) + (mapbacktrace #'backtrace--print-frame 'backtrace))) + +(defun backtrace-frames (&optional base) + "Collect all frames of current backtrace into a list. +If non-nil, BASE should be a function, and frames before its +nearest activation frames are discarded." + (let ((frames nil)) + (mapbacktrace (lambda (&rest frame) (push frame frames)) + (or base 'backtrace-frames)) + (nreverse frames))) + +(defun backtrace-frame (nframes &optional base) + "Return the function and arguments NFRAMES up from current execution point. +If non-nil, BASE should be a function, and NFRAMES counts from its +nearest activation frame. +If the frame has not evaluated the arguments yet (or is a special form), +the value is (nil FUNCTION ARG-FORMS...). +If the frame has evaluated its arguments and called its function already, +the value is (t FUNCTION ARG-VALUES...). +A &rest arg is represented as the tail of the list ARG-VALUES. +FUNCTION is whatever was supplied as car of evaluated list, +or a lambda expression for macro calls. +If NFRAMES is more than the number of frames, the value is nil." + (backtrace-frame--internal + (lambda (evald func args _) `(,evald ,func ,@args)) + nframes (or base 'backtrace-frame))) + (defvar called-interactively-p-functions nil "Special hook called to skip special frames in `called-interactively-p'. @@ -4494,7 +4541,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. @@ -4949,7 +4997,41 @@ as a list.") "-pkg.el")) +;;; Thread support. + +(defmacro with-mutex (mutex &rest body) + "Invoke BODY with MUTEX held, releasing MUTEX when done. +This is the simplest safe way to acquire and release a mutex." + (declare (indent 1) (debug t)) + (let ((sym (make-symbol "mutex"))) + `(let ((,sym ,mutex)) + (mutex-lock ,sym) + (unwind-protect + (progn ,@body) + (mutex-unlock ,sym))))) + + ;;; 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 new file mode 100644 index 00000000000..a92c6dfb610 --- /dev/null +++ b/lisp/svg.el @@ -0,0 +1,273 @@ +;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: image + +;; 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: + +;;; Code: + +(require 'cl-lib) +(require 'xml) +(require 'dom) +(require 'subr-x) + +(defun svg-create (width height &rest args) + "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") + (xmlns . "http://www.w3.org/2000/svg") + ,@(svg--arguments nil args)))) + +(defun svg-gradient (svg id type stops) + "Add a gradient with ID to SVG. +TYPE is `linear' or `radial'. STOPS is a list of percentage/color +pairs." + (svg--def + svg + (apply + 'dom-node + (if (eq type 'linear) + 'linearGradient + 'radialGradient) + `((id . ,id) + (x1 . 0) + (x2 . 0) + (y1 . 0) + (y2 . 1)) + (mapcar + (lambda (stop) + (dom-node 'stop `((offset . ,(format "%s%%" (car stop))) + (stop-color . ,(cdr stop))))) + stops)))) + +(defun svg-rectangle (svg x y width height &rest args) + "Create a rectangle on SVG, starting at position X/Y, of WIDTH/HEIGHT. +ARGS is a plist of modifiers. Possible values are + +:stroke-width PIXELS. The line width. +:stroke-color COLOR. The line color. +:gradient ID. The gradient ID to use." + (svg--append + svg + (dom-node 'rect + `((width . ,width) + (height . ,height) + (x . ,x) + (y . ,y) + ,@(svg--arguments svg args))))) + +(defun svg-circle (svg x y radius &rest args) + "Create a circle of RADIUS on SVG. +X/Y denote the center of the circle." + (svg--append + svg + (dom-node 'circle + `((cx . ,x) + (cy . ,y) + (r . ,radius) + ,@(svg--arguments svg args))))) + +(defun svg-ellipse (svg x y x-radius y-radius &rest args) + "Create an ellipse of X-RADIUS/Y-RADIUS on SVG. +X/Y denote the center of the ellipse." + (svg--append + svg + (dom-node 'ellipse + `((cx . ,x) + (cy . ,y) + (rx . ,x-radius) + (ry . ,y-radius) + ,@(svg--arguments svg args))))) + +(defun svg-line (svg x1 y1 x2 y2 &rest args) + "Create a line of starting in X1/Y1, ending at X2/Y2 in SVG." + (svg--append + svg + (dom-node 'line + `((x1 . ,x1) + (x2 . ,y1) + (y1 . ,x2) + (y2 . ,y2) + ,@(svg--arguments svg args))))) + +(defun svg-polyline (svg points &rest args) + "Create a polyline going through POINTS on SVG. +POINTS is a list of x/y pairs." + (svg--append + svg + (dom-node + 'polyline + `((points . ,(mapconcat (lambda (pair) + (format "%s %s" (car pair) (cdr pair))) + points + ", ")) + ,@(svg--arguments svg args))))) + +(defun svg-polygon (svg points &rest args) + "Create a polygon going through POINTS on SVG. +POINTS is a list of x/y pairs." + (svg--append + svg + (dom-node + 'polygon + `((points . ,(mapconcat (lambda (pair) + (format "%s %s" (car pair) (cdr pair))) + points + ", ")) + ,@(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 + (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))) + (stroke-color (or (plist-get args :stroke-color) + (dom-attr svg 'stroke-color))) + (fill-color (plist-get args :fill-color)) + attr) + (when stroke-width + (push (cons 'stroke-width stroke-width) attr)) + (when stroke-color + (push (cons 'stroke stroke-color) attr)) + (when fill-color + (push (cons 'fill fill-color) attr)) + (when (plist-get args :gradient) + (setq attr + (append + ;; We need a way to specify the gradient direction here... + `((x1 . 0) + (x2 . 0) + (y1 . 0) + (y2 . 1) + (fill . ,(format "url(#%s)" + (plist-get args :gradient)))) + attr))) + (cl-loop for (key value) on args by #'cddr + unless (memq key '(:stroke-color :stroke-width :gradient + :fill-color)) + ;; Drop the leading colon. + do (push (cons (intern (substring (symbol-name key) 1) obarray) + value) + attr)) + attr)) + +(defun svg--def (svg def) + (dom-append-child + (or (dom-by-tag svg 'defs) + (let ((node (dom-node 'defs))) + (dom-add-child-before svg node) + node)) + def) + svg) + +(defun svg-image (svg) + "Return an image object from SVG." + (create-image + (with-temp-buffer + (svg-print svg) + (buffer-string)) + 'svg t)) + +(defun svg-insert-image (svg) + "Insert SVG as an image at point. +If the SVG is later changed, the image will also be updated." + (let ((image (svg-image svg)) + (marker (point-marker))) + (insert-image image) + (dom-set-attribute svg :image marker))) + +(defun svg-possibly-update-image (svg) + (let ((marker (dom-attr svg :image))) + (when (and marker + (buffer-live-p (marker-buffer marker))) + (with-current-buffer (marker-buffer marker) + (put-text-property marker (1+ marker) 'display (svg-image svg)))))) + +(defun svg-print (dom) + "Convert DOM into a string containing the xml representation." + (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) + +;;; svg.el ends here diff --git a/lisp/term.el b/lisp/term.el index 18d67757d0c..a4c652bad7f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -834,6 +834,10 @@ is buffer-local." (define-key map [down] 'term-send-down) (define-key map [right] 'term-send-right) (define-key map [left] 'term-send-left) + (define-key map [C-up] 'term-send-ctrl-up) + (define-key map [C-down] 'term-send-ctrl-down) + (define-key map [C-right] 'term-send-ctrl-right) + (define-key map [C-left] 'term-send-ctrl-left) (define-key map [delete] 'term-send-del) (define-key map [deletechar] 'term-send-del) (define-key map [backspace] 'term-send-backspace) @@ -1099,17 +1103,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." (term-reset-size (cdr size) (car size))) size)) - ;; Without the below setting, term-mode and ansi-term behave - ;; sluggishly when the buffer includes a lot of whitespace - ;; characters. - ;; - ;; There's a larger problem here with supporting bidirectional text: - ;; the application that writes to the terminal could have its own - ;; ideas about displaying bidirectional text, and might not want us - ;; reordering the text or deciding on base paragraph direction. One - ;; such application is Emacs in TTY mode... FIXME. - (setq bidi-paragraph-direction 'left-to-right) - (easy-menu-add term-terminal-menu) (easy-menu-add term-signals-menu) (or term-input-ring @@ -1227,6 +1220,10 @@ without any interpretation." (defun term-send-down () (interactive) (term-send-raw-string "\eOB")) (defun term-send-right () (interactive) (term-send-raw-string "\eOC")) (defun term-send-left () (interactive) (term-send-raw-string "\eOD")) +(defun term-send-ctrl-up () (interactive) (term-send-raw-string "\e[1;5A")) +(defun term-send-ctrl-down () (interactive) (term-send-raw-string "\e[1;5B")) +(defun term-send-ctrl-right () (interactive) (term-send-raw-string "\e[1;5C")) +(defun term-send-ctrl-left () (interactive) (term-send-raw-string "\e[1;5D")) (defun term-send-home () (interactive) (term-send-raw-string "\e[1~")) (defun term-send-insert() (interactive) (term-send-raw-string "\e[2~")) (defun term-send-end () (interactive) (term-send-raw-string "\e[4~")) @@ -3262,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/AT386.el b/lisp/term/AT386.el index 7f46f61c4fb..63469422f76 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -54,4 +54,6 @@ (define-key local-function-key-map [ALT] [27]) )) +(provide 'term/AT386) + ;;; AT386.el ends here diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el index f26dc6b9198..a32da6ae8f2 100644 --- a/lisp/term/bobcat.el +++ b/lisp/term/bobcat.el @@ -5,4 +5,6 @@ (keyboard-translate ?\177 ?\^h) (keyboard-translate ?\^h ?\177)) +(provide 'term/bobcat) + ;;; bobcat.el ends here diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el index d69433a77c2..edc64b4404d 100644 --- a/lisp/term/cygwin.el +++ b/lisp/term/cygwin.el @@ -6,4 +6,6 @@ "Terminal initialization function for cygwin." (tty-no-underline)) +(provide 'term/cygwin) + ;;; cygwin.el ends here diff --git a/lisp/term/internal.el b/lisp/term/internal.el index 6f4866b0795..0fd0f2237a5 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -606,4 +606,6 @@ list. You can (and should) also run it if and when the value of (run-hooks 'dos-codepage-setup-hook) )) +(provide 'term/internal) + ;;; internal.el ends here diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index ee638643949..5217e42e319 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -327,4 +327,6 @@ (set-keymap-parent m (keymap-parent input-decode-map)) (set-keymap-parent input-decode-map m))) +(provide 'term/iris-ansi) + ;;; iris-ansi.el ends here diff --git a/lisp/term/linux.el b/lisp/term/linux.el index 00bcdfdf542..70730dc5844 100644 --- a/lisp/term/linux.el +++ b/lisp/term/linux.el @@ -19,4 +19,6 @@ ;; The arg only matters in that it is not t or nil. (set-input-meta-mode 'iso-latin-1)) +(provide 'term/linux) + ;;; linux.el ends here diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index 6b9e1301003..aab4110b3ae 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -80,4 +80,6 @@ (set-keymap-parent m (keymap-parent input-decode-map)) (set-keymap-parent input-decode-map m))) +(provide 'term/lk201) + ;;; lk201.el ends here diff --git a/lisp/term/news.el b/lisp/term/news.el index b66e000e3b5..5738644259e 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -66,4 +66,6 @@ (define-key news-fkey-prefix "x" [kp-8]) )) +(provide 'term/news) + ;;; news.el ends here diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 21bba480d02..41d6d72812b 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -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. @@ -936,5 +888,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (ns-get-selection selection-symbol target-type)) (provide 'ns-win) +(provide 'term/ns-win) ;;; ns-win.el ends here diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 85c4144ad22..5b4bdf7cb97 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -388,5 +388,6 @@ Errors out because it is not supposed to be called, ever." ;; --------------------------------------------------------------------------- (provide 'pc-win) +(provide 'term/pc-win) ;;; pc-win.el ends here diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index da26d30a682..97d38659115 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -195,4 +195,6 @@ (* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6)) (set-terminal-parameter nil 'background-mode 'dark))))) +(provide 'term/rxvt) + ;;; rxvt.el ends here diff --git a/lisp/term/screen.el b/lisp/term/screen.el index 7f681154d6e..d7ee7705208 100644 --- a/lisp/term/screen.el +++ b/lisp/term/screen.el @@ -20,4 +20,6 @@ it runs, which can change when the screen session is moved to another tty." (let ((xterm-extra-capabilities xterm-screen-extra-capabilities)) (tty-run-terminal-initialization (selected-frame) "xterm"))) +(provide 'term/screen) + ;; screen.el ends here diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 7fb8e7ed984..ef40db16d18 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -158,4 +158,6 @@ (eval (car hooks)) (setq hooks (cdr hooks)))))) +(provide 'term/sun) + ;;; sun.el ends here diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 3ea26b8c3ed..a88695062b8 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -1035,4 +1035,6 @@ A color is considered gray if the 3 components of its RGB value are equal." (setq colors (cdr colors))) count)) +(provide 'term/tty-colors) + ;;; tty-colors.el ends here diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 1173f9f15dd..e25a3b616d5 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -115,4 +115,6 @@ which the keypad's keys act as ordinary digits." (send-string-to-terminal (if (terminal-parameter nil 'tvi970-keypad-numeric) "\e=" "\e>"))) +(provide 'term/tvi970) + ;;; tvi970.el ends here diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index fb46c996491..16a1c271b9a 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -48,4 +48,6 @@ switch to 132-column mode if ARG is omitted or nil." (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l")) (set-frame-width terminal-frame (if vt100-wide-mode 132 80))) +(provide 'term/vt100) + ;;; vt100.el ends here diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el index 550266816e0..dde2e229068 100644 --- a/lisp/term/vt200.el +++ b/lisp/term/vt200.el @@ -7,4 +7,6 @@ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. (define-key local-function-key-map [f11] [?\e])) +(provide 'term/vt200) + ;;; vt200.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 5c56d05a140..d8cf5efcfab 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -400,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)) @@ -466,5 +470,6 @@ That includes all Windows systems except for 9X/Me." (getenv "SystemRoot")) (provide 'w32-win) +(provide 'term/w32-win) ;;; w32-win.el ends here diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index b7e0a22bfb3..bf1550f7c33 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -93,4 +93,6 @@ (tty-set-up-initial-frame-faces) (run-hooks 'terminal-init-w32-hook)) +(provide 'term/w32console) + ;;; w32console.el ends here diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index 3e1055a1873..d3ee7a0a6cb 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -155,4 +155,6 @@ M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar" ;; (nth 1 key-definition))) (fset 'enable-arrow-keys nil)) +(provide 'term/wyse50) + ;;; wyse50.el ends here diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 59df14da93a..c8e79e3f81a 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1487,5 +1487,6 @@ This uses `icon-map-list' to map icon file names to stock icon names." (global-set-key [XF86WakeUp] 'ignore) (provide 'x-win) +(provide 'term/x-win) ;;; x-win.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 880141bda12..5fc6056ca23 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -591,6 +591,19 @@ Return the pasted text as a string." (define-key map [f59] [M-f11]) (define-key map [f60] [M-f12]) + (define-key map [f61] [M-S-f1]) + (define-key map [f62] [M-S-f2]) + (define-key map [f63] [M-S-f3]) + (define-key map [f64] [M-S-f4]) + (define-key map [f65] [M-S-f5]) + (define-key map [f66] [M-S-f6]) + (define-key map [f67] [M-S-f7]) + (define-key map [f68] [M-S-f8]) + (define-key map [f69] [M-S-f9]) + (define-key map [f70] [M-S-f10]) + (define-key map [f71] [M-S-f11]) + (define-key map [f72] [M-S-f12]) + map) "Keymap of possible alternative meanings for some keys.") 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 b3a41d3822c..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,110 +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" "orphans" "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" - "widows" "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" "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" 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" @@ -243,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 @@ -321,8 +731,6 @@ :type 'integer :safe 'integerp) -(require 'smie) - (defconst css-smie-grammar (smie-prec2->grammar (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) @@ -377,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 @@ -394,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" @@ -533,9 +1055,11 @@ pseudo-classes, and at-rules." (let ((st (make-syntax-table css-mode-syntax-table))) (modify-syntax-entry ?/ ". 124" st) (modify-syntax-entry ?\n ">" st) + ;; Variable names are prefixed by $. + (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]*(") @@ -556,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 730b55fbd8f..bfe839ac77e 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -88,11 +88,34 @@ downcased before comparing with these exceptions." :version "24.1") (defcustom flyspell-sort-corrections nil - "Non-nil means, sort the corrections alphabetically before popping them." + "If non-nil, sort the corrections before popping them. +The sorting is controlled by the `flyspell-sort-corrections-function' +variable, and defaults to sorting alphabetically." :group 'flyspell :version "21.1" :type 'boolean) +(defcustom flyspell-sort-corrections-function + 'flyspell-sort-corrections-alphabetically + "The function used to sort corrections. +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 "26.1" + :type 'function + :group 'flyspell) + +(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _) + (string< corr1 corr2)) + +(defun flyspell-sort (corrs word) + (if flyspell-sort-corrections + (sort corrs + (lambda (c1 c2) + (funcall flyspell-sort-corrections-function c1 c2 word))) + corrs)) + (defcustom flyspell-duplicate-distance 400000 "The maximum distance for finding duplicates of unrecognized words. This applies to the feature that when a word is not found in the dictionary, @@ -424,12 +447,7 @@ like <img alt=\"Some thing.\">." ;;* The minor mode declaration. */ ;;*---------------------------------------------------------------------*/ (defvar flyspell-mouse-map - (let ((map (make-sparse-keymap))) - (if (featurep 'xemacs) - (define-key map [button2] #'flyspell-correct-word) - (define-key map [down-mouse-2] #'flyspell-correct-word) - (define-key map [mouse-2] 'undefined)) - map) + (make-sparse-keymap) "Keymap for Flyspell to put on erroneous words.") (defvar flyspell-mode-map @@ -629,9 +647,7 @@ in your init file. ;; the welcome message (if (and flyspell-issue-message-flag flyspell-issue-welcome-flag - (if (featurep 'xemacs) - (interactive-p) ;; XEmacs does not have (called-interactively-p) - (called-interactively-p 'interactive))) + (called-interactively-p 'interactive)) (let ((binding (where-is-internal 'flyspell-auto-correct-word nil 'non-ascii))) (message "%s" @@ -1007,9 +1023,7 @@ Mostly we check word delimiters." (defun flyspell-notify-misspell (word poss) (let ((replacements (if (stringp poss) poss - (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))))) + (flyspell-sort (car (cdr (cdr poss))) word)))) (if flyspell-issue-message-flag (message "misspelling `%s' %S" word replacements)))) @@ -1158,9 +1172,7 @@ misspelling and skips redundant spell-checking step." (ispell-send-string (concat "^" word "\n")) ;; we mark the ispell process so it can be killed ;; when emacs is exited without query - (if (featurep 'xemacs) - (process-kill-without-query ispell-process) - (set-process-query-on-exit-flag ispell-process nil)) + (set-process-query-on-exit-flag ispell-process nil) ;; Wait until ispell has processed word. (while (progn (accept-process-output ispell-process) @@ -1695,15 +1707,7 @@ FLYSPELL-BUFFER." ;;*---------------------------------------------------------------------*/ (defun flyspell-delete-region-overlays (beg end) "Delete overlays used by flyspell in a given region." - (if (featurep 'emacs) - (remove-overlays beg end 'flyspell-overlay t) - ;; XEmacs does not have `remove-overlays' - (let ((l (overlays-in beg end))) - (while (consp l) - (progn - (if (flyspell-overlay-p (car l)) - (delete-overlay (car l))) - (setq l (cdr l))))))) + (remove-overlays beg end 'flyspell-overlay t)) (defun flyspell-delete-all-overlays () "Delete all the overlays used by flyspell." @@ -1945,7 +1949,7 @@ This command proposes various successive corrections for the current word." (funcall flyspell-insert-function word) (flyspell-word) (flyspell-display-next-corrections flyspell-auto-correct-ring)) - (flyspell-ajust-cursor-point pos (point) old-max) + (flyspell-adjust-cursor-point pos (point) old-max) (setq flyspell-auto-correct-pos (point))) ;; Fetch the word to be checked. (let ((word (flyspell-get-word))) @@ -1979,9 +1983,8 @@ This command proposes various successive corrections for the current word." (error "Ispell: error in Ispell process")) (t ;; The word is incorrect, we have to propose a replacement. - (let ((replacements (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss)))))) + (let ((replacements (flyspell-sort (car (cdr (cdr poss))) + word))) (setq flyspell-auto-correct-region nil) (if (consp replacements) (progn @@ -2013,7 +2016,7 @@ This command proposes various successive corrections for the current word." (flyspell-word) (flyspell-display-next-corrections (cons new-word flyspell-auto-correct-ring)) - (flyspell-ajust-cursor-point pos + (flyspell-adjust-cursor-point pos (point) old-max)))))))))) (setq flyspell-auto-correct-pos (point)) @@ -2136,10 +2139,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ((null poss) ;; ispell error (error "Ispell: error in Ispell process")) - ((featurep 'xemacs) - (flyspell-xemacs-popup - poss word cursor-location start end opoint)) - (t + (t ;; The word is incorrect, we have to propose a replacement. (flyspell-do-correct (flyspell-emacs-popup event poss word) poss word cursor-location start end opoint))) @@ -2150,17 +2150,12 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ;;*---------------------------------------------------------------------*/ (defun flyspell-do-correct (replace poss word cursor-location start end save) "The popup menu callback." - ;; Originally, the XEmacs code didn't do the (goto-char save) here and did - ;; it instead right after calling the function. (cond ((eq replace 'ignore) (goto-char save) nil) ((eq replace 'save) (goto-char save) (ispell-send-string (concat "*" word "\n")) - ;; This was added only to the XEmacs side in revision 1.18 of - ;; flyspell. I assume its absence on the Emacs side was an - ;; oversight. --Stef (ispell-send-string "#\n") (flyspell-unhighlight-at cursor-location) (setq ispell-pdict-modified-p '(t))) @@ -2177,8 +2172,6 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (if (eq replace 'buffer) (ispell-add-per-file-word-list word))) (replace - ;; This was added only to the Emacs side. I assume its absence on - ;; the XEmacs side was an oversight. --Stef (flyspell-unhighlight-at cursor-location) (let ((old-max (point-max)) (new-word (if (atom replace) @@ -2192,17 +2185,15 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (funcall flyspell-insert-function new-word) (if flyspell-abbrev-p (flyspell-define-abbrev word new-word))) - ;; In the original Emacs code, this was only called in the body - ;; of the if. I arbitrarily kept the XEmacs behavior instead. - (flyspell-ajust-cursor-point save cursor-location old-max))) + (flyspell-adjust-cursor-point save cursor-location old-max))) (t (goto-char save) nil))) ;;*---------------------------------------------------------------------*/ -;;* flyspell-ajust-cursor-point ... */ +;;* flyspell-adjust-cursor-point ... */ ;;*---------------------------------------------------------------------*/ -(defun flyspell-ajust-cursor-point (save cursor-location old-max) +(defun flyspell-adjust-cursor-point (save cursor-location old-max) (if (>= save cursor-location) (let ((new-pos (+ save (- (point-max) old-max)))) (goto-char (cond @@ -2229,9 +2220,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." (setq event (list (list (car (cdr mouse-pos)) (1+ (cdr (cdr mouse-pos)))) (car mouse-pos))))) - (let* ((corrects (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))) + (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word)) (cor-menu (if (consp corrects) (mapcar (lambda (correct) (list correct correct)) @@ -2258,80 +2247,6 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." menu))))) ;;*---------------------------------------------------------------------*/ -;;* flyspell-xemacs-popup ... */ -;;*---------------------------------------------------------------------*/ -(defun flyspell-xemacs-popup (poss word cursor-location start end save) - "The XEmacs popup menu." - (let* ((corrects (if flyspell-sort-corrections - (sort (car (cdr (cdr poss))) 'string<) - (car (cdr (cdr poss))))) - (cor-menu (if (consp corrects) - (mapcar (lambda (correct) - (vector correct - (list 'flyspell-do-correct - correct - (list 'quote poss) - word - cursor-location - start - end - save) - t)) - corrects) - '())) - (affix (car (cdr (cdr (cdr poss))))) - show-affix-info - (menu (let ((save (if (and (consp affix) show-affix-info) - (vector - (concat "Save affix: " (car affix)) - (list 'flyspell-do-correct - ''save - (list 'quote poss) - word - cursor-location - start - end - save) - t) - (vector - "Save word" - (list 'flyspell-do-correct - ''save - (list 'quote poss) - word - cursor-location - start - end - save) - t))) - (session (vector "Accept (session)" - (list 'flyspell-do-correct - ''session - (list 'quote poss) - word - cursor-location - start - end - save) - t)) - (buffer (vector "Accept (buffer)" - (list 'flyspell-do-correct - ''buffer - (list 'quote poss) - word - cursor-location - start - end - save) - t))) - (if (consp cor-menu) - (append cor-menu (list "-" save session buffer)) - (list save session buffer))))) - (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary - ispell-dictionary)) - menu)))) - -;;*---------------------------------------------------------------------*/ ;;* Some example functions for real autocorrecting */ ;;*---------------------------------------------------------------------*/ (defun flyspell-maybe-correct-transposition (beg end poss) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0cedf86bb73..7551d2fde97 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,14 +1,9 @@ -;;; 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. ;; Author: Ken Stevens <k.stevens@ieee.org> -;; Maintainer: Ken Stevens <k.stevens@ieee.org> -;; Stevens Mod Date: Mon Jan 7 12:32:44 PST 2003 -;; Stevens Revision: 3.6 ;; Status : Release with 3.1.12+ and 3.2.0+ ispell. -;; Bug Reports : ispell-el-bugs@itcorp.com -;; Web Site : http://kdstevens.com/~stevens/ispell-page.html ;; Keywords: unix wp ;; This file is part of GNU Emacs. @@ -46,9 +41,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 @@ -123,153 +118,16 @@ ;; Recursive edits (?C-r or ?R) inside a keyboard text replacement check (?r) ;; can cause misalignment errors. -;; HISTORY - -;; Modifications made in latest versions: - -;; Revision 3.6 2003/01/07 12:32:44 kss -;; Removed extra -d LIB in dictionary defs. (Pavel Janik) -;; Filtered process calls with duplicate dictionary entries. -;; Fixed bug where message-text-end is inside a mime skipped region. -;; Minor fixes to get ispell menus right in XEmacs -;; Fixed skip regexp so it doesn't match stuff like `/.\w'. -;; Detecting dictionary change not working. Fixed. kss -;; function `ispell-change-dictionary' now only completes valid dicts. - -;; Revision 3.5 2001/7/11 18:43:57 kss -;; Added fix for aspell to work in XEmacs (ispell-check-version). -;; Added Portuguese dictionary definition. -;; New feature: MIME mail message support, Fcc support. -;; Bug fix: retain comment syntax on lines with region skipping. (TeX $ bug...) -;; Improved allocation for graphic mode lines. (Miles Bader) -;; Support -v flag for old versions of aspell. (Eli Zaretskii) -;; Clear minibuffer on ^G from ispell-help (Tak Ota) - -;; Revision 3.4 2000/8/4 09:41:50 kss -;; Support new color display functions. -;; Fixed misalignment offset bug when replacing a string after a shift made. -;; Set to standard Author/Maintainer heading, -;; ensure localwords lists are separated from the text by newline. (Dave Love) -;; Added dictionary definition for Italian (William Deakin) -;; HTML region skipping greatly improved. (Chuck D. Phillips) -;; improved menus. Fixed regexp matching http/email addresses. -;; one arg always for XEmacs sleep-for (gunnar Evermann) -;; support for synchronous processes (Eli Zaretskii) - -;; Revision 3.3 1999/11/29 11:38:34 kss -;; Only word replacements entered in from the keyboard are rechecked. -;; This fixes a bug in tex parsing and misalignment. -;; Exceptions exist for recursive edit and query-replace, with tex error -;; condition tested. Recursive editing improved. -;; XEmacs repair for when `enable-multibyte-characters' defined - Didier Verna. -;; ispell-help fixed for XEmacs. Choices minibuffer now displayed in XEmacs. -;; Only list valid dictionaries in Spell menu. Russian dictionary doesn't allow -;; run-together words, and uses koi8-r font. Don't skip text in html <TT> -;; fonts. - -;; Revision 3.2 1999/5/7 14:25:14 kss -;; Accept ispell versions 3.X.Y where X>=1 -;; fine tuned latex region skipping. Fixed bug in ispell-word that did not -;; point in right place on words < 2 chars. Simplified ispell-minor-mode. -;; Fixed bug in TeX parsing when math commands are in the comments. -;; Removed calls to `when' macro. - -;; Revision 3.1 1998/12/1 13:21:52 kss -;; Improved and fixed customize support. -;; Improved and fixed comments in variables and messages. -;; A coding system is now required for all languages. -;; casechars improved for castellano, castellano8, and norsk dictionaries. -;; Dictionary norsk7-tex removed. Dictionary polish added. -;; Dictionaries redefined at load-time to support dictionary changes. -;; Menu redefined at load time to support dictionary changes. -;; ispell-check-version added as an alias for `check-ispell-version'. -;; Spelling suggestions returned in order generated by ispell. -;; Small bug fixed in matching ispell error messages. -;; Robustness added to ensure `case-fold-search' doesn't get redefined. -;; Fixed bug that didn't respect case of word in `ispell-complete-word'. -;; Multibyte character coding support added for process interactions. -;; Ensure ispell process has terminated before starting new process. -;; This can otherwise confuse process filters and hang ispell. -;; Improved skipping support for SGML. -;; Fixed bug using ^M rather than \r in `ispell-minor-check'. -;; Improved message reference matching in `ispell-message'. -;; 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. -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))) - -;; 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. -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 -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)))) - -;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode. -(defmacro ispell-with-no-warnings (&rest body) - (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) - ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar mail-yank-prefix) (defgroup ispell nil "User variables for Emacs ispell interface." :group 'applications) -(if (not (fboundp 'buffer-substring-no-properties)) - (defun buffer-substring-no-properties (start end) - (buffer-substring start end))) - (defalias 'check-ispell-version 'ispell-check-version) ;;; ********************************************************************** @@ -402,19 +260,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) @@ -491,9 +345,7 @@ window system by evaluating the following on startup to set this variable: ;;;###autoload (defcustom ispell-personal-dictionary nil "File name of your personal spelling dictionary, or nil. -If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or -\"~/.aspell.LANG.pws\" for Aspell) is used, where DICTNAME is the name of your -default dictionary and LANG the two letter language code." +If nil, the default personal dictionary for your spelling checker is used." :type '(choice file (const :tag "default" nil)) :group 'ispell) @@ -810,29 +662,11 @@ here just for backwards compatibility.") "Alist with known matching locales for standard dict names in `ispell-dictionary-base-alist'.") -(defvar ispell-emacs-alpha-regexp - (if (string-match "^[[:alpha:]]+$" "abcde") - "[[:alpha:]]" - nil) - "[[:alpha:]] if Emacs supports [:alpha:] regexp, nil -otherwise (current XEmacs does not support it).") ;;; ********************************************************************** ;;; The following are used by ispell, and should not be changed. ;;; ********************************************************************** - - -;; The version must be 3.1 or greater for this version of ispell.el -;; There is an incompatibility between version 3.1.12 and lower versions. -(defconst ispell-required-version '(3 1 12) - "Ispell versions with which this version of ispell.el is known to work.") -(defvar ispell-offset -1 - "Offset that maps protocol differences between ispell 3.1 versions.") - -(defconst ispell-version "ispell.el 3.6 - 7-Jan-2003") - - (defun ispell-check-version (&optional interactivep) "Ensure that `ispell-program-name' is valid and has the correct version. Returns version number if called interactively. @@ -848,7 +682,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 @@ -862,17 +701,19 @@ Otherwise returns the library directory name, if that is defined." (if (string-match "\\`aspell" speller) "-v" "-vv")))) (goto-char (point-min)) (if interactivep - ;; Report version information of ispell and ispell.el + ;; Report version information of ispell (progn (end-of-line) - (setq result (concat (buffer-substring-no-properties (point-min) - (point)) - ", " - ispell-version)) + (setq result (buffer-substring-no-properties (point-min) + (point))) (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 @@ -886,8 +727,7 @@ Otherwise returns the library directory name, if that is defined." ;; Make sure these variables are (re-)initialized to the default value (setq ispell-really-aspell nil - ispell-aspell-supports-utf8 nil - ispell-really-hunspell nil + ispell-really-hunspell nil ispell-encoding8-command nil) (goto-char (point-min)) @@ -901,29 +741,26 @@ Otherwise returns the library directory name, if that is defined." nil t) (match-string 1))))) - (let ((aspell-minver "0.50") - (aspell8-minver "0.60") - (ispell0-minver "3.1.0") - (ispell-minver "3.1.12") - (hunspell8-minver "1.1.6")) - - (if (ispell-check-minver ispell0-minver ispell-program-version) - (or (ispell-check-minver ispell-minver ispell-program-version) - (setq ispell-offset 0)) - (error "%s release %s or greater is required" - ispell-program-name - ispell-minver)) + (let* ((aspell8-minver "0.60") + (ispell-minver "3.1.12") + (hunspell8-minver "1.1.6") + (minver (cond + ((not (version<= ispell-minver ispell-program-version)) + ispell-minver) + ((and ispell-really-aspell + (not (version<= aspell8-minver ispell-really-aspell))) + aspell8-minver)))) + + (if minver + (error "%s release %s or greater is required" + ispell-program-name + minver)) (cond (ispell-really-aspell - (if (ispell-check-minver aspell-minver ispell-really-aspell) - (if (ispell-check-minver aspell8-minver ispell-really-aspell) - (progn - (setq ispell-aspell-supports-utf8 t) - (setq ispell-encoding8-command "--encoding="))) - (setq ispell-really-aspell nil))) + (setq ispell-encoding8-command "--encoding=")) (ispell-really-hunspell - (if (ispell-check-minver hunspell8-minver ispell-really-hunspell) + (if (version<= hunspell8-minver ispell-really-hunspell) (setq ispell-encoding8-command "-i") (setq ispell-really-hunspell nil)))))) result)) @@ -942,6 +779,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, @@ -972,22 +811,10 @@ See `ispell-buffer-with-debug' for an example of use." ;; Redo menu when loading ispell to get dictionary modifications (setq ispell-menu-map nil) -;;;###autoload -(defvar ispell-menu-xemacs nil - "Spelling menu for XEmacs. -If nil when package is loaded, a standard menu will be set, -and added as a submenu of the \"Edit\" menu.") - -;; Break out XEmacs menu and split into several calls to avoid having -;; long lines in loaddefs.el. Detect need off following constant. - ;;; Set up dictionary ;;;###autoload (defvar ispell-menu-map-needed - ;; only needed when not version 18 and not XEmacs. - (and (not ispell-menu-map) - (not (featurep 'xemacs)) - 'reload)) + (unless ispell-menu-map 'reload)) (defvar ispell-library-directory (condition-case () (ispell-check-version) @@ -999,11 +826,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 'make-process) - ;;(fboundp 'set-process-filter) - ;;(fboundp 'process-kill-without-query) - ) + (fboundp 'accept-process-output)) "Non-nil means that the OS supports asynchronous processes.") ;; Make ispell.el work better with aspell. @@ -1013,9 +836,7 @@ and added as a submenu of the \"Edit\" menu.") Internal use.") (defun ispell-find-aspell-dictionaries () - "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'." - (unless (and ispell-really-aspell ispell-encoding8-command) - (error "This function only works with Aspell >= 0.60")) + "Find Aspell's dictionaries, and record in `ispell-aspell-dictionary-alist'." (let* ((dictionaries (split-string (with-temp-buffer @@ -1182,15 +1003,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 +1056,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 +1067,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 +1089,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 +1129,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 +1140,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 +1158,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 @@ -1379,11 +1198,9 @@ aspell is used along with Emacs).") (setq ispell-library-directory (ispell-check-version)) t) (error nil)) - ispell-encoding8-command - ispell-emacs-alpha-regexp) + ispell-encoding8-command) ;; auto-detection will only be used if spellchecker is not - ;; ispell, supports a way to set communication to UTF-8 and - ;; Emacs flavor supports [:alpha:] + ;; ispell and supports a way to set communication to UTF-8. (if ispell-really-aspell (or ispell-aspell-dictionary-alist (ispell-find-aspell-dictionaries)) @@ -1397,9 +1214,8 @@ aspell is used along with Emacs).") ;; installed dictionaries and add to it elements of the original ;; list that are not present there. Allow distro info. (let ((found-dicts-alist - (if (and ispell-encoding8-command - ispell-emacs-alpha-regexp) - (if ispell-really-aspell + (if ispell-encoding8-command + (if ispell-really-aspell ispell-aspell-dictionary-alist (if ispell-really-hunspell ispell-hunspell-dictionary-alist)) @@ -1443,80 +1259,83 @@ 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) - ;; Add dicts to ``ispell-dictionary-alist'' unless already present. + ;; Add dicts to `ispell-dictionary-alist' unless already present. (dolist (dict (append found-dicts-alist 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 - ;; spellchecker also supports UTF-8 via command-line option use it + ;; If spellchecker supports UTF-8 via command-line option, use it ;; in communication. This does not affect definitions in your ;; init file. - (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))) - (setq ispell-dictionary-alist tmp-dicts-alist))))) + (let (tmp-dicts-alist) + (dolist (adict ispell-dictionary-alist) + (cl-pushnew (if (cadr adict) ;; Do not touch hunspell uninitialized entries + (list + (nth 0 adict) ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; 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 () "Return a list of valid dictionaries. The variable `ispell-library-directory' defines their location." ;; Initialize variables and dictionaries alists for desired spellchecker. - ;; Make sure ispell.el is loaded to avoid some autoload loops in XEmacs - ;; (and may be others) + ;; Make sure ispell.el is loaded to avoid some autoload loops. (if (featurep 'ispell) (ispell-set-spellchecker-params)) (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)) @@ -1592,65 +1411,8 @@ The variable `ispell-library-directory' defines their location." (define-key ispell-menu-map [ispell-buffer] `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer :help ,(purecopy "Check spelling of selected buffer"))) - ;;(put 'ispell-region 'menu-enable 'mark-active) (fset 'ispell-menu-map (symbol-value 'ispell-menu-map)))) -;;; XEmacs versions 19 & 20 -(if (and (featurep 'xemacs) - (featurep 'menubar) - ;;(null ispell-menu-xemacs) - (not (and (boundp 'infodock-version) infodock-version))) - (let ((dicts (if (fboundp 'ispell-valid-dictionary-list) - (reverse (ispell-valid-dictionary-list)))) - (current-menubar (or current-menubar default-menubar)) - (menu - '(["Help" (describe-function 'ispell-help) t] - ;;["Help" (popup-menu ispell-help-list) t] - ["Check Message" ispell-message t] - ["Check Buffer" ispell-buffer t] - ["Check Comments" ispell-comments-and-strings t] - ["Check Word" ispell-word t] - ["Check Region" ispell-region (or (not zmacs-regions) (mark))] - ["Continue Check" ispell-continue t] - ["Complete Word Frag"ispell-complete-word-interior-frag t] - ["Complete Word" ispell-complete-word t] - ["Kill Process" (ispell-kill-ispell nil 'clear) t] - ["Customize..." (customize-group 'ispell) t] - ;; flyspell-mode may not be bound... - ;;["flyspell" flyspell-mode - ;; :style toggle :selected flyspell-mode ] - "-" - ["Save Personal Dict"(ispell-pdict-save t t) t] - ["Change Dictionary" ispell-change-dictionary t]))) - (if (null dicts) - (setq dicts (cons "default" nil))) - (dolist (name dicts) - (setq menu (append menu - (list - (vector - (concat "Select " (capitalize name)) - (list 'ispell-change-dictionary name) - t))))) - (setq ispell-menu-xemacs menu) - (if current-menubar - (progn - (if (car (find-menu-item current-menubar '("Cmds"))) - (progn - ;; XEmacs 21.2 - (delete-menu-item '("Cmds" "Spell-Check")) - (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs)) - ;; previous - (delete-menu-item '("Edit" "Spell")) ; in case already defined - (add-menu '("Edit") "Spell" ispell-menu-xemacs)))))) - -(defalias 'ispell-int-char - ;; Allow incrementing characters as integers in XEmacs 20 - (if (and (featurep 'xemacs) - (fboundp 'int-char)) - 'int-char - ;; Emacs and XEmacs 19 or earlier - 'identity)) - ;;; ********************************************************************** @@ -1664,17 +1426,8 @@ used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.") This is passed to the Ispell process using the `-p' switch.") (defun ispell-decode-string (str) - "Decodes multibyte character strings. -Protects against bogus binding of `enable-multibyte-characters' in XEmacs." - ;; FIXME: enable-multibyte-characters is read-only, so bogus bindings are - ;; really nasty (they signal an error in Emacs): Who does that? --Stef - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'decode-coding-string) - (ispell-get-coding-system)) - (decode-coding-string str (ispell-get-coding-system)) - str)) + "Decodes multibyte character strings." + (decode-coding-string str (ispell-get-coding-system))) ;; Return a string decoded from Nth element of the current dictionary. (defun ispell-get-decoded-string (n) @@ -1875,6 +1628,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) @@ -2132,32 +1886,20 @@ quit spell session exited." (cond ((eq poss t) (or quietly (message "%s is correct" - (funcall ispell-format-word-function word))) - (and (featurep 'xemacs) - (extent-at start) - (and (fboundp 'delete-extent) - (delete-extent (extent-at start))))) + (funcall ispell-format-word-function word)))) ((stringp poss) (or quietly (message "%s is correct because of root %s" (funcall ispell-format-word-function word) - (funcall ispell-format-word-function poss))) - (and (featurep 'xemacs) - (extent-at start) - (and (fboundp 'delete-extent) - (delete-extent (extent-at start))))) + (funcall ispell-format-word-function poss)))) ((null poss) (message "Error checking word %s using %s with %s dictionary" (funcall ispell-format-word-function word) (file-name-nondirectory ispell-program-name) (or ispell-current-dictionary "default"))) (ispell-check-only ; called from ispell minor mode. - (if (fboundp 'make-extent) - (if (fboundp 'set-extent-property) - (let ((ext (make-extent start end))) - (set-extent-property ext 'face ispell-highlight-face) - (set-extent-property ext 'priority 2000))) - (beep) + (progn + (beep) (message "%s is incorrect" (funcall ispell-format-word-function word)))) (t ; prompt for correct word. @@ -2327,15 +2069,9 @@ Global `ispell-quit' set to start location to continue spell session." "-- %b -- word: " word " -- dict: " (or ispell-current-dictionary "default") " -- prog: " (file-name-nondirectory ispell-program-name))) - ;; XEmacs: no need for horizontal scrollbar in choices window - (ispell-with-no-warnings - (and (fboundp 'set-specifier) - (boundp 'horizontal-scrollbar-visible-p) - (set-specifier horizontal-scrollbar-visible-p nil - (cons (current-buffer) nil)))) - (ispell-with-no-warnings - (and (boundp 'horizontal-scroll-bar) - (setq horizontal-scroll-bar nil))) + ;; No need for horizontal scrollbar in choices window + (with-no-warnings + (setq horizontal-scroll-bar nil)) (erase-buffer) (if guess (progn @@ -2358,12 +2094,12 @@ Global `ispell-quit' set to start location to continue spell session." ;; not so good if there are over 20 or 30 options, but then, if ;; there are that many you don't want to scan them all anyway... (while (memq count command-characters) ; skip command characters. - (setq count (ispell-int-char (1+ count)) + (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) - count (ispell-int-char (1+ count)))) - (setq count (ispell-int-char (- count ?0 skipped)))) + count (1+ count))) + (setq count (- count ?0 skipped))) (run-hooks 'ispell-update-post-hook) @@ -2422,14 +2158,15 @@ Global `ispell-quit' set to start location to continue spell session." ((= char ?i) ; accept and insert word into pers dict (ispell-send-string (concat "*" word "\n")) (setq ispell-pdict-modified-p '(t)) ; dictionary modified! - (and (fboundp 'flyspell-unhighlight-at) - (flyspell-unhighlight-at start)) + (when (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) - (add-to-list 'ispell-buffer-session-localwords word) - (and (fboundp 'flyspell-unhighlight-at) - (flyspell-unhighlight-at start)) + (cl-pushnew word ispell-buffer-session-localwords + :test #'equal) + (when (fboundp 'flyspell-unhighlight-at) + (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict (setq ispell-buffer-local-name (buffer-name))) (if (null ispell-pdict-modified-p) @@ -2509,13 +2246,12 @@ Global `ispell-quit' set to start location to continue spell session." (window-width)) (insert "\n")) (while (memq count command-characters) - (setq count (ispell-int-char (1+ count)) + (setq count (1+ count) skipped (1+ skipped))) (insert "(" count ") " (car choices) " ") (setq choices (cdr choices) - count (ispell-int-char (1+ count)))) - (setq count (ispell-int-char - (- count ?0 skipped)))) + count (1+ count))) + (setq count (- count ?0 skipped))) (setq textwin (selected-window)) (ispell-show-choices) (select-window textwin)))) @@ -2682,8 +2418,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 +2496,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) @@ -2828,17 +2564,6 @@ Optional REFRESH will unhighlighted then highlight, using block cursor (if (eq 'block refresh) start (- start 2)) end t)))) -(defun ispell-highlight-spelling-error-xemacs (start end &optional highlight) - "Highlight the word from START to END using `isearch-highlight'. -When the optional third arg HIGHLIGHT is set, the word is highlighted, -otherwise it is displayed normally." - (if highlight - (isearch-highlight start end) - (isearch-dehighlight)) - ;;(sit-for 0) - ) - - (defun ispell-highlight-spelling-error-overlay (start end &optional highlight) "Highlight the word from START to END using overlays. When the optional third arg HIGHLIGHT is set, the word is highlighted @@ -2874,14 +2599,9 @@ The variable `ispell-highlight-face' selects the face to use for highlighting." (defun ispell-highlight-spelling-error (start end &optional highlight refresh) - (cond - ((featurep 'xemacs) - (ispell-highlight-spelling-error-xemacs start end highlight)) - ((and (featurep 'faces) - (or (and (fboundp 'display-color-p) (display-color-p)) - window-system)) - (ispell-highlight-spelling-error-overlay start end highlight)) - (t (ispell-highlight-spelling-error-generic start end highlight refresh)))) + (if (display-color-p) + (ispell-highlight-spelling-error-overlay start end highlight) + (ispell-highlight-spelling-error-generic start end highlight refresh))) (defun ispell-display-buffer (buffer) "Show BUFFER in new window above selected one. @@ -3040,17 +2760,14 @@ 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) ;; 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 + ;; personal dictionaries (default-directory (if (or ispell-really-aspell ispell-really-hunspell @@ -3063,9 +2780,8 @@ Keeps argument list for future Ispell invocations for no async support." ".ispell_" (or dict-bname "default"))))) - ;; Ispell, in a minibuffer, and XEmacs - (and (window-minibuffer-p) - (not (fboundp 'minibuffer-selected-window)))) + ;; Ispell, in a minibuffer + (window-minibuffer-p)) (expand-file-name "~/") (expand-file-name default-directory)))) ;; Check if process needs restart @@ -3097,29 +2813,21 @@ Keeps argument list for future Ispell invocations for no async support." (unless (equal ispell-process-directory (expand-file-name "~/")) ;; At this point, `ispell-process-directory' will be "~/" unless using - ;; Ispell with directory-specific dicts and not in XEmacs minibuffer. + ;; Ispell with directory-specific dicts. ;; If not, kill ispell process when killing buffer. It may be in a ;; removable device that would otherwise become un-mountable. (with-current-buffer - (if (and (window-minibuffer-p) ;; In minibuffer - (fboundp 'minibuffer-selected-window)) ;; Not XEmacs. + (if (window-minibuffer-p) ;; In minibuffer ;; In this case kill ispell only when parent buffer is killed ;; to avoid over and over ispell kill. (window-buffer (minibuffer-selected-window)) (current-buffer)) - ;; 'local does not automatically make hook buffer-local in XEmacs. - (if (featurep 'xemacs) - (make-local-hook 'kill-buffer-hook)) - (add-hook 'kill-buffer-hook + (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) nil 'local))) (if ispell-async-processp (set-process-filter ispell-process 'ispell-filter)) - ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'. - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'set-process-coding-system) + (if (and enable-multibyte-characters ;; Evidently, some people use the synchronous mode even ;; when async subprocesses are supported, in which case ;; set-process-coding-system is bound, but @@ -3150,17 +2858,13 @@ 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 (ispell-send-string (concat extended-char-mode "\n")))) - (if ispell-async-processp - (if (featurep 'emacs) - (set-process-query-on-exit-flag ispell-process nil) - (if (fboundp 'set-process-query-on-exit-flag) - (set-process-query-on-exit-flag ispell-process nil) - (process-kill-without-query ispell-process))))))) + (when ispell-async-processp + (set-process-query-on-exit-flag ispell-process nil))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error clear) @@ -3172,9 +2876,7 @@ With CLEAR, buffer session localwords are cleaned." ;; to optimize the common cases. (run-hooks 'ispell-kill-ispell-hook) (if (or clear - (if (featurep 'xemacs) - (interactive-p) - (called-interactively-p 'interactive))) + (called-interactively-p 'interactive)) (setq ispell-buffer-session-localwords nil)) (if (not (and ispell-process (eq (ispell-process-status) 'run))) @@ -3206,7 +2908,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 @@ -3223,9 +2925,7 @@ By just answering RET you can find out what the current dictionary is." ;; Specified dictionary is the default already. Could reload ;; the dictionaries if needed. (ispell-internal-change-dictionary) - (and (if (featurep 'xemacs) - (interactive-p) - (called-interactively-p 'interactive)) + (when (called-interactively-p 'interactive) (message "No change, using %s dictionary" dict))) (t ; reset dictionary! (if (or (assoc dict ispell-local-dictionary-alist) @@ -3412,7 +3112,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 @@ -3638,7 +3338,10 @@ Returns the sum SHIFT due to changes in word replacements." ;; Markers can move with highlighting! This destroys ;; end of region markers line-end and ispell-region-end (let ((word-start - (copy-marker (+ ispell-start ispell-offset (car (cdr poss))))) + ;; There is a -1 offset here as the string is escaped + ;; with '^' to prevent us accidentally sending any + ;; ispell commands. + (copy-marker (+ ispell-start -1 (car (cdr poss))))) (word-len (length (car poss))) (line-end (copy-marker ispell-end)) (line-start (copy-marker ispell-start)) @@ -3869,7 +3572,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 +3806,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: @@ -4135,29 +3838,23 @@ You can bind this to the key C-c i in GNUS or mail by adding to (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (default-prefix ; Vanilla cite prefix (just used for cite-regexp) - (if (and (boundp 'mail-yank-prefix) mail-yank-prefix) - (ispell-non-empty-string mail-yank-prefix) + (if (ispell-non-empty-string mail-yank-prefix) " \\|\t")) (cite-regexp ;Prefix of quoted text (cond - ((functionp 'sc-cite-regexp) ; sc 3.0 - (ispell-with-no-warnings + ((functionp 'sc-cite-regexp) ; supercite >= 3.0 + (with-no-warnings (concat "\\(" (sc-cite-regexp) "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string)))) - ((boundp 'sc-cite-regexp) ; sc 2.3 - (concat "\\(" sc-cite-regexp "\\)" "\\|" - (ispell-with-no-warnings - (ispell-non-empty-string sc-reference-tag-string)))) - ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below - (equal major-mode 'message-mode)) ;GNUS 5 + ((equal major-mode 'message-mode) ; GNUS >= 5 (concat "In article <" "\\|" "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|" - (ispell-with-no-warnings message-cite-prefix-regexp) + (with-no-warnings message-cite-prefix-regexp) "\\|" default-prefix)) ((equal major-mode 'mh-letter-mode) ; mh mail message (concat "[^,;&+=\n]+ writes:" "\\|" - (ispell-with-no-warnings + (with-no-warnings (ispell-non-empty-string mh-ins-buf-prefix)))) ((not internal-messagep) ; Assume nn sent us this message. (concat "In [a-zA-Z.]+ you write:" "\\|" @@ -4381,8 +4078,8 @@ Both should not be used to define a buffer-local dictionary." ;; Returns optionally adjusted region-end-point. -;; If comment-padright is defined, newcomment must be loaded. -(declare-function comment-add "newcomment" (arg)) +;; If comment-normalize-vars is defined, newcomment must be loaded. +(declare-function comment-normalize-vars "newcomment" (&optional noerror)) (defun ispell-add-per-file-word-list (word) "Add WORD to the per-file word list." @@ -4408,16 +4105,12 @@ Both should not be used to define a buffer-local dictionary." (unless found (newline)) (insert (if comment-start (concat - (if (fboundp 'comment-padright) - ;; Try and use the proper comment marker, - ;; e.g. ";;" rather than ";". - (progn - ;; XEmacs: comment-normalize-vars - ;; (newcomment.el) only in >= 21.5 - (and (fboundp 'comment-normalize-vars) - (comment-normalize-vars)) - (comment-padright comment-start - (comment-add nil))) + (progn + ;; Try and use the proper comment marker, + ;; e.g. ";;" rather than ";". + (comment-normalize-vars) + (comment-padright comment-start + (comment-add nil)) comment-start) " ") "") @@ -4428,6 +4121,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) @@ -4465,6 +4159,6 @@ Both should not be used to define a buffer-local dictionary." ; LocalWords: minipage pers dict unhighlight buf grep sync prev inc ; LocalWords: fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg ; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict -; LocalWords: lns XEmacs HTML casechars Multibyte +; LocalWords: lns HTML casechars Multibyte ;;; ispell.el ends here 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/picture.el b/lisp/textmodes/picture.el index b77f8e9717c..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." 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 c3f39ecd327..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) @@ -237,5 +237,5 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See ;;; reftex-auc.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 0a3e7a48356..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))) @@ -1262,5 +1262,5 @@ created files in the variables `reftex-create-bibtex-header' or ;;; reftex-cite.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 9d4ee086db1..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) @@ -488,5 +488,5 @@ Calling this function several times find successive citation locations." ;;; reftex-dcr.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 7f27158d257..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)) @@ -477,5 +477,5 @@ With no argument, this command toggles ;;; reftex-global.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index c5c3885b167..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)) @@ -2119,5 +2111,5 @@ Does not do a save-excursion." ;;; reftex-index.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 5f969f4effd..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))) @@ -1131,5 +1131,5 @@ When LEVEL is non-nil, increase section numbers on that level." ;;; reftex-parse.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 32703591cad..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 @@ -881,5 +881,5 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." ;;; reftex-ref.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index f46c2370d71..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"))) @@ -745,5 +733,5 @@ Cycle in reverse order if optional argument REVERSE is non-nil." ;;; reftex-sel.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index e96e822fd0f..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)) @@ -1111,5 +1103,5 @@ always show the current section in connection with the option ;;; reftex-toc.el ends here ;; Local Variables: -;; generated-autoload-file: "reftex.el" +;; generated-autoload-file: "reftex-loaddefs.el" ;; End: diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index d1a6b87da2e..11dcdd5a183 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) @@ -151,6 +151,22 @@ distribution. Mixed-case symbols are convenience aliases.") (?A . "\\citeauthor*{%l}") (?y . "\\citeyear{%l}") (?n . "\\nocite{%l}"))) + (biblatex "The Biblatex package" + ((?\C-m . "\\cite[][]{%l}") + (?C . "\\cite*[][]{%l}") + (?t . "\\textcite[][]{%l}") + (?T . "\\textcite*[][]{%l}") + (?p . "\\parencite[][]{%l}") + (?P . "\\parencite*[][]{%l}") + (?f . "\\footcite[][]{%l}") + (?s . "\\smartcite[][]{%l}") + (?u . "\\autocite[][]{%l}") + (?U . "\\autocite*[][]{%l}") + (?a . "\\citeauthor{%l}") + (?A . "\\citeauthor*{%l}") + (?y . "\\citeyear{%l}") + (?Y . "\\citeyear*{%l}") + (?n . "\\nocite{%l}"))) (amsrefs "The AMSRefs package" ((?\C-m . "\\cite{%l}") (?p . "\\cite{%l}") @@ -1076,9 +1092,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 ae9db7de10a..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) @@ -70,7 +70,8 @@ (require 'reftex-vars) -;;; Autoloads - see end for automatic autoloads +;;; Autoloads to ensure loading of support files when necessary +(require 'reftex-loaddefs) ;; We autoload tons of functions from these files, but some have ;; a single function that needs to be globally autoloaded. @@ -99,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) @@ -254,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. @@ -443,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 @@ -452,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 @@ -658,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 @@ -795,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) @@ -812,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) @@ -830,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) @@ -914,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))) @@ -940,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) @@ -967,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 @@ -1057,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) @@ -1122,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)) @@ -1253,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)) @@ -1757,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? @@ -1771,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) @@ -2133,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 @@ -2164,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 @@ -2268,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 @@ -2394,702 +2391,6 @@ Your bug report will be posted to the AUCTeX bug reporting list. (setq reftex-tables-dirty t) ; in case this file is evaluated by hand - -;;; Start of automatically extracted autoloads. - -;;;### (autoloads nil "reftex-auc" "reftex-auc.el" "32dc44348a7eaf247f63c81b3ead2ba4") -;;; Generated autoloads from reftex-auc.el - -(autoload 'reftex-arg-label "reftex-auc" "\ -Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. -What is being used depends upon `reftex-plug-into-AUCTeX'. - -\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) - -(autoload 'reftex-arg-cite "reftex-auc" "\ -Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. -What is being used depends upon `reftex-plug-into-AUCTeX'. - -\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) - -(autoload 'reftex-arg-index-tag "reftex-auc" "\ -Prompt for an index tag with completion. -This is the name of an index, not the entry. - -\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) - -(autoload 'reftex-arg-index "reftex-auc" "\ -Prompt for an index entry completing with known entries. -Completion is specific for just one index, if the macro or a tag -argument identify one of multiple indices. - -\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) - -(autoload 'reftex-plug-into-AUCTeX "reftex-auc" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" "\ -Toggle Interface between AUCTeX and RefTeX on and off. - -\(fn)" t nil) - -(autoload 'reftex-add-label-environments "reftex-auc" "\ -Add label environment descriptions to `reftex-label-alist-style'. -The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there -for details. -This function makes it possible to support RefTeX from AUCTeX style files. -The entries in ENTRY-LIST will be processed after the user settings in -`reftex-label-alist', and before the defaults (specified in -`reftex-default-label-alist-entries'). Any changes made to -`reftex-label-alist-style' will raise a flag to the effect that -the label information is recompiled on next use. - -\(fn ENTRY-LIST)" nil nil) - -(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) - -(autoload 'reftex-add-section-levels "reftex-auc" "\ -Add entries to the value of `reftex-section-levels'. -The added values are kept local to the current document. The format -of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See -`reftex-section-levels' for an example. - -\(fn ENTRY-LIST)" nil nil) - -(autoload 'reftex-notice-new-section "reftex-auc" "\ - - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-cite" "reftex-cite.el" "7ee48dcf194ffd3cce3b7a2eb990e300") -;;; Generated autoloads from reftex-cite.el - -(autoload 'reftex-default-bibliography "reftex-cite" "\ -Return the expanded value of variable `reftex-default-bibliography'. -The expanded value is cached. - -\(fn)" nil nil) - -(autoload 'reftex-bib-or-thebib "reftex-cite" "\ -Test if BibTeX or egin{thebibliography} should be used for the citation. -Find the bof of the current file - -\(fn)" nil nil) - -(autoload 'reftex-get-bibfile-list "reftex-cite" "\ -Return list of bibfiles for current document. -When using the chapterbib or bibunits package you should either -use the same database files everywhere, or separate parts using -different databases into different files (included into the mater file). -Then this function will return the applicable database files. - -\(fn)" nil nil) - -(autoload 'reftex-pop-to-bibtex-entry "reftex-cite" "\ -Find BibTeX KEY in any file in FILE-LIST in another window. -If MARK-TO-KILL is non-nil, mark new buffer to kill. -If HIGHLIGHT is non-nil, highlight the match. -If ITEM in non-nil, search for bibitem instead of database entry. -If RETURN is non-nil, just return the entry and restore point. - -\(fn KEY FILE-LIST &optional MARK-TO-KILL HIGHLIGHT ITEM RETURN)" nil nil) - -(autoload 'reftex-end-of-bib-entry "reftex-cite" "\ - - -\(fn ITEM)" nil nil) - -(autoload 'reftex-parse-bibtex-entry "reftex-cite" "\ -Parse BibTeX ENTRY. -If ENTRY is nil then parse the entry in current buffer between FROM and TO. -If RAW is non-nil, keep double quotes/curly braces delimiting fields. - -\(fn ENTRY &optional FROM TO RAW)" nil nil) - -(autoload 'reftex-citation "reftex-cite" "\ -Make a citation using BibTeX database files. -After prompting for a regular expression, scans the buffers with -bibtex entries (taken from the \\bibliography command) and offers the -matching entries for selection. The selected entry is formatted according -to `reftex-cite-format' and inserted into the buffer. - -If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. - -FORMAT-KEY can be used to pre-select a citation format. - -When called with a `C-u' prefix, prompt for optional arguments in -cite macros. When called with a numeric prefix, make that many -citations. When called with point inside the braces of a `\\cite' -command, it will add another key, ignoring the value of -`reftex-cite-format'. - -The regular expression uses an expanded syntax: && is interpreted as `and'. -Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. -While entering the regexp, completion on knows citation keys is possible. -`=' is a good regular expression to match all entries in all files. - -\(fn &optional NO-INSERT FORMAT-KEY)" t nil) - -(autoload 'reftex-citep "reftex-cite" "\ -Call `reftex-citation' with a format selector `?p'. - -\(fn)" t nil) - -(autoload 'reftex-citet "reftex-cite" "\ -Call `reftex-citation' with a format selector `?t'. - -\(fn)" t nil) - -(autoload 'reftex-make-cite-echo-string "reftex-cite" "\ -Format a bibtex ENTRY for the echo area and cache the result. - -\(fn ENTRY DOCSTRUCT-SYMBOL)" nil nil) - -(autoload 'reftex-create-bibtex-file "reftex-cite" "\ -Create a new BibTeX database BIBFILE with all entries referenced in document. -The command prompts for a filename and writes the collected -entries to that file. Only entries referenced in the current -document with any \\cite-like macros are used. The sequence in -the new file is the same as it was in the old database. - -Entries referenced from other entries must appear after all -referencing entries. - -You can define strings to be used as header or footer for the -created files in the variables `reftex-create-bibtex-header' or -`reftex-create-bibtex-footer' respectively. - -\(fn BIBFILE)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-dcr" "reftex-dcr.el" "8a1cb9d9c9190eefd4e22ab89d278e03") -;;; Generated autoloads from reftex-dcr.el - -(autoload 'reftex-view-crossref "reftex-dcr" "\ -View cross reference of macro at point. Point must be on the KEY -argument. When at a `\\ref' macro, show corresponding `\\label' -definition, also in external documents (`xr'). When on a label, show -a locations where KEY is referenced. Subsequent calls find additional -locations. When on a `\\cite', show the associated `\\bibitem' macro or -the BibTeX database entry. When on a `\\bibitem', show a `\\cite' macro -which uses this KEY. When on an `\\index', show other locations marked -by the same index entry. -To define additional cross referencing items, use the option -`reftex-view-crossref-extra'. See also `reftex-view-crossref-from-bibtex'. -With one or two C-u prefixes, enforce rescanning of the document. -With argument 2, select the window showing the cross reference. -AUTO-HOW is only for the automatic crossref display and is handed through -to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'. - -\(fn &optional ARG AUTO-HOW FAIL-QUIETLY)" t nil) - -(autoload 'reftex-mouse-view-crossref "reftex-dcr" "\ -View cross reference of \\ref or \\cite macro where you click. -If the macro at point is a \\ref, show the corresponding label definition. -If it is a \\cite, show the BibTeX database entry. -If there is no such macro at point, search forward to find one. -With argument, actually select the window showing the cross reference. - -\(fn EV)" t nil) - -(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr" "\ -Toggle the automatic display of crossref information in the echo area. -When active, leaving point idle in the argument of a \\ref or \\cite macro -will display info in the echo area. - -\(fn)" t nil) - -(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "\ -View location in a LaTeX document which cites the BibTeX entry at point. -Since BibTeX files can be used by many LaTeX documents, this function -prompts upon first use for a buffer in RefTeX mode. To reset this -link to a document, call the function with a prefix arg. -Calling this function several times find successive citation locations. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-global" "reftex-global.el" "a7a6a1872e4509da5b211972c2a588ad") -;;; Generated autoloads from reftex-global.el - -(autoload 'reftex-create-tags-file "reftex-global" "\ -Create TAGS file by running `etags' on the current document. -The TAGS file is also immediately visited with `visit-tags-table'. - -\(fn)" t nil) - -(autoload 'reftex-grep-document "reftex-global" "\ -Run grep query through all files related to this document. -With prefix arg, force to rescan document. -No active TAGS table is required. - -\(fn GREP-CMD)" t nil) - -(autoload 'reftex-search-document "reftex-global" "\ -Regexp search through all files of the current document. -Starts always in the master file. Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. -No active TAGS table is required. - -\(fn &optional REGEXP)" t nil) - -(autoload 'reftex-query-replace-document "reftex-global" "\ -Do `query-replace-regexp' of FROM with TO over the entire document. -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]. -No active TAGS table is required. - -\(fn &optional FROM TO DELIMITED)" t nil) - -(autoload 'reftex-find-duplicate-labels "reftex-global" "\ -Produce a list of all duplicate labels in the document. - -\(fn)" t nil) - -(autoload 'reftex-change-label "reftex-global" "\ -Run `query-replace-regexp' of FROM with TO in all macro arguments. -Works on the entire multifile document. -If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]. -No active TAGS table is required. - -\(fn &optional FROM TO)" t nil) - -(autoload 'reftex-renumber-simple-labels "reftex-global" "\ -Renumber all simple labels in the document to make them sequentially. -Simple labels are the ones created by RefTeX, consisting only of the -prefix and a number. After the command completes, all these labels will -have sequential numbers throughout the document. Any references to -the labels will be changed as well. For this, RefTeX looks at the -arguments of any macros which either start or end in the string `ref'. -This command should be used with care, in particular in multifile -documents. You should not use it if another document refers to this -one with the `xr' package. - -\(fn)" t nil) - -(autoload 'reftex-save-all-document-buffers "reftex-global" "\ -Save all documents associated with the current document. -The function is useful after a global action like replacing or renumbering -labels. - -\(fn)" t nil) - -(autoload 'reftex-isearch-minor-mode "reftex-global" "\ -When on, isearch searches the whole document, not only the current file. -This minor mode allows isearch to search through all the files of -the current TeX document. - -With no argument, this command toggles -`reftex-isearch-minor-mode'. With a prefix argument ARG, turn -`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-index" "reftex-index.el" "0e0eef2a199fb9de6f13b5eef601843f") -;;; Generated autoloads from reftex-index.el - -(autoload 'reftex-index-selection-or-word "reftex-index" "\ -Put selection or the word near point into the default index macro. -This uses the information in `reftex-index-default-macro' to make an index -entry. The phrase indexed is the current selection or the word near point. -When called with one `C-u' prefix, let the user have a chance to edit the -index entry. When called with 2 `C-u' as prefix, also ask for the index -macro and other stuff. -When called inside TeX math mode as determined by the `texmathp.el' library -which is part of AUCTeX, the string is first processed with the -`reftex-index-math-format', which see. - -\(fn &optional ARG PHRASE)" t nil) - -(autoload 'reftex-index "reftex-index" "\ -Query for an index macro and insert it along with its arguments. -The index macros available are those defined in `reftex-index-macro' or -by a call to `reftex-add-index-macros', typically from an AUCTeX style file. -RefteX provides completion for the index tag and the index key, and -will prompt for other arguments. - -\(fn &optional CHAR KEY TAG SEL NO-INSERT)" t nil) - -(autoload 'reftex-index-complete-tag "reftex-index" "\ - - -\(fn &optional ITAG OPT-ARGS)" nil nil) - -(autoload 'reftex-index-select-tag "reftex-index" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-index-complete-key "reftex-index" "\ - - -\(fn &optional TAG OPTIONAL INITIAL)" nil nil) - -(autoload 'reftex-index-show-entry "reftex-index" "\ - - -\(fn DATA &optional NO-REVISIT)" nil nil) - -(autoload 'reftex-display-index "reftex-index" "\ -Display a buffer with an index compiled from the current document. -When the document has multiple indices, first prompts for the correct one. -When index support is turned off, offer to turn it on. -With one or two `C-u' prefixes, rescan document first. -With prefix 2, restrict index to current document section. -With prefix 3, restrict index to region. - -\(fn &optional TAG OVERRIDING-RESTRICTION REDO &rest LOCATIONS)" t nil) - -(autoload 'reftex-index-phrase-selection-or-word "reftex-index" "\ -Add current selection or word at point to the phrases buffer. -When you are in transient-mark-mode and the region is active, the -selection will be used - otherwise the word at point. -You get a chance to edit the entry in the phrases buffer - finish with -`C-c C-c'. - -\(fn ARG)" t nil) - -(autoload 'reftex-index-visit-phrases-buffer "reftex-index" "\ -Switch to the phrases buffer, initialize if empty. - -\(fn)" t nil) - -(autoload 'reftex-index-phrases-mode "reftex-index" "\ -Major mode for managing the Index phrases of a LaTeX document. -This buffer was created with RefTeX. - -To insert new phrases, use - - `C-c \\' in the LaTeX document to copy selection or word - - `\\[reftex-index-new-phrase]' in the phrases buffer. - -To index phrases use one of: - -\\[reftex-index-this-phrase] index current phrase -\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) -\\[reftex-index-all-phrases] index all phrases -\\[reftex-index-remaining-phrases] index current and following phrases -\\[reftex-index-region-phrases] index the phrases in the region - -You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. -To display information about the phrase at point, use \\[reftex-index-phrases-info]. - -For more information see the RefTeX User Manual. - -Here are all local bindings. - -\\{reftex-index-phrases-mode-map} - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "9015d91c86a135c850f92b828eca6b62") -;;; Generated autoloads from reftex-parse.el - -(autoload 'reftex-parse-one "reftex-parse" "\ -Re-parse this file. - -\(fn)" t nil) - -(autoload 'reftex-parse-all "reftex-parse" "\ -Re-parse entire document. - -\(fn)" t nil) - -(autoload 'reftex-do-parse "reftex-parse" "\ -Do a document rescan. -When allowed, do only a partial scan from FILE. - -\(fn RESCAN &optional FILE)" nil nil) - -(autoload 'reftex-everything-regexp "reftex-parse" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-all-document-files "reftex-parse" "\ -Return a list of all files belonging to the current document. -When RELATIVE is non-nil, give file names relative to directory -of master file. - -\(fn &optional RELATIVE)" nil nil) - -(autoload 'reftex-locate-bibliography-files "reftex-parse" "\ -Scan buffer for bibliography macros and return file list. - -\(fn MASTER-DIR &optional FILES)" nil nil) - -(autoload 'reftex-section-info "reftex-parse" "\ -Return a section entry for the current match. -Careful: This function expects the match-data to be still in place! - -\(fn FILE)" nil nil) - -(autoload 'reftex-ensure-index-support "reftex-parse" "\ -When index support is turned off, ask to turn it on and -set the current prefix argument so that `reftex-access-scan-info' -will rescan the entire document. - -\(fn &optional ABORT)" nil nil) - -(autoload 'reftex-index-info-safe "reftex-parse" "\ - - -\(fn FILE)" nil nil) - -(autoload 'reftex-index-info "reftex-parse" "\ -Return an index entry for the current match. -Careful: This function expects the match-data to be still in place! - -\(fn FILE)" nil nil) - -(autoload 'reftex-short-context "reftex-parse" "\ -Get about one line of useful context for the label definition at point. - -\(fn ENV PARSE &optional BOUND DERIVE)" nil nil) - -(autoload 'reftex-where-am-I "reftex-parse" "\ -Return the docstruct entry above point. -Actually returns a cons cell in which the cdr is a flag indicating -if the information is exact (t) or approximate (nil). - -\(fn)" nil nil) - -(autoload 'reftex-notice-new "reftex-parse" "\ -Hook to handshake with RefTeX after something new has been inserted. - -\(fn &optional N FORCE)" nil nil) - -(autoload 'reftex-what-macro-safe "reftex-parse" "\ -Call `reftex-what-macro' with special syntax table. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-macro "reftex-parse" "\ -Find out if point is within the arguments of any TeX-macro. -The return value is either (\"\\macro\" . (point)) or a list of them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing macro. -If WHICH is t, return list of all macros enclosing point. -If WHICH is a list of macros, look only for those macros and return the - name of the first macro in this list found to enclose point. -If the optional BOUND is an integer, bound backwards directed - searches to this point. If it is nil, limit to nearest \\section - - like statement. - -This function is pretty stable, but can be fooled if the text contains -things like \\macro{aa}{bb} where \\macro is defined to take only one -argument. As RefTeX cannot know this, the string \"bb\" would still be -considered an argument of macro \\macro. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-environment "reftex-parse" "\ -Find out if point is inside a LaTeX environment. -The return value is (e.g.) either (\"equation\" . (point)) or a list of -them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing environment. -If WHICH is t, return list of all environments enclosing point. -If WHICH is a list of environments, look only for those environments and - return the name of the first environment in this list found to enclose - point. - -If the optional BOUND is an integer, bound backwards directed searches to -this point. If it is nil, limit to nearest \\section - like statement. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-what-special-env "reftex-parse" "\ -Run the special environment parsers and return the matches. - -The return value is (e.g.) either (\"my-parser-function\" . (point)) -or a list of them. - -If WHICH is nil, immediately return nil. -If WHICH is 1, return innermost enclosing environment. -If WHICH is t, return list of all environments enclosing point. -If WHICH is a list of environments, look only for those environments and - return the name of the first environment in this list found to enclose - point. - -\(fn WHICH &optional BOUND)" nil nil) - -(autoload 'reftex-nth-arg "reftex-parse" "\ -Return the Nth following {} or [] parentheses content. -OPT-ARGS is a list of argument numbers which are optional. - -\(fn N &optional OPT-ARGS)" nil nil) - -(autoload 'reftex-move-over-touching-args "reftex-parse" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-init-section-numbers "reftex-parse" "\ -Initialize the section numbers with zeros or with what is found in the TOC-ENTRY. - -\(fn &optional TOC-ENTRY APPENDIX)" nil nil) - -(autoload 'reftex-section-number "reftex-parse" "\ -Return a string with the current section number. -When LEVEL is non-nil, increase section numbers on that level. - -\(fn &optional LEVEL STAR)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-ref" "reftex-ref.el" "b2ce366d12050904d89cc38b96b8058a") -;;; Generated autoloads from reftex-ref.el - -(autoload 'reftex-label-location "reftex-ref" "\ -Return the environment or macro which determines the label type at point. -If optional BOUND is an integer, limit backward searches to that point. - -\(fn &optional BOUND)" nil nil) - -(autoload 'reftex-label-info-update "reftex-ref" "\ - - -\(fn CELL)" nil nil) - -(autoload 'reftex-label-info "reftex-ref" "\ - - -\(fn LABEL &optional FILE BOUND DERIVE ENV-OR-MAC)" nil nil) - -(autoload 'reftex-label "reftex-ref" "\ -Insert a unique label. Return the label. -If ENVIRONMENT is given, don't bother to find out yourself. -If NO-INSERT is non-nil, do not insert label into buffer. -With prefix arg, force to rescan document first. -When you are prompted to enter or confirm a label, and you reply with -just the prefix or an empty string, no label at all will be inserted. -A new label is also recorded into the label list. -This function is controlled by the settings of reftex-insert-label-flags. - -\(fn &optional ENVIRONMENT NO-INSERT)" t nil) - -(autoload 'reftex-reference "reftex-ref" "\ -Make a LaTeX reference. Look only for labels of a certain TYPE. -With prefix arg, force to rescan buffer for labels. This should only be -necessary if you have recently entered labels yourself without using -reftex-label. Rescanning of the buffer can also be requested from the -label selection menu. -The function returns the selected label or nil. -If NO-INSERT is non-nil, do not insert \\ref command, just return label. -When called with 2 C-u prefix args, disable magic word recognition. - -\(fn &optional TYPE NO-INSERT CUT)" t nil) - -(autoload 'reftex-query-label-type "reftex-ref" "\ - - -\(fn)" nil nil) - -(autoload 'reftex-show-label-location "reftex-ref" "\ - - -\(fn DATA FORWARD NO-REVISIT &optional STAY ERROR)" nil nil) - -(autoload 'reftex-goto-label "reftex-ref" "\ -Prompt for a label (with completion) and jump to the location of this label. -Optional prefix argument OTHER-WINDOW goes to the label in another window. - -\(fn &optional OTHER-WINDOW)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-sel" "reftex-sel.el" "b5e68431056b461d8a0562e9e685a5f1") -;;; Generated autoloads from reftex-sel.el - -(autoload 'reftex-select-label-mode "reftex-sel" "\ -Major mode for selecting a label in a LaTeX document. -This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a -selection process. -To select a label, move the cursor to it and press RET. -Press `?' for a summary of important key bindings. - -During a selection process, these are the local bindings. - -\\{reftex-select-label-mode-map} - -\(fn)" t nil) - -(autoload 'reftex-select-bib-mode "reftex-sel" "\ -Major mode for selecting a citation key in a LaTeX document. -This buffer was created with RefTeX. -It only has a meaningful keymap when you are in the middle of a -selection process. -In order to select a citation, move the cursor to it and press RET. -Press `?' for a summary of important key bindings. - -During a selection process, these are the local bindings. - -\\{reftex-select-label-mode-map} - -\(fn)" t nil) - -(autoload 'reftex-get-offset "reftex-sel" "\ - - -\(fn BUF HERE-AM-I &optional TYPEKEY TOC INDEX FILE)" nil nil) - -(autoload 'reftex-insert-docstruct "reftex-sel" "\ - - -\(fn BUF TOC LABELS INDEX-ENTRIES FILES CONTEXT COUNTER SHOW-COMMENTED HERE-I-AM XR-PREFIX TOC-BUFFER)" nil nil) - -(autoload 'reftex-find-start-point "reftex-sel" "\ - - -\(fn FALLBACK &rest LOCATIONS)" nil nil) - -(autoload 'reftex-select-item "reftex-sel" "\ - - -\(fn REFTEX-SELECT-PROMPT HELP-STRING KEYMAP &optional OFFSET CALL-BACK CB-FLAG)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-toc" "reftex-toc.el" "af8f426ef3a0607322ca4c9742e177a8") -;;; Generated autoloads from reftex-toc.el - -(autoload 'reftex-toc "reftex-toc" "\ -Show the table of contents for the current document. -When called with a raw C-u prefix, rescan the document first. - -\(fn &optional REBUILD REUSE)" t nil) - -(autoload 'reftex-toc-recenter "reftex-toc" "\ -Display the TOC window and highlight line corresponding to current position. - -\(fn &optional ARG)" t nil) - -(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "\ -Toggle the automatic recentering of the TOC window. -When active, leaving point idle will make the TOC window jump to the correct -section. - -\(fn)" t nil) - -;;;*** - -;;; End of automatically extracted autoloads. - (provide 'reftex) ;;; reftex.el ends here diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index aea8e7072ea..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))) @@ -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 98a01e8d83f..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)) @@ -842,6 +845,25 @@ Return non-nil if we skipped over matched tags." (setq arg (1- arg))) return)) +(defun sgml-forward-sexp (n) + ;; This function is needed in major-modes such as nxml-mode where + ;; forward-sexp-function is used to give a more dwimish behavior to + ;; the `forward-sexp' command. + ;; Without it, we can end up with backtraces like: + ;; "get-text-property" (0xffffc0f0) + ;; "nxml-token-after" (0xffffc2ac) + ;; "nxml-forward-single-balanced-item" (0xffffc46c) + ;; "nxml-forward-balanced-item" (0xffffc61c) + ;; "forward-sexp" (0xffffc7f8) + ;; "sgml-parse-tag-backward" (0xffffc9c8) + ;; "sgml-lexical-context" (0xffffcba8) + ;; "sgml-mode-flyspell-verify" (0xffffcd74) + ;; "flyspell-word" (0xffffcf3c) + ;; "flyspell-post-command-hook" (0xffffd108) + ;; FIXME: should we also set the sgml-tag-syntax-table? + (let ((forward-sexp-function nil)) + (forward-sexp n))) + (defvar sgml-electric-tag-pair-overlays nil) (defvar sgml-electric-tag-pair-timer nil) @@ -862,11 +884,12 @@ Return non-nil if we skipped over matched tags." (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) (with-syntax-table sgml-tag-syntax-table - (up-list -1) - (when (sgml-skip-tag-forward 1) - (backward-sexp 1) - (forward-char 2) - t)))) + (let ((forward-sexp-function nil)) + (up-list -1) + (when (sgml-skip-tag-forward 1) + (backward-sexp 1) + (forward-char 2) + t))))) (clones (get-char-property (point) 'text-clones))) (when (and match (/= cl-end cl-start) @@ -1066,9 +1089,9 @@ With prefix argument ARG, repeat this ARG times." ((and (eq (char-before) ?>) (or (not (eq (char-after) ?<)) (> x y))) - (backward-sexp)) + (sgml-forward-sexp -1)) ((eq (char-after y) ?<) - (forward-sexp))) + (sgml-forward-sexp 1))) (point)))) (message "Invisible tag: %s" ;; Strip properties, otherwise, the text is invisible. @@ -1235,7 +1258,7 @@ You might want to turn on `auto-fill-mode' to get better results." (unless (or ;;(looking-at "</") (progn (skip-chars-backward " \t") (bolp))) (reindent-then-newline-and-indent)) - (forward-sexp 1))) + (sgml-forward-sexp 1))) ;; (indent-region beg end) )) @@ -1281,7 +1304,7 @@ Leave point at the beginning of the tag." (let ((pos (point))) (condition-case nil ;; FIXME: This does not correctly skip over PI an CDATA tags. - (forward-sexp) + (sgml-forward-sexp 1) (scan-error ;; This < seems to be just a spurious one, let's ignore it. (goto-char pos) @@ -1315,7 +1338,7 @@ Leave point at the beginning of the tag." (with-syntax-table sgml-tag-syntax-table (goto-char tag-end) (condition-case nil - (backward-sexp) + (sgml-forward-sexp -1) (scan-error ;; This > isn't really the end of a tag. Skip it. (goto-char (1- tag-end)) @@ -1540,7 +1563,7 @@ LCON is the lexical context, if any." (`text (while (looking-at "</") - (forward-sexp 1) + (sgml-forward-sexp 1) (skip-chars-forward " \t")) (let* ((here (point)) (unclosed (and ;; (not sgml-xml-mode) @@ -1759,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:") @@ -1776,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 " />" ">")) @@ -1798,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"))) @@ -1819,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 @@ -1835,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 @@ -1858,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:" @@ -1874,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") @@ -1904,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") @@ -1946,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") @@ -1967,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.") @@ -2031,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") @@ -2081,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 ea7fbf8d4c2..25d674541c5 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -343,7 +343,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (defun latex-imenu-create-index () "Generate an alist for imenu from a LaTeX buffer." (let ((section-regexp - (concat "\\\\" (regexp-opt (mapcar 'car latex-section-alist) t) + (concat "\\\\" (regexp-opt (mapcar #'car latex-section-alist) t) "\\*?[ \t]*{")) (metasection-regexp (concat "\\\\" (regexp-opt latex-metasection-list t))) @@ -373,7 +373,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; Using sexps allows some use of matching {...} inside ;; titles. (forward-sexp 1) - (push (cons (concat (apply 'concat + (push (cons (concat (apply #'concat (make-list (max 0 (- i i0)) latex-imenu-indent-string)) @@ -413,7 +413,8 @@ An alternative value is \" . \", if you use a font with a narrow period." (defvar latex-outline-regexp (concat "\\\\" (regexp-opt (append latex-metasection-list - (mapcar 'car latex-section-alist)) t))) + (mapcar #'car latex-section-alist)) + t))) (defun latex-outline-level () (if (looking-at latex-outline-regexp) @@ -504,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.) @@ -544,7 +545,8 @@ An alternative value is \" . \", if you use a font with a narrow period." (let* (;; ;; Names of commands whose arg should be fontified with fonts. (bold (regexp-opt '("textbf" "textsc" "textup" - "boldsymbol" "pmb") t)) + "boldsymbol" "pmb") + t)) (italic (regexp-opt '("textit" "textsl" "emph") t)) ;; FIXME: unimplemented yet. ;; (type (regexp-opt '("texttt" "textmd" "textrm" "textsf") t)) @@ -566,7 +568,8 @@ An alternative value is \" . \", if you use a font with a narrow period." '("linebreak" "nolinebreak" "pagebreak" "nopagebreak" "newline" "newpage" "clearpage" "cleardoublepage" "displaybreak" "allowdisplaybreaks" - "enlargethispage") t)) + "enlargethispage") + t)) (general "\\([a-zA-Z@]+\\**\\|[^ \t\n]\\)") ;; ;; Miscellany. @@ -649,7 +652,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (defvar tex-verbatim-environments '("verbatim" "verbatim*")) (put 'tex-verbatim-environments 'safe-local-variable - (lambda (x) (null (delq t (mapcar 'stringp x))))) + (lambda (x) (null (delq t (mapcar #'stringp x))))) (eval-when-compile (defconst tex-syntax-propertize-rules @@ -797,15 +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 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. @@ -833,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) @@ -1128,34 +1127,36 @@ subshell is initiated, `tex-shell-hook' is run." (concat "[ \t]*\\(\\$\\$\\|" "\\\\[][]\\|" "\\\\" (regexp-opt (append - (mapcar 'car latex-section-alist) + (mapcar #'car latex-section-alist) '("begin" "label" "end" "item" "bibitem" "newline" "noindent" "newpage" "footnote" "marginpar" - "parbox" "caption")) t) + "parbox" "caption")) + t) "\\>\\|\\\\[a-z]*" (regexp-opt '("space" "skip" "page") t) "\\>\\)")) (setq paragraph-separate (concat "[\f%]\\|[ \t]*\\($\\|" "\\\\[][]\\|" "\\\\" (regexp-opt (append - (mapcar 'car latex-section-alist) - '("begin" "label" "end" )) t) + (mapcar #'car latex-section-alist) + '("begin" "label" "end" )) + t) "\\>\\|\\\\\\(" (regexp-opt '("item" "bibitem" "newline" "noindent" "newpage" "footnote" "marginpar" "parbox" "caption")) "\\|\\$\\$\\|[a-z]*\\(space\\|skip\\|page[a-z]*\\)" "\\>\\)[ \t]*\\($\\|%\\)\\)")) - (setq-local imenu-create-index-function 'latex-imenu-create-index) + (setq-local imenu-create-index-function #'latex-imenu-create-index) (setq-local tex-face-alist tex-latex-face-alist) - (add-hook 'fill-nobreak-predicate 'latex-fill-nobreak-predicate nil t) - (setq-local indent-line-function 'latex-indent) + (add-hook 'fill-nobreak-predicate #'latex-fill-nobreak-predicate nil t) + (setq-local indent-line-function #'latex-indent) (setq-local fill-indent-according-to-mode t) (add-hook 'completion-at-point-functions - 'latex-complete-data nil 'local) + #'latex-complete-data nil 'local) (setq-local outline-regexp latex-outline-regexp) - (setq-local outline-level 'latex-outline-level) - (setq-local forward-sexp-function 'latex-forward-sexp) + (setq-local outline-level #'latex-outline-level) + (setq-local forward-sexp-function #'latex-forward-sexp) (setq-local skeleton-end-hook nil)) ;;;###autoload @@ -1205,6 +1206,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (defvar tildify-space-string) (defvar tildify-foreach-region-function) +(declare-function tildify-foreach-ignore-environments + "tildify" (pairs callback _beg end)) (defvar tex--prettify-symbols-alist) (defun tex-common-initialization () @@ -1216,7 +1219,7 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook ;; rather than using regex-based filtering. (setq-local tildify-foreach-region-function (apply-partially - 'tildify-foreach-ignore-environments + #'tildify-foreach-ignore-environments `(("\\\\\\\\" . "") ; do not remove this (,(eval-when-compile (concat "\\\\begin{\\(" @@ -1308,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. ;; @@ -1545,8 +1549,7 @@ a skeleton (see `skeleton-insert').") Puts point on a blank line between them." (let ((choice (completing-read (format "LaTeX block name [%s]: " latex-block-default) - (append latex-block-names - latex-standard-block-names) + (latex-complete-envnames) nil nil nil nil latex-block-default))) (setq latex-block-default choice) (unless (or (member choice latex-standard-block-names) @@ -1603,17 +1606,32 @@ Puts point on a blank line between them." (complete-with-action action keys key pred))))) (defun latex-complete-envnames () - (append latex-block-names latex-standard-block-names)) + (completion-table-in-turn + (append latex-block-names latex-standard-block-names) + (completion-table-dynamic + (lambda (str) + (with-current-buffer (if (and (minibufferp) (minibuffer-selected-window)) + (window-buffer (minibuffer-selected-window)) + (current-buffer)) + (save-excursion + (let ((comps '()) + (pos (point))) + (goto-char (point-min)) + (while (re-search-forward (concat "\\\\begin{\\(" str "[^}\n ]*\\)") + nil t) + (unless (and (<= (match-beginning 0) pos) + (>= (match-end 0) pos)) + (push (match-string 1) comps))) + comps))))))) (defun latex-complete-refkeys () (when (boundp 'reftex-docstruct-symbol) (symbol-value reftex-docstruct-symbol))) (defvar latex-complete-alist - ;; TODO: Add \begin, \end, \ref, ... - '(("\\`\\\\\\(short\\)?cite\\'" . latex-complete-bibtex-keys) - ("\\`\\\\\\(begin\\|end\\)\\'" . latex-complete-envnames) - ("\\`\\\\[vf]?ref\\'" . latex-complete-refkeys))) + `(("\\`\\\\\\(short\\)?cite\\'" . ,#'latex-complete-bibtex-keys) + ("\\`\\\\\\(begin\\|end\\)\\'" . ,#'latex-complete-envnames) + ("\\`\\\\[vf]?ref\\'" . ,#'latex-complete-refkeys))) (defun latex-complete-data () "Get completion-data at point." @@ -2095,13 +2113,17 @@ If NOT-ALL is non-nil, save the `.dvi' file." :group 'tex) (defvar tex-compile-commands - '(((concat "pdf" tex-command - " " (if (< 0 (length tex-start-commands)) - (shell-quote-argument tex-start-commands)) " %f") - t "%r.pdf") + `(,@(mapcar (lambda (prefix) + `((concat ,prefix tex-command + " " (if (< 0 (length tex-start-commands)) + (shell-quote-argument tex-start-commands)) + " %f") + t "%r.pdf")) + '("pdf" "xe" "lua")) ((concat tex-command " " (if (< 0 (length tex-start-commands)) - (shell-quote-argument tex-start-commands)) " %f") + (shell-quote-argument tex-start-commands)) + " %f") t "%r.dvi") ("xdvi %r &" "%r.dvi") ("\\doc-view \"%r.pdf\"" "%r.pdf") @@ -2196,7 +2218,7 @@ of the current buffer." (defun tex-summarize-command (cmd) (if (not (stringp cmd)) "" - (mapconcat 'identity + (mapconcat #'identity (mapcar (lambda (s) (car (split-string s))) (split-string cmd "\\s-*\\(?:;\\|&&\\)\\s-*")) "&"))) @@ -2378,7 +2400,8 @@ Only applies the FSPEC to the args part of FORMAT." ;; Substitute and return. (if (and hist-cmd (string-match (concat "[' \t\"]" (format-spec "%r" fspec) - "\\([;&' \t\"]\\|\\'\\)") hist-cmd)) + "\\([;&' \t\"]\\|\\'\\)") + hist-cmd)) ;; The history command was already applied to the same file, ;; so just reuse it. hist-cmd @@ -2763,7 +2786,7 @@ Runs the shell command defined by `tex-show-queue-command'." (defvar tex-indent-item-re "\\\\\\(bib\\)?item\\>") (defvar latex-noindent-environments '("document")) (put 'latex-noindent-environments 'safe-local-variable - (lambda (x) (null (delq t (mapcar 'stringp x))))) + (lambda (x) (null (delq t (mapcar #'stringp x))))) (defvar tex-latex-indent-syntax-table (let ((st (make-syntax-table tex-mode-syntax-table))) @@ -2983,7 +3006,7 @@ There might be text before point." ("\\sigma" . ?σ) ("\\tau" . ?τ) ("\\upsilon" . ?υ) - ("\\phi" . ?φ) + ("\\phi" . ?ϕ) ("\\chi" . ?χ) ("\\psi" . ?ψ) ("\\omega" . ?ω) @@ -3372,10 +3395,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/texinfo.el b/lisp/textmodes/texinfo.el index c22f531440d..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. @@ -368,8 +366,10 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") ;; their arguments frequently include a @@, and we don't want that ;; to overwrite the normal fontification of the argument. ("@\\(file\\|email\\){\\([^}]+\\)" 2 font-lock-string-face keep) - ("@\\(samp\\|code\\|var\\|math\\|env\\|command\\|option\\){\\([^}]+\\)" + ("@\\(samp\\|code\\|var\\|env\\|command\\|option\\){\\([^}]+\\)" 2 font-lock-variable-name-face keep) + ;; @math allows nested braces like @math{2^{12}} + ("@math{\\([^{}]*{?[^{}]*}?[^{}]*\\)}" 1 font-lock-variable-name-face) ("@\\(cite\\|x?ref\\|pxref\\|dfn\\|inforef\\){\\([^}]+\\)" 2 font-lock-constant-face) ("@\\(anchor\\){\\([^}]+\\)" 2 font-lock-type-face) @@ -378,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) 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-stamp.el b/lisp/time-stamp.el index d4cddc92f94..c053ea6e924 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -43,10 +43,7 @@ (defcustom time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %u" "Format of the string inserted by \\[time-stamp]. -The value may be a string or a list. Lists are supported only for -backward compatibility; see variable `time-stamp-old-format-warn'. - -A string is used verbatim except for character sequences beginning +This is a string, used verbatim except for character sequences beginning with %, as follows. The values of non-numeric formatted items depend on the locale setting recorded in `system-time-locale' and `locale-coding-system'. The examples here are for the default @@ -107,17 +104,6 @@ otherwise would have been updated." :group 'time-stamp :version "19.29") -(defcustom time-stamp-old-format-warn 'ask - "Action if `time-stamp-format' is an old-style list. -If `error', the format is not used. If `ask', the user is queried about -using the time-stamp-format. If `warn', a warning is displayed. -If nil, no notification is given." - :type '(choice (const :tag "Don't use the format" error) - (const ask) - (const warn) - (const :tag "No notification" nil)) - :group 'time-stamp) - (defcustom time-stamp-time-zone nil "The time zone to be used by \\[time-stamp]. Its format is that of the ZONE argument of the `format-time-string' function." @@ -420,26 +406,14 @@ With ARG, turn time stamping on if and only if arg is positive." "Generate the new string to be inserted by \\[time-stamp]. Optionally use format TS-FORMAT instead of `time-stamp-format' to format the string." - (or ts-format - (setq ts-format time-stamp-format)) - (if (stringp ts-format) - (time-stamp--format (time-stamp-string-preprocess ts-format) nil) - ;; handle version 1 compatibility - (cond ((or (eq time-stamp-old-format-warn 'error) - (and (eq time-stamp-old-format-warn 'ask) - (not (y-or-n-p "Use non-string time-stamp-format? ")))) - (message "Warning: no time-stamp: time-stamp-format not a string") - (sit-for 1) - nil) - (t - (cond ((eq time-stamp-old-format-warn 'warn) - (message "Obsolescent time-stamp-format type; should be string") - (sit-for 1))) - (time-stamp-fconcat ts-format " "))))) + (if (stringp (or ts-format (setq ts-format time-stamp-format))) + (time-stamp--format (time-stamp-string-preprocess ts-format) nil))) + (defconst time-stamp-no-file "(no file)" "String to use when the buffer is not associated with a file.") +;;; FIXME This comment was written in 1996! ;;; time-stamp is transitioning to using the new, expanded capabilities ;;; of format-time-string. During the process, this function implements ;;; intermediate, compatible formats and complains about old, soon to @@ -676,28 +650,6 @@ otherwise the value of the function `system-name'." mail-host-address) (system-name))) -;;; the rest of this file is for version 1 compatibility - -(defun time-stamp-fconcat (list sep) - "Similar to (mapconcat \\='funcall LIST SEP) but LIST allows literals. -If an element of LIST is a symbol, it is funcalled to get the string to use; -the separator SEP is used between two strings obtained by funcalling a -symbol. Otherwise the element itself is inserted; no separator is used -around literals." - (let ((return-string "") - (insert-sep-p nil)) - (while list - (cond ((symbolp (car list)) - (if insert-sep-p - (setq return-string (concat return-string sep))) - (setq return-string (concat return-string (funcall (car list)))) - (setq insert-sep-p t)) - (t - (setq return-string (concat return-string (car list))) - (setq insert-sep-p nil))) - (setq list (cdr list))) - return-string)) - (provide 'time-stamp) ;;; time-stamp.el ends here diff --git a/lisp/time.el b/lisp/time.el index c9f2df38244..b507fe9df02 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -314,7 +314,7 @@ For example: (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 () @@ -535,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/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-cookie.el b/lisp/url/url-cookie.el index 4c7366adc8e..6848230c28f 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -353,6 +353,24 @@ to run the `url-cookie-setup-save-timer' function manually." url-cookie-save-interval #'url-cookie-write-file)))) +(defun url-cookie-delete-cookies (&optional regexp keep) + "Delete all cookies from the cookie store where the domain matches REGEXP. +If REGEXP is nil, all cookies are deleted. If KEEP is non-nil, +instead delete all cookies that do not match REGEXP." + (dolist (variable '(url-cookie-secure-storage url-cookie-storage)) + (let ((cookies (symbol-value variable))) + (dolist (elem cookies) + (when (or (and (null keep) + (or (null regexp) + (string-match regexp (car elem)))) + (and keep + regexp + (not (string-match regexp (car elem))))) + (setq cookies (delq elem cookies)))) + (set variable cookies))) + (setq url-cookies-changed-since-last-save t) + (url-cookie-write-file)) + ;;; Mode for listing and editing cookies. (defun url-cookie-list () 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-gw.el b/lisp/url/url-gw.el index 460ee0dd426..d898368cf9e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -246,8 +246,8 @@ overriding the value of `url-gateway-method'." :type gw-method ;; Use non-blocking socket if we can. :nowait (featurep 'make-network-process - '(:nowait t)))) - (`socks + '(:nowait t)))) + (`socks (socks-open-network-stream name buffer host service)) (`telnet (url-open-telnet name buffer host service)) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 717651df544..0fada8d49d7 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -262,14 +262,16 @@ 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))) - (mm-save-part-to-file handle newname) + (let ((mm-attachment-file-modes (default-file-modes))) + (mm-save-part-to-file handle newname)) (kill-buffer buffer) (mm-destroy-parts handle))) (put 'copy-file 'url-file-handlers 'url-copy-file) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index e0e080e76af..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. @@ -26,6 +26,8 @@ ;;; Code: (require 'cl-lib) +(require 'puny) +(require 'nsm) (eval-when-compile (require 'subr-x)) @@ -126,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") @@ -135,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. @@ -196,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. @@ -211,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." @@ -296,8 +329,9 @@ request.") (url-scheme-get-property (url-type url-http-target-url) 'default-port)) (format - "Host: %s:%d\r\n" host (url-port url-http-target-url)) - (format "Host: %s\r\n" host)) + "Host: %s:%d\r\n" (puny-encode-domain host) + (url-port url-http-target-url)) + (format "Host: %s\r\n" (puny-encode-domain host))) ;; Who its from (if url-personal-mail-address (concat @@ -475,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. @@ -588,15 +623,7 @@ should be shown to the user." ;; We do not support agent-driven negotiation, so we just ;; redirect to the preferred URI if one is provided. nil) - ((or `moved-permanently `found `temporary-redirect) ; 301 302 307 - ;; If the 301|302 status code is received in response to a - ;; request other than GET or HEAD, the user agent MUST NOT - ;; automatically redirect the request unless it can be - ;; confirmed by the user, since this might change the - ;; conditions under which the request was issued. - (unless (member url-http-method '("HEAD" "GET")) - (setq redirect-uri nil))) - (`see-other ; 303 + (`see-other ; 303 ;; The response to the request can be found under a different ;; URI and SHOULD be retrieved using a GET method on that ;; resource. @@ -905,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) @@ -931,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 @@ -1061,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)" @@ -1069,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 @@ -1210,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 @@ -1281,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. @@ -1299,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 @@ -1365,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 @@ -1380,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) @@ -1464,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-queue.el b/lisp/url/url-queue.el index 0ff4ad1556c..8972d0b056c 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -1,4 +1,4 @@ -;;; url-queue.el --- Fetching web pages in parallel +;;; url-queue.el --- Fetching web pages in parallel -*- lexical-binding: t -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -47,6 +47,7 @@ ;;; Internal variables. (defvar url-queue nil) +(defvar url-queue-progress-timer nil) (cl-defstruct url-queue url callback cbargs silentp @@ -90,7 +91,13 @@ The variable `url-queue-timeout' sets a timeout." (when (and waiting (< running url-queue-parallel-processes)) (setf (url-queue-pre-triggered waiting) t) - (run-with-idle-timer 0.01 nil 'url-queue-run-queue)))) + ;; We start fetching from this idle timer... + (run-with-idle-timer 0.01 nil #'url-queue-run-queue) + ;; And then we set up a separate timer to ensure progress when a + ;; web server is unresponsive. + (unless url-queue-progress-timer + (setq url-queue-progress-timer + (run-with-idle-timer 1 1 #'url-queue-check-progress)))))) (defun url-queue-run-queue () (url-queue-prune-old-entries) @@ -107,6 +114,13 @@ The variable `url-queue-timeout' sets a timeout." (setf (url-queue-start-time waiting) (float-time)) (url-queue-start-retrieve waiting)))) +(defun url-queue-check-progress () + (when url-queue-progress-timer + (if url-queue + (url-queue-run-queue) + (cancel-timer url-queue-progress-timer) + (setq url-queue-progress-timer nil)))) + (defun url-queue-callback-function (status job) (setq url-queue (delq job url-queue)) (when (and (eq (car status) :error) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 1ae2213eee6..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. @@ -468,7 +468,7 @@ should return it unchanged." (and host (not (string-match "\\`\\[.*\\]\\'" host)) (setf (url-host obj) - (url-hexify-string host url-host-allowed-chars))) + (decode-coding-string (url-host obj) 'utf-8))) (if path (setq path (url-hexify-string path url-path-allowed-chars))) 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 91adada5e85..6d710e02d63 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -221,17 +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. -If SILENT is non-nil, don't display progress reports and similar messages. -If INHIBIT-COOKIES is non-nil, cookies will neither be stored nor sent -to the server." + +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) @@ -253,7 +256,11 @@ to the server." ;; 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) @@ -284,7 +291,7 @@ to the server." ;; `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 fa02a5a1f5e..ba710b2f4f9 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -171,56 +171,55 @@ Note: The search is conducted only within 10%, at the beginning of the file." :type '(repeat regexp) :group 'change-log) +(defcustom change-log-directory-files '(".bzr" ".git" ".hg" ".svn") + "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 "26.1" + :type '(repeat file) + :group 'change-log) + (defface change-log-date '((t (:inherit font-lock-string-face))) "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))) @@ -229,8 +228,6 @@ Note: The search is conducted only within 10%, at the beginning of the 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:+ ]*") @@ -582,25 +579,14 @@ If a string, interpret as the ZONE argument of `format-time-string'.") (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." @@ -690,7 +676,11 @@ If `change-log-default-name' is nil, behave as though it were \"ChangeLog\" If `change-log-default-name' contains a leading directory component, then simply find it in the current directory. Otherwise, search in the current -directory and its successive parents for a file so named. +directory and its successive parents for a file so named. Stop at the first +such file that exists (or has a buffer visiting it), or the first directory +that contains any of `change-log-directory-files'. If no match is found, +use the current directory. To override the choice of this function, +simply create an empty ChangeLog file first by hand in the desired place. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name. @@ -723,24 +713,27 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." ;; for several related directories. (setq file-name (file-chase-links file-name)) (setq file-name (expand-file-name file-name)) - ;; Move up in the dir hierarchy till we find a change log file. - (let ((file1 file-name) - parent-dir) - (while (and (not (or (get-file-buffer file1) (file-exists-p file1))) - (progn (setq parent-dir - (file-name-directory - (directory-file-name - (file-name-directory file1)))) - ;; Give up if we are already at the root dir. - (not (string= (file-name-directory file1) - parent-dir)))) - ;; Move up to the parent dir and try again. - (setq file1 (expand-file-name - (file-name-nondirectory (change-log-name)) - parent-dir))) - ;; If we found a change log in a parent, use that. - (if (or (get-file-buffer file1) (file-exists-p file1)) - (setq file-name file1))))) + (let* ((cbase (file-name-nondirectory (change-log-name))) + (root + (locate-dominating-file + file-name + (lambda (dir) + (or + (let ((clog (expand-file-name cbase dir))) + (or (get-file-buffer clog) (file-exists-p clog))) + ;; Stop at VCS root? + (and change-log-directory-files + (let ((files change-log-directory-files) + found) + (while + (and + (not + (setq found + (file-exists-p + (expand-file-name (car files) dir)))) + (setq files (cdr files)))) + found))))))) + (if root (setq file-name (expand-file-name cbase root)))))) ;; Make a local variable in this buffer so we needn't search again. (set (make-local-variable 'change-log-default-name) file-name)) file-name) @@ -895,8 +888,10 @@ non-nil, otherwise in local time." "\\(\\s \\|[(),:]\\)") bound t))) ;; Add to the existing item for the same file. - (re-search-forward "^\\s *$\\|^\\s \\*") - (goto-char (match-beginning 0)) + (if (re-search-forward "^\\s *$\\|^\\s \\*" nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)) + (insert "\n")) ;; Delete excess empty lines; make just 2. (while (and (not (eobp)) (looking-at "^\\s *$")) (delete-region (point) (line-beginning-position 2))) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index bada492a31b..75fd420922a 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,26 +551,124 @@ 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 - (when diff-auto-refine-mode - (unless (prog1 diff--auto-refine-data - (setq diff--auto-refine-data - (cons (current-buffer) (point-marker)))) - (run-at-time 0.0 nil - (lambda () - (when diff--auto-refine-data - (let ((buffer (car diff--auto-refine-data)) - (point (cdr diff--auto-refine-data))) - (setq diff--auto-refine-data nil) - (with-local-quit - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (goto-char point) - (diff-refine-hunk)))))))))))) + diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view) (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))) + + ;; We successfully moved to the next/prev hunk/file. Apply the + ;; auto-refinement if needed + (when diff-auto-refine-mode + (unless (prog1 diff--auto-refine-data + (setq diff--auto-refine-data + (cons (current-buffer) (point-marker)))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (goto-char point) + (diff-refine-hunk)))))))))))))) + +;; 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 +679,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. @@ -692,7 +771,7 @@ data such as \"Index: ...\" and such." (setq prevfile nextfile)) (if (and previndex (numberp prevfile) (< previndex prevfile)) (setq prevfile previndex)) - (if (and (numberp prevfile) (<= prevfile start)) + (if (numberp prevfile) (progn (goto-char prevfile) ;; Now skip backward over the leading junk we may have before the @@ -820,7 +899,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 +1764,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 +1775,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 +1883,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 current 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 +1972,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 +2024,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 +2038,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 +2067,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/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-init.el b/lisp/vc/ediff-init.el index b0d5d2fabc4..c96a9684ac8 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -318,7 +318,7 @@ It needs to be killed when we quit the session.") (defsubst ediff-patch-metajob (&optional metajob) (memq (or metajob ediff-metajob-name) '(ediff-multifile-patch))) -;; metajob involving only one group of files, such as multipatch or directory +;; metajob involving only one group of files, such as multi-patch or directory ;; revision (defsubst ediff-one-filegroup-metajob (&optional metajob) (or (ediff-revision-metajob metajob) 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..9f0e1dcf4f7 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 multi-patches the file doesn't exist + ;; because the directory part is wrong; for instance, if the + ;; patch needs 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 failures 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 6781f504894..76223e9f6e4 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 () @@ -1293,7 +1290,8 @@ which see." (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe) (setq ediff-multiframe nil) - (setq window-setup-func 'ediff-setup-windows-plain)) + (setq window-setup-func 'ediff-setup-windows-plain) + (message "ediff is now in 'plain' mode")) ((eq ediff-window-setup-function 'ediff-setup-windows-plain) (if (ediff-in-control-buffer-p) (ediff-kill-bottom-toolbar)) @@ -1301,14 +1299,15 @@ which see." (window-live-p ediff-control-window)) (set-window-dedicated-p ediff-control-window nil)) (setq ediff-multiframe t) - (setq window-setup-func 'ediff-setup-windows-multiframe)) + (setq window-setup-func 'ediff-setup-windows-multiframe) + (message "ediff is now in 'multiframe' mode")) (t (if (and (ediff-buffer-live-p ediff-control-buffer) (window-live-p ediff-control-window)) (set-window-dedicated-p ediff-control-window nil)) (setq ediff-multiframe t) (setq window-setup-func 'ediff-setup-windows-multiframe)) - ) + (message "ediff is now in 'multiframe' mode")) ;; change default (setq-default ediff-window-setup-function window-setup-func) @@ -1643,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) @@ -1661,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 @@ -2440,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)) @@ -2523,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 @@ -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 71099ab4d6e..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,7 +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)) 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)) @@ -1401,9 +1402,8 @@ patch. If not given, the user is prompted according to the prefix argument." (if arg (prefix-numeric-value arg)) patch-buf)) (ediff-patch-buffer-internal patch-buf - (read-buffer - "Which buffer to patch? " - (ediff-other-buffer patch-buf)))) + (read-buffer "Which buffer to patch? " (ediff-other-buffer patch-buf) + 'require-match))) ;;;###autoload 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 63d50033eec..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)) diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index b9ecc892540..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) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 489ece81bec..1a7decead25 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -67,34 +67,34 @@ (append '("-d" "-b") (if (listp diff-switches) diff-switches (list diff-switches))) "A list of strings specifying switches to be passed to diff. -Used in `smerge-diff-base-mine' and related functions." +Used in `smerge-diff-base-upper' and related functions." :type '(repeat string)) (defcustom smerge-auto-leave t "Non-nil means to leave `smerge-mode' when the last conflict is resolved." :type 'boolean) -(defface smerge-mine +(defface smerge-upper '((((class color) (min-colors 88) (background light)) :background "#ffdddd") (((class color) (min-colors 88) (background dark)) :background "#553333") (((class color)) :foreground "red")) - "Face for your code.") -(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1") -(defvar smerge-mine-face 'smerge-mine) + "Face for the `upper' version of a conflict.") +(define-obsolete-face-alias 'smerge-mine 'smerge-upper "26.1") +(defvar smerge-upper-face 'smerge-upper) -(defface smerge-other +(defface smerge-lower '((((class color) (min-colors 88) (background light)) :background "#ddffdd") (((class color) (min-colors 88) (background dark)) :background "#335533") (((class color)) :foreground "green")) - "Face for the other code.") -(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1") -(defvar smerge-other-face 'smerge-other) + "Face for the `lower' version of a conflict.") +(define-obsolete-face-alias 'smerge-other 'smerge-lower "26.1") +(defvar smerge-lower-face 'smerge-lower) (defface smerge-base '((((class color) (min-colors 88) (background light)) @@ -149,16 +149,18 @@ Used in `smerge-diff-base-mine' and related functions." ("r" . smerge-resolve) ("a" . smerge-keep-all) ("b" . smerge-keep-base) - ("o" . smerge-keep-other) - ("m" . smerge-keep-mine) + ("o" . smerge-keep-lower) ; for the obsolete keep-other + ("l" . smerge-keep-lower) + ("m" . smerge-keep-upper) ; for the obsolete keep-mine + ("u" . smerge-keep-upper) ("E" . smerge-ediff) ("C" . smerge-combine-with-next) ("R" . smerge-refine) ("\C-m" . smerge-keep-current) ("=" . ,(make-sparse-keymap "Diff")) - ("=<" "base-mine" . smerge-diff-base-mine) - ("=>" "base-other" . smerge-diff-base-other) - ("==" "mine-other" . smerge-diff-mine-other)) + ("=<" "base-upper" . smerge-diff-base-upper) + ("=>" "base-lower" . smerge-diff-base-lower) + ("==" "upper-lower" . smerge-diff-upper-lower)) "The base keymap for `smerge-mode'.") (defcustom smerge-command-prefix "\C-c^" @@ -196,19 +198,19 @@ Used in `smerge-diff-base-mine' and related functions." "--" ["Revert to Base" smerge-keep-base :help "Revert to base version" :active (smerge-check 2)] - ["Keep Other" smerge-keep-other :help "Keep `other' version" - :active (smerge-check 3)] - ["Keep Yours" smerge-keep-mine :help "Keep your version" + ["Keep Upper" smerge-keep-upper :help "Keep `upper' version" :active (smerge-check 1)] + ["Keep Lower" smerge-keep-lower :help "Keep `lower' version" + :active (smerge-check 3)] "--" - ["Diff Base/Mine" smerge-diff-base-mine - :help "Diff `base' and `mine' for current conflict" + ["Diff Base/Upper" smerge-diff-base-upper + :help "Diff `base' and `upper' for current conflict" :active (smerge-check 2)] - ["Diff Base/Other" smerge-diff-base-other - :help "Diff `base' and `other' for current conflict" + ["Diff Base/Lower" smerge-diff-base-lower + :help "Diff `base' and `lower' for current conflict" :active (smerge-check 2)] - ["Diff Mine/Other" smerge-diff-mine-other - :help "Diff `mine' and `other' for current conflict" + ["Diff Upper/Lower" smerge-diff-upper-lower + :help "Diff `upper' and `lower' for current conflict" :active (smerge-check 1)] "--" ["Invoke Ediff" smerge-ediff @@ -223,7 +225,7 @@ Used in `smerge-diff-base-mine' and related functions." )) (easy-menu-define smerge-context-menu nil - "Context menu for mine area in `smerge-mode'." + "Context menu for upper area in `smerge-mode'." '(nil ["Keep Current" smerge-keep-current :help "Use current (at point) version"] ["Kill Current" smerge-kill-current :help "Remove current (at point) version"] @@ -234,9 +236,9 @@ Used in `smerge-diff-base-mine' and related functions." (defconst smerge-font-lock-keywords '((smerge-find-conflict - (1 smerge-mine-face prepend t) + (1 smerge-upper-face prepend t) (2 smerge-base-face prepend t) - (3 smerge-other-face prepend t) + (3 smerge-lower-face prepend t) ;; FIXME: `keep' doesn't work right with syntactic fontification. (0 smerge-markers-face keep) (4 nil t t) @@ -246,7 +248,7 @@ Used in `smerge-diff-base-mine' and related functions." (defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n") (defconst smerge-end-re "^>>>>>>> \\(.*\\)\n") (defconst smerge-base-re "^||||||| \\(.*\\)\n") -(defconst smerge-other-re "^=======\n") +(defconst smerge-lower-re "^=======\n") (defvar smerge-conflict-style nil "Keep track of which style of conflict is in use. @@ -267,7 +269,7 @@ Can be nil if the style is undecided, or else: (if diff-auto-refine-mode (condition-case nil (smerge-refine) (error nil)))) -(defconst smerge-match-names ["conflict" "mine" "base" "other"]) +(defconst smerge-match-names ["conflict" "upper" "base" "lower"]) (defun smerge-ensure-match (n) (unless (match-end n) @@ -570,7 +572,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (zerop (call-process diff-command nil buf nil "-bc" b m))) (set-match-data md) (smerge-keep-n 3)) - ;; Try "diff -b BASE MINE | patch OTHER". + ;; Try "diff -b BASE UPPER | patch LOWER". ((when (and (not safe) m2e b ;; If the BASE is empty, this would just concatenate ;; the two, which is rarely right. @@ -585,7 +587,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (narrow-to-region m0b m0e) (smerge-remove-props m0b m0e) (insert-file-contents o nil nil nil t))) - ;; Try "diff -b BASE OTHER | patch MINE". + ;; Try "diff -b BASE LOWER | patch UPPER". ((when (and (not safe) m2e b ;; If the BASE is empty, this would just concatenate ;; the two, which is rarely right. @@ -685,22 +687,40 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (smerge-keep-n 2) (smerge-auto-leave)) -(defun smerge-keep-other () - "Use \"other\" version." +(defun smerge-keep-lower () + "Keep the \"lower\" version of a merge conflict. +In a conflict that looks like: + <<<<<<< + UUU + ======= + LLL + >>>>>>> +this keeps \"LLL\"." (interactive) (smerge-match-conflict) ;;(smerge-ensure-match 3) (smerge-keep-n 3) (smerge-auto-leave)) -(defun smerge-keep-mine () - "Keep your version." +(define-obsolete-function-alias 'smerge-keep-other 'smerge-keep-lower "26.1") + +(defun smerge-keep-upper () + "Keep the \"upper\" version of a merge conflict. +In a conflict that looks like: + <<<<<<< + UUU + ======= + LLL + >>>>>>> +this keeps \"UUU\"." (interactive) (smerge-match-conflict) ;;(smerge-ensure-match 1) (smerge-keep-n 1) (smerge-auto-leave)) +(define-obsolete-function-alias 'smerge-keep-mine 'smerge-keep-upper "26.1") + (defun smerge-get-current () (let ((i 3)) (while (or (not (match-end i)) @@ -734,28 +754,37 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (smerge-keep-n (car left)) (smerge-auto-leave)))))) -(defun smerge-diff-base-mine () - "Diff `base' and `mine' version in current conflict region." +(defun smerge-diff-base-upper () + "Diff `base' and `upper' version in current conflict region." (interactive) (smerge-diff 2 1)) -(defun smerge-diff-base-other () - "Diff `base' and `other' version in current conflict region." +(define-obsolete-function-alias 'smerge-diff-base-mine + 'smerge-diff-base-upper "26.1") + +(defun smerge-diff-base-lower () + "Diff `base' and `lower' version in current conflict region." (interactive) (smerge-diff 2 3)) -(defun smerge-diff-mine-other () - "Diff `mine' and `other' version in current conflict region." +(define-obsolete-function-alias 'smerge-diff-base-other + 'smerge-diff-base-lower "26.1") + +(defun smerge-diff-upper-lower () + "Diff `upper' and `lower' version in current conflict region." (interactive) (smerge-diff 1 3)) +(define-obsolete-function-alias 'smerge-diff-mine-other + 'smerge-diff-upper-lower "26.1") + (defun smerge-match-conflict () "Get info about the conflict. Puts the info in the `match-data'. The submatches contain: 0: the whole conflict. - 1: your code. - 2: the base code. - 3: other code. + 1: upper version of the code. + 2: base version of the code. + 3: lower version of the code. An error is raised if not inside a conflict." (save-excursion (condition-case nil @@ -765,26 +794,26 @@ An error is raised if not inside a conflict." (_ (re-search-backward smerge-begin-re)) (start (match-beginning 0)) - (mine-start (match-end 0)) + (upper-start (match-end 0)) (filename (or (match-string 1) "")) (_ (re-search-forward smerge-end-re)) (_ (cl-assert (< orig-point (match-end 0)))) - (other-end (match-beginning 0)) + (lower-end (match-beginning 0)) (end (match-end 0)) - (_ (re-search-backward smerge-other-re start)) + (_ (re-search-backward smerge-lower-re start)) - (mine-end (match-beginning 0)) - (other-start (match-end 0)) + (upper-end (match-beginning 0)) + (lower-start (match-end 0)) base-start base-end) ;; handle the various conflict styles (cond ((save-excursion - (goto-char mine-start) + (goto-char upper-start) (re-search-forward smerge-begin-re end t)) ;; There's a nested conflict and we're after the beginning ;; of the outer one but before the beginning of the inner one. @@ -797,8 +826,8 @@ An error is raised if not inside a conflict." ((re-search-backward smerge-base-re start t) ;; a 3-parts conflict (set (make-local-variable 'smerge-conflict-style) 'diff3-A) - (setq base-end mine-end) - (setq mine-end (match-beginning 0)) + (setq base-end upper-end) + (setq upper-end (match-beginning 0)) (setq base-start (match-end 0))) ((string= filename (file-name-nondirectory @@ -811,17 +840,17 @@ An error is raised if not inside a conflict." (equal filename "ANCESTOR") (string-match "\\`[.0-9]+\\'" filename))) ;; a same-diff conflict - (setq base-start mine-start) - (setq base-end mine-end) - (setq mine-start other-start) - (setq mine-end other-end))) + (setq base-start upper-start) + (setq base-end upper-end) + (setq upper-start lower-start) + (setq upper-end lower-end))) (store-match-data (list start end - mine-start mine-end + upper-start upper-end base-start base-end - other-start other-end + lower-start lower-end (when base-start (1- base-start)) base-start - (1- other-start) other-start)) + (1- lower-start) lower-start)) t) (search-failed (user-error "Point not in conflict region"))))) @@ -1133,10 +1162,10 @@ repeating the command will highlight other two parts." '((smerge . refine) (face . smerge-refined-added)))))) (defun smerge-swap () - "Swap the \"Mine\" and the \"Other\" chunks. + "Swap the \"Upper\" and the \"Lower\" chunks. Can be used before things like `smerge-keep-all' or `smerge-resolve' where the ordering can have some subtle influence on the result, such as preferring the -spacing of the \"Other\" chunk." +spacing of the \"Lower\" chunk." (interactive) (smerge-match-conflict) (goto-char (match-beginning 3)) @@ -1205,9 +1234,9 @@ spacing of the \"Other\" chunk." default))) ;;;###autoload -(defun smerge-ediff (&optional name-mine name-other name-base) +(defun smerge-ediff (&optional name-upper name-lower name-base) "Invoke ediff to resolve the conflicts. -NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the +NAME-UPPER, NAME-LOWER, and NAME-BASE, if non-nil, are used for the buffer names." (interactive) (let* ((buf (current-buffer)) @@ -1215,18 +1244,18 @@ buffer names." ;;(ediff-default-variant 'default-B) (config (current-window-configuration)) (filename (file-name-nondirectory (or buffer-file-name "-"))) - (mine (generate-new-buffer - (or name-mine + (upper (generate-new-buffer + (or name-upper (concat "*" filename " " - (smerge--get-marker smerge-begin-re "MINE") + (smerge--get-marker smerge-begin-re "UPPER") "*")))) - (other (generate-new-buffer - (or name-other + (lower (generate-new-buffer + (or name-lower (concat "*" filename " " - (smerge--get-marker smerge-end-re "OTHER") + (smerge--get-marker smerge-end-re "LOWER") "*")))) base) - (with-current-buffer mine + (with-current-buffer upper (buffer-disable-undo) (insert-buffer-substring buf) (goto-char (point-min)) @@ -1237,7 +1266,7 @@ buffer names." (set-buffer-modified-p nil) (funcall mode)) - (with-current-buffer other + (with-current-buffer lower (buffer-disable-undo) (insert-buffer-substring buf) (goto-char (point-min)) @@ -1269,9 +1298,9 @@ buffer names." ;; Fire up ediff. (set-buffer (if base - (ediff-merge-buffers-with-ancestor mine other base) + (ediff-merge-buffers-with-ancestor upper lower base) ;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name) - (ediff-merge-buffers mine other))) + (ediff-merge-buffers upper lower))) ;; nil 'ediff-merge-revisions buffer-file-name))) ;; Ediff is now set up, and we are in the control buffer. @@ -1313,21 +1342,21 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict." (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4) (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=))) (goto-char pt1) (beginning-of-line) - (insert ">>>>>>> OTHER\n") + (insert ">>>>>>> LOWER\n") (goto-char pt2) (beginning-of-line) (insert "=======\n") (goto-char pt3) (beginning-of-line) (when pt4 (insert "||||||| BASE\n") (goto-char pt4) (beginning-of-line)) - (insert "<<<<<<< MINE\n")) + (insert "<<<<<<< UPPER\n")) (if smerge-mode nil (smerge-mode 1)) (smerge-refine)) (defconst smerge-parsep-re (concat smerge-begin-re "\\|" smerge-end-re "\\|" - smerge-base-re "\\|" smerge-other-re "\\|")) + smerge-base-re "\\|" smerge-lower-re "\\|")) ;;;###autoload (define-minor-mode smerge-mode 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 3cfe8ee56a2..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) 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 eba5be9cbec..72bc6b55505 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -704,8 +704,10 @@ It is based on `log-edit-mode', and has Git-specific extensions.") ;; 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. - (if (eq system-type 'windows-nt) (make-temp-file "git-msg")))) + ;; 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))))) @@ -790,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) @@ -881,6 +888,11 @@ 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'. @@ -901,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" @@ -1005,7 +1023,9 @@ or BRANCH^ (where \"^\" can be repeated)." (goto-char (point-min)) (unless (eobp) ;; Indent the expanded log entry. - (indent-region (point-min) (point-max) 2) + (while (re-search-forward "^ " nil t) + (replace-match "") + (forward-line)) (buffer-string)))) (defun vc-git-region-history (file buffer lfrom lto) @@ -1084,6 +1104,13 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (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") @@ -1091,6 +1118,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." "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")) @@ -1129,6 +1157,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." 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) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2d8bab70598..29f8df04698 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -48,7 +48,7 @@ ;; - dir-printer (fileinfo) OK ;; * working-revision (file) OK ;; * checkout-model (files) OK -;; - mode-line-string (file) NOT NEEDED +;; - mode-line-string (file) OK ;; STATE-CHANGING FUNCTIONS ;; * register (files &optional rev comment) OK ;; * create-repo () OK @@ -106,6 +106,8 @@ (require 'vc) (require 'vc-dir)) +(declare-function vc-compilation-mode "vc-dispatcher" (backend)) + ;;; Customization options (defgroup vc-hg nil @@ -197,6 +199,11 @@ highlighting the Log View buffer." (defun vc-hg-state (file) "Hg-specific version of `vc-state'." + (let ((state (vc-hg-state-fast file))) + (if (eq state 'unsupported) (vc-hg-state-slow file) state))) + +(defun vc-hg-state-slow (file) + "Determine status of FILE by running hg." (setq file (expand-file-name file)) (let* ((status nil) @@ -245,6 +252,130 @@ highlighting the Log View buffer." "parent" "--template" "{rev}"))) "0")) +(defcustom vc-hg-symbolic-revision-styles + '(builtin-active-bookmark + "{if(bookmarks,sub(' ',',',bookmarks),if(phabdiff,phabdiff,shortest(node,6)))}") + "List of ways to present versions symbolically. The version +that we use is the first one that successfully produces a +non-empty string. + +Each entry in the list can be either: + +- The symbol `builtin-active-bookmark', which indicates that we +should use the active bookmark if one exists. A template can +supply this information as well, but `builtin-active-bookmark' is +handled entirely inside Emacs and so is more efficient than using +the generic Mercurial mechanism. + +- A string giving the Mercurial template to supply to \"hg +parent\". \"hg help template\" may be useful reading. + +- A function to call; it should accept two arguments (a revision +and an optional path to which to limit history) and produce a +string. The function is called with `default-directory' set to +within the repository. + +If no list entry produces a useful revision, return `nil'." + :type '(repeat (choice + (const :tag "Active bookmark" 'bookmark) + (string :tag "Hg template") + (function :tag "Custom"))) + :version "26.1" + :group 'vc-hg) + +(defcustom vc-hg-use-file-version-for-mode-line-version nil + "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 "26.1" + :group 'vc-hg) + +(defun vc-hg--active-bookmark-internal (rev) + (when (equal rev ".") + (let* ((current-bookmarks-file ".hg/bookmarks.current")) + (when (file-exists-p current-bookmarks-file) + (ignore-errors + (with-temp-buffer + (insert-file-contents current-bookmarks-file) + (buffer-substring-no-properties + (point-min) (point-max)))))))) + +(defun vc-hg--run-log (template rev path) + (ignore-errors + (with-output-to-string + (if path + (vc-hg-command + standard-output 0 nil + "log" "-f" "-l1" "--template" template path) + (vc-hg-command + standard-output 0 nil + "log" "-r" rev "-l1" "--template" template))))) + +(defun vc-hg--symbolic-revision (rev &optional path) + "Make a Mercurial revision human-readable. +REV is a Mercurial revision. `default-directory' is assumed to +be in the repository root of interest. PATH, if set, is a +specific file to query." + (let ((symbolic-revision nil) + (styles vc-hg-symbolic-revision-styles)) + (while (and (not symbolic-revision) styles) + (let ((style (pop styles))) + (setf symbolic-revision + (cond ((and (null path) (eq style 'builtin-active-bookmark)) + (vc-hg--active-bookmark-internal rev)) + ((stringp style) + (vc-hg--run-log style rev path)) + ((functionp style) + (funcall style rev path)))))) + symbolic-revision)) + +(defun vc-hg-mode-line-string (file) + "Hg-specific version of `vc-mode-line-string'." + (let* ((backend-name "Hg") + (truename (file-truename file)) + (state (vc-state truename)) + (state-echo nil) + (face nil) + (rev (and state + (let ((default-directory + (expand-file-name (vc-hg-root truename)))) + (vc-hg--symbolic-revision + "." + (and vc-hg-use-file-version-for-mode-line-version + truename))))) + (rev (or rev "???"))) + (propertize + (cond ((or (eq state 'up-to-date) + (eq state 'needs-update)) + (setq state-echo "Up to date file") + (setq face 'vc-up-to-date-state) + (concat backend-name "-" rev)) + ((eq state 'added) + (setq state-echo "Locally added file") + (setq face 'vc-locally-added-state) + (concat backend-name "@" rev)) + ((eq state 'conflict) + (setq state-echo "File contains conflicts after the last merge") + (setq face 'vc-conflict-state) + (concat backend-name "!" rev)) + ((eq state 'removed) + (setq state-echo "File removed from the VC system") + (setq face 'vc-removed-state) + (concat backend-name "!" rev)) + ((eq state 'missing) + (setq state-echo "File tracked by the VC system, but missing from the file system") + (setq face 'vc-missing-state) + (concat backend-name "?" rev)) + (t + (setq state-echo "Locally modified file") + (setq face 'vc-edited-state) + (concat backend-name ":" rev))) + 'face face + 'help-echo (concat state-echo " under the " backend-name + " version control system")))) + ;;; History functions (defcustom vc-hg-log-switches nil @@ -435,6 +566,488 @@ Optional arg REVISION is a revision to annotate from." ;; TODO: update *vc-change-log* buffer so can see @ if --graph )) +;;; Native data structure reading + +(defcustom vc-hg-parse-hg-data-structures t + "If true, try directly parsing Mercurial data structures +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 "26.1" + :group 'vc-hg) + +(defsubst vc-hg--read-u8 () + "Read and advance over an unsigned byte. +Return a fixnum." + (prog1 (char-after) + (forward-char))) + +(defsubst vc-hg--read-u32-be () + "Read and advance over a big-endian unsigned 32-bit integer. +Return a fixnum; on overflow, result is undefined." + ;; Because elisp bytecode has an instruction for multiply and + ;; doesn't have one for lsh, it's somewhat counter-intuitively + ;; faster to multiply than to shift. + (+ (* (vc-hg--read-u8) (* 256 256 256)) + (* (vc-hg--read-u8) (* 256 256)) + (* (vc-hg--read-u8) 256) + (identity (vc-hg--read-u8)))) + +(defun vc-hg--raw-dirstate-search (dirstate fname) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally dirstate) + (let* ((result nil) + (flen (length fname)) + (case-fold-search nil) + (inhibit-changing-match-data t) + ;; Find a conservative bound for the loop below by using + ;; Boyer-Moore on the raw dirstate without parsing it; we + ;; know we can't possibly find fname _after_ the last place + ;; it appears, so we can bail out early if we try to parse + ;; past it, which especially helps when the file we're + ;; trying to find isn't in dirstate at all. There's no way + ;; to similarly bound the starting search position, since + ;; the file format is such that we need to parse it from + ;; the beginning to find record boundaries. + (search-limit + (progn + (goto-char (point-max)) + (or (search-backward fname (+ (point-min) 40) t) + (point-min))))) + ;; 40 is just after the header, which contains the working + ;; directory parents + (goto-char (+ (point-min) 40)) + ;; Iterate over all dirstate entries; we might run this loop + ;; hundreds of thousands of times, so performance is important + ;; here + (while (< (point) search-limit) + ;; 1+4*4 is the length of the dirstate item header, which we + ;; spell as a literal for performance, since the elisp + ;; compiler lacks constant propagation + (forward-char (1+ (* 3 4))) + (let ((this-flen (vc-hg--read-u32-be))) + (if (and (or (eq this-flen flen) + (and (> this-flen flen) + (eq (char-after (+ (point) flen)) 0))) + (search-forward fname (+ (point) flen) t)) + (progn + (backward-char (+ flen (1+ (* 4 4)))) + (setf result + (list (vc-hg--read-u8) ; status + (vc-hg--read-u32-be) ; mode + (vc-hg--read-u32-be) ; size (of file) + (vc-hg--read-u32-be) ; mtime + )) + (goto-char (point-max))) + (forward-char this-flen)))) + result))) + +(define-error 'vc-hg-unsupported-syntax "unsupported hgignore syntax") + +(defconst vc-hg--pcre-c-escapes + '((?a . ?\a) + (?b . ?\b) + (?f . ?\f) + (?n . ?\n) + (?r . ?\r) + (?t . ?\t) + (?n . ?\n) + (?r . ?\r) + (?t . ?\t) + (?v . ?\v))) + +(defconst vc-hg--pcre-metacharacters + '(?. ?^ ?$ ?* ?+ ?? ?{ ?\\ ?\[ ?\| ?\()) + +(defconst vc-hg--elisp-metacharacters + '(?. ?* ?+ ?? ?\[ ?$ ?\\)) + +(defun vc-hg--escape-for-pcre (c) + (if (memq c vc-hg--pcre-metacharacters) + (string ?\\ c) + c)) + +(defun vc-hg--parts-to-string (parts) + "Build a string from list PARTS. Each element is a character or string." + (let ((parts2 nil)) + (while parts + (let* ((partcell (prog1 parts (setf parts (cdr parts)))) + (part (car partcell))) + (if (stringp part) + (setf parts2 (nconc (append part nil) parts2)) + (setcdr partcell parts2) + (setf parts2 partcell)))) + (apply #'string parts2))) + +(defun vc-hg--pcre-to-elisp-re (pcre prefix) + "Transform PCRE, a Mercurial file PCRE, into an elisp RE against PREFIX. +PREFIX is the directory name of the directory against which these +patterns are rooted. We understand only a subset of PCRE syntax; +if we don't understand a construct, we signal +`vc-hg-unsupported-syntax'." + (cl-assert (string-match "^/\\(.*/\\)?$" prefix)) + (let ((parts nil) + (i 0) + (anchored nil) + (state 'normal) + (pcrelen (length pcre))) + (while (< i pcrelen) + (let ((c (aref pcre i))) + (cond ((eq state 'normal) + (cond ((string-match + (rx (| "}\\?" (: "(?" (not (any ":"))))) + pcre i) + (signal 'vc-hg-unsupported-syntax (list pcre))) + ((eq c ?\\) + (setf state 'backslash)) + ((eq c ?\[) + (setf state 'charclass-enter) + (push c parts)) + ((eq c ?^) + (if (eq i 0) (setf anchored t) + (signal 'vc-hg-unsupported-syntax (list pcre)))) + ((eq c ?$) + ;; Patterns can also match directories exactly, + ;; ignoring everything under a matched directory + (push "\\(?:$\\|/\\)" parts)) + ((memq c '(?| ?\( ?\))) + (push ?\\ parts) + (push c parts)) + (t (push c parts)))) + ((eq state 'backslash) + (cond ((memq c '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?A ?b ?B ?d ?D ?s ?S ?w ?W ?Z ?x)) + (signal 'vc-hg-unsupported-syntax (list pcre))) + ((memq c vc-hg--elisp-metacharacters) + (push ?\\ parts) + (push c parts)) + (t (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts))) + (setf state 'normal)) + ((eq state 'charclass-enter) + (push c parts) + (setf state + (if (eq c ?\\) + 'charclass + 'charclass-backslash))) + ((eq state 'charclass-backslash) + (if (memq c '(?0 ?x)) + (signal 'vc-hg-unsupported-syntax (list pcre))) + (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts) + (setf state 'charclass)) + ((eq state 'charclass) + (push c parts) + (cond ((eq c ?\\) (setf state 'charclass-backslash)) + ((eq c ?\]) (setf state 'normal)))) + (t (error "invalid state"))) + (setf i (1+ i)))) + (unless (eq state 'normal) + (signal 'vc-hg-unsupported-syntax (list pcre))) + (concat + "^" + prefix + (if anchored "" "\\(?:.*/\\)?") + (vc-hg--parts-to-string parts)))) + +(defun vc-hg--glob-to-pcre (glob) + "Transform a glob pattern into a Mercurial file pattern regex." + (let ((parts nil) (i 0) (n (length glob)) (group 0) c) + (cl-macrolet ((peek () '(and (< i n) (aref glob i)))) + (while (< i n) + (setf c (aref glob i)) + (cl-incf i) + (cond ((not (memq c '(?* ?? ?\[ ?\{ ?\} ?, ?\\))) + (push (vc-hg--escape-for-pcre c) parts)) + ((eq c ?*) + (cond ((eq (peek) ?*) + (cl-incf i) + (cond ((eq (peek) ?/) + (cl-incf i) + (push "(?:.*/)?" parts)) + (t + (push ".*" parts)))) + (t (push "[^/]*" parts)))) + ((eq c ??) + (push ?. parts)) + ((eq c ?\[) + (let ((j i)) + (when (and (< j n) (memq (aref glob j) '(?! ?\]))) + (cl-incf j)) + (while (and (< j n) (not (eq (aref glob j) ?\]))) + (cl-incf j)) + (cond ((>= j n) + (push "\\[" parts)) + (t + (let ((x (substring glob i j))) + (setf x (replace-regexp-in-string + "\\\\" "\\\\" x t t)) + (setf i (1+ j)) + (cond ((eq (aref x 0) ?!) + (setf (aref x 0) ?^)) + ((eq (aref x 0) ?^) + (setf x (concat "\\" x)))) + (push ?\[ parts) + (push x parts) + (push ?\] parts)))))) + ((eq c ?\{) + (cl-incf group) + (push "(?:" parts)) + ((eq c ?\}) + (push ?\) parts) + (cl-decf group)) + ((and (eq c ?,) (> group 0)) + (push ?| parts)) + ((eq c ?\\) + (if (eq i n) + (push "\\\\" parts) + (cl-incf i) + (push ?\\ parts) + (push c parts))) + (t + (push (vc-hg--escape-for-pcre c) parts))))) + (concat (vc-hg--parts-to-string parts) "$"))) + +(defvar vc-hg--hgignore-patterns) +(defvar vc-hg--hgignore-filenames) + +(defun vc-hg--hgignore-add-pcre (pcre prefix) + (push (vc-hg--pcre-to-elisp-re pcre prefix) vc-hg--hgignore-patterns)) + +(defun vc-hg--hgignore-add-glob (glob prefix) + (push (vc-hg--pcre-to-elisp-re (vc-hg--glob-to-pcre glob) prefix) + vc-hg--hgignore-patterns)) + +(defun vc-hg--hgignore-add-path (path prefix) + (let ((parts nil)) + (dotimes (i (length path)) + (push (vc-hg--escape-for-pcre (aref path i)) parts)) + (vc-hg--hgignore-add-pcre + (concat "^" (vc-hg--parts-to-string parts) "$") + prefix))) + +(defun vc-hg--slurp-hgignore-1 (hgignore prefix) + (let ((default-syntax 'vc-hg--hgignore-add-glob)) + (with-temp-buffer + (let ((attr (file-attributes hgignore))) + (when attr (insert-file-contents hgignore)) + (push (list hgignore (nth 5 attr) (nth 7 attr)) + vc-hg--hgignore-filenames)) + (while (not (eobp)) + ;; This list of pattern-file commands isn't complete, but it + ;; should cover the common cases. Remember that we fall back + ;; to regular hg commands if we see something we don't like. + (save-restriction + (narrow-to-region (point) (point-at-eol)) + (cond ((looking-at "[ \t]*\\(?:#.*\\)?$")) + ((looking-at "syntax:[ \t]*re[ \t]*$") + (setf default-syntax 'vc-hg--hgignore-add-pcre)) + ((looking-at "syntax:[ \t]*glob[ \t]*$") + (setf default-syntax 'vc-hg--hgignore-add-glob)) + ((looking-at "path:\\(.+?\\)[ \t]*$") + (vc-hg--hgignore-add-path (match-string 1) prefix)) + ((looking-at "glob:\\(.+?\\)[ \t]*$") + (vc-hg--hgignore-add-glob (match-string 1) prefix)) + ((looking-at "re:\\(.+?\\)[ \t]*$") + (vc-hg--hgignore-add-pcre (match-string 1) prefix)) + ((looking-at "\\(sub\\)?include:\\(.+?\\)[ \t]*$") + (let* ((sub (equal (match-string 1) "sub")) + (arg (match-string 2)) + (included-file + (if (string-match "^/" arg) arg + (concat (file-name-directory hgignore) arg)))) + (vc-hg--slurp-hgignore-1 + included-file + (if sub (file-name-directory included-file) prefix)))) + ((looking-at "[a-zA-Z0-9_]*:") + (signal 'vc-hg-unsupported-syntax (list (match-string 0)))) + ((looking-at ".*$") + (funcall default-syntax (match-string 0) prefix)))) + (forward-line 1))))) + +(cl-defstruct (vc-hg--ignore-patterns + (:copier nil) + (:constructor vc-hg--ignore-patterns-make)) + repo + ignore-patterns + file-sources) + +(defun vc-hg--slurp-hgignore (repo) + "Read hg ignore patterns from REPO. +REPO must be the directory name of an hg repository." + (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (let* ((hgignore (concat repo ".hgignore")) + (vc-hg--hgignore-patterns nil) + (vc-hg--hgignore-filenames nil)) + (vc-hg--slurp-hgignore-1 hgignore repo) + (vc-hg--ignore-patterns-make + :repo repo + :ignore-patterns (nreverse vc-hg--hgignore-patterns) + :file-sources (nreverse vc-hg--hgignore-filenames)))) + +(defun vc-hg--ignore-patterns-valid-p (hgip) + "Return whether the cached ignore patterns in HGIP are still valid" + (let ((valid t) + (file-sources (vc-hg--ignore-patterns-file-sources hgip))) + (while (and file-sources valid) + (let* ((fs (pop file-sources)) + (saved-mtime (nth 1 fs)) + (saved-size (nth 2 fs)) + (attr (file-attributes (nth 0 fs))) + (current-mtime (nth 5 attr)) + (current-size (nth 7 attr))) + (unless (and (equal saved-mtime current-mtime) + (equal saved-size current-size)) + (setf valid nil)))) + valid)) + +(defun vc-hg--ignore-patterns-ignored-p (hgip filename) + "Test whether the ignore pattern set HGIP says to ignore FILENAME. +FILENAME must be the file's true absolute name." + (let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip)) + (inhibit-changing-match-data t) + (ignored nil)) + (while (and patterns (not ignored)) + (setf ignored (string-match (pop patterns) filename))) + ignored)) + +(defun vc-hg--time-to-fixnum (ts) + (+ (* 65536 (car ts)) (cadr ts))) + +(defvar vc-hg--cached-ignore-patterns nil + "Cached pre-parsed hg ignore patterns.") + +(defun vc-hg--file-ignored-p (repo repo-relative-filename) + (let ((hgip vc-hg--cached-ignore-patterns)) + (unless (and hgip + (equal repo (vc-hg--ignore-patterns-repo hgip)) + (vc-hg--ignore-patterns-valid-p hgip)) + (setf vc-hg--cached-ignore-patterns nil) + (setf hgip (vc-hg--slurp-hgignore repo)) + (setf vc-hg--cached-ignore-patterns hgip)) + (vc-hg--ignore-patterns-ignored-p + hgip + (concat repo repo-relative-filename)))) + +(defun vc-hg--read-repo-requirements (repo) + (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (let* ((requires-filename (concat repo ".hg/requires"))) + (and (file-exists-p requires-filename) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally requires-filename) + (split-string (buffer-substring-no-properties + (point-min) (point-max))))))) + +(defconst vc-hg-supported-requirements + '("dotencode" + "fncache" + "generaldelta" + "lz4revlog" + "remotefilelog" + "revlogv1" + "store") + "List of Mercurial repository requirements we understand; if a +repository requires features not present in this list, we avoid +attempting to parse Mercurial data structures.") + +(defun vc-hg--requirements-understood-p (repo) + "Check that we understand the format of the given repository. +REPO is the directory name of a Mercurial repository." + (null (cl-set-difference (vc-hg--read-repo-requirements repo) + vc-hg-supported-requirements + :test #'equal))) + +(defvar vc-hg--dirstate-scan-cache nil + "Cache of the last result of `vc-hg--raw-dirstate-search'. +Avoids the need to repeatedly scan dirstate on repeated calls to +`vc-hg-state', as we see during registration queries.") + +(defun vc-hg--cached-dirstate-search (dirstate dirstate-attr ascii-fname) + (let* ((mtime (nth 5 dirstate-attr)) + (size (nth 7 dirstate-attr)) + (cache vc-hg--dirstate-scan-cache) + ) + (if (and cache + (equal dirstate (pop cache)) + (equal mtime (pop cache)) + (equal size (pop cache)) + (equal ascii-fname (pop cache))) + (pop cache) + (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname))) + (setf vc-hg--dirstate-scan-cache + (list dirstate mtime size ascii-fname result)) + result)))) + +(defun vc-hg-state-fast (filename) + "Like `vc-hg-state', but parse internal data structures directly. +Returns one of the usual `vc-state' enumeration values or +`unsupported' if we need to take the slow path and run the +hg binary." + (let* (truename + repo + dirstate + dirstate-attr + repo-relative-filename + ascii-fname) + (if (or + ;; Explicit user disable + (not vc-hg-parse-hg-data-structures) + ;; It'll probably be faster to run hg remotely + (file-remote-p filename) + (progn + (setf truename (file-truename filename)) + (file-remote-p truename)) + (not (setf repo (vc-hg-root truename))) + ;; dirstate must exist + (not (progn + (setf repo (expand-file-name repo)) + (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (setf dirstate (concat repo ".hg/dirstate")) + (setf dirstate-attr (file-attributes dirstate)))) + ;; Repository must be in an understood format + (not (vc-hg--requirements-understood-p repo)) + ;; Dirstate too small to be valid + (< (nth 7 dirstate-attr) 40) + ;; We want to store 32-bit unsigned values in fixnums + (< most-positive-fixnum 4294967295) + (progn + (setf repo-relative-filename + (file-relative-name truename repo)) + (setf ascii-fname + (string-as-unibyte + (let (last-coding-system-used) + (encode-coding-string + repo-relative-filename + 'us-ascii t)))) + ;; We only try dealing with ASCII filenames + (not (equal ascii-fname repo-relative-filename)))) + 'unsupported + (let* ((dirstate-entry + (vc-hg--cached-dirstate-search + dirstate dirstate-attr ascii-fname)) + (state (car dirstate-entry)) + (stat (file-attributes + (concat repo repo-relative-filename)))) + (cond ((eq state ?r) 'removed) + ((and (not state) stat) + (condition-case nil + (if (vc-hg--file-ignored-p repo repo-relative-filename) + 'ignored + 'unregistered) + (vc-hg-unsupported-syntax 'unsupported))) + ((and state (not stat)) 'missing) + ((eq state ?n) + (let ((vc-hg-size (nth 2 dirstate-entry)) + (vc-hg-mtime (nth 3 dirstate-entry)) + (fs-size (nth 7 stat)) + (fs-mtime (vc-hg--time-to-fixnum (nth 5 stat)))) + (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime)) + 'up-to-date + 'edited))) + ((eq state ?a) 'added) + (state 'unsupported)))))) + ;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) @@ -734,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 b3644cc1ac5..f59b4632e70 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -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-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-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 @@ -807,15 +812,15 @@ In the latter case, VC mode is deactivated for this buffer." (add-hook 'vc-mode-line-hook 'vc-mode-line nil t) (let (backend) (cond - ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) + ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) + ;; Let the backend setup any buffer-local things he needs. + (vc-call-backend backend 'find-file-hook) ;; Compute the state and put it in the mode line. (vc-mode-line buffer-file-name backend) (unless vc-make-backup-files ;; Use this variable, not make-backup-files, ;; because this is for things that depend on the file name. - (set (make-local-variable 'backup-inhibited) t)) - ;; Let the backend setup any buffer-local things he needs. - (vc-call-backend backend 'find-file-hook)) + (set (make-local-variable 'backup-inhibited) t))) ((let* ((truename (and buffer-file-truename (expand-file-name buffer-file-truename))) (link-type (and truename 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/version.el b/lisp/version.el index 77188a51ee3..d4cb92ec86a 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -38,13 +38,11 @@ This variable first existed in version 19.23.") "Minor version number of this version of Emacs. This variable first existed in version 19.23.") -(defconst emacs-build-time (current-time) - "Time at which Emacs was dumped out.") - -;; I think this should be obsoleted/removed. It's just one more meaningless -;; difference between different builds. It's usually not even an fqdn. (defconst emacs-build-system (system-name) - "Name of the system on which Emacs was built.") + "Name of the system on which Emacs was built, or nil if not available.") + +(defconst emacs-build-time (if emacs-build-system (current-time)) + "Time at which Emacs was dumped out, or nil if not available.") (defvar motif-version-string) (defvar gtk-version-string) @@ -58,9 +56,7 @@ Don't use this function in programs to choose actions according to the system configuration; look at `system-configuration' instead." (interactive "P") (let ((version-string - (format (if (not (called-interactively-p 'interactive)) - "GNU Emacs %s (%s%s%s%s)\n of %s" - "GNU Emacs %s (%s%s%s%s) of %s") + (format "GNU Emacs %s (%s%s%s%s)%s" emacs-version system-configuration (cond ((featurep 'motif) @@ -79,7 +75,14 @@ to the system configuration; look at `system-configuration' instead." (format ", %s scroll bars" (capitalize (symbol-name x-toolkit-scroll-bars))) "") - (format-time-string "%Y-%m-%d" emacs-build-time)))) + (if emacs-build-time + (format-time-string (concat + (if (called-interactively-p + 'interactive) + "" "\n") + " of %Y-%m-%d") + emacs-build-time) + "")))) (if here (insert version-string) (if (called-interactively-p 'interactive) @@ -113,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. @@ -134,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 ff7d2c9deb1..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." diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 0f31c4a668d..91c02530427 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -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 16ea67dba56..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. @@ -152,6 +152,16 @@ renamed by `dired-do-rename' and `dired-do-rename-regexp'." :version "24.3" :group 'wdired) +(defcustom wdired-create-parent-directories t + "If non-nil, create parent directories of destination files. +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 "26.1" + :type 'boolean + :group 'wdired) + (defvar wdired-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-x\C-s" 'wdired-finish-edit) @@ -492,6 +502,8 @@ non-nil means return old filename." (require 'dired-aux) (condition-case err (let ((dired-backup-overwrite nil)) + (and wdired-create-parent-directories + (wdired-create-parentdirs file-new)) (dired-rename-file file-ori file-new overwrite)) (error @@ -501,6 +513,11 @@ non-nil means return old filename." err))))))))) errors)) +(defun wdired-create-parentdirs (file-new) + "Create parent directories for FILE-NEW if they don't exist." + (and (not (file-exists-p (file-name-directory file-new))) + (message "Creating directory for file %s" file-new) + (make-directory (file-name-directory file-new) t))) (defun wdired-exit () "Exit wdired and return to dired mode. @@ -573,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 @@ -586,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 diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 0f6b8df03de..231675407d1 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) @@ -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]+\\)\\'" "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. @@ -1453,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. @@ -1476,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. @@ -1497,30 +1390,29 @@ 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 (save-excursion - (save-match-data ;FIXME: Why? - ;; PROBLEM 1: empty lines at bob - ;; PROBLEM 2: empty lines at eob - ;; ACTION: remove all empty lines at bob and/or eob - (when (memq 'empty whitespace-style) - (let (overwrite-mode) ; enforce no overwrite - (goto-char (point-min)) - (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) - (delete-region (match-beginning 1) (match-end 1))))))) - ;; PROBLEM 3: 8 or more SPACEs at bol + ;; PROBLEM 1: empty lines at bob + ;; PROBLEM 2: empty lines at eob + ;; ACTION: remove all empty lines at bob and/or eob + (when (memq 'empty whitespace-style) + (let (overwrite-mode) ; enforce no overwrite + (goto-char (point-min)) + (when (looking-at whitespace-empty-at-bob-regexp) + (delete-region (match-beginning 1) (match-end 1))) + (when (re-search-forward + whitespace-empty-at-eob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1)))))) + ;; 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 () @@ -1536,13 +1428,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. @@ -1559,7 +1451,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. @@ -1583,76 +1475,75 @@ documentation." overwrite-mode ; enforce no overwrite tmp) (save-excursion - (save-match-data ;FIXME: Why? - ;; PROBLEM 1: 8 or more SPACEs at bol - (cond - ;; ACTION: replace 8 or more SPACEs at bol by TABs, if - ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs - ;; by SPACEs. - ((memq 'indentation whitespace-style) - (let ((regexp (whitespace-indentation-regexp))) - (goto-char rstart) - (while (re-search-forward regexp rend t) - (setq tmp (current-indentation)) - (goto-char (match-beginning 0)) - (delete-horizontal-space) - (unless (eolp) - (indent-to tmp))))) - ;; ACTION: replace 8 or more SPACEs at bol by TABs. - ((memq 'indentation::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - (whitespace-indentation-regexp 'tab) 0)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'indentation::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - (whitespace-indentation-regexp 'space) 0))) - ;; PROBLEM 3: SPACEs or TABs at eol - ;; ACTION: remove all SPACEs or TABs at eol - (when (memq 'trailing whitespace-style) - (whitespace-replace-action - 'delete-region rstart rend - whitespace-trailing-regexp 1)) - ;; PROBLEM 4: 8 or more SPACEs after TAB - (cond - ;; ACTION: replace 8 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. - ((memq 'space-after-tab::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - (whitespace-space-after-tab-regexp 'tab) 1)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'space-after-tab::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - (whitespace-space-after-tab-regexp 'space) 1))) - ;; PROBLEM 2: SPACEs before TAB - (cond - ;; ACTION: replace SPACEs before TAB by TABs, if - ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs - ;; by SPACEs. - ((memq 'space-before-tab whitespace-style) - (whitespace-replace-action - (if whitespace-indent-tabs-mode 'tabify 'untabify) - rstart rend whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 0 2))) - ;; ACTION: replace SPACEs before TAB by TABs. - ((memq 'space-before-tab::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - whitespace-space-before-tab-regexp 0)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'space-before-tab::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - whitespace-space-before-tab-regexp 2))))) + ;; PROBLEM 1: `tab-width' or more SPACEs at bol + (cond + ;; 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) + (let ((regexp (whitespace-indentation-regexp))) + (goto-char rstart) + (while (re-search-forward regexp rend t) + (setq tmp (current-indentation)) + (goto-char (match-beginning 0)) + (delete-horizontal-space) + (unless (eolp) + (indent-to tmp))))) + ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs. + ((memq 'indentation::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + (whitespace-indentation-regexp 'tab) 0)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'indentation::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + (whitespace-indentation-regexp 'space) 0))) + ;; PROBLEM 3: SPACEs or TABs at eol + ;; ACTION: remove all SPACEs or TABs at eol + (when (memq 'trailing whitespace-style) + (whitespace-replace-action + 'delete-region rstart rend + whitespace-trailing-regexp 1)) + ;; PROBLEM 4: `tab-width' or more SPACEs after TAB + (cond + ;; 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 `tab-width' or more SPACEs by TABs. + ((memq 'space-after-tab::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + (whitespace-space-after-tab-regexp 'tab) 1)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'space-after-tab::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + (whitespace-space-after-tab-regexp 'space) 1))) + ;; PROBLEM 2: SPACEs before TAB + (cond + ;; ACTION: replace SPACEs before TAB by TABs, if + ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs + ;; by SPACEs. + ((memq 'space-before-tab whitespace-style) + (whitespace-replace-action + (if whitespace-indent-tabs-mode 'tabify 'untabify) + rstart rend whitespace-space-before-tab-regexp + (if whitespace-indent-tabs-mode 0 2))) + ;; ACTION: replace SPACEs before TAB by TABs. + ((memq 'space-before-tab::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + whitespace-space-before-tab-regexp 0)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'space-before-tab::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + whitespace-space-before-tab-regexp 2)))) (set-marker rend nil)))) ; point marker to nowhere @@ -1674,13 +1565,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) @@ -1721,15 +1614,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" @@ -1743,14 +1636,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") @@ -1784,13 +1677,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 @@ -1802,9 +1690,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. @@ -1812,7 +1700,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 @@ -1820,68 +1708,73 @@ cleaning up these problems." (interactive "r") (setq force (or current-prefix-arg force)) (save-excursion - (save-match-data ;FIXME: Why? - (let* ((has-bogus nil) - (rstart (min start end)) - (rend (max start end)) - (bogus-list - (mapcar - #'(lambda (option) - (when force - (add-to-list 'whitespace-style (car option))) - (goto-char rstart) - (let ((regexp - (cond - ((eq (car option) 'indentation) - (whitespace-indentation-regexp)) - ((eq (car option) 'indentation::tab) - (whitespace-indentation-regexp 'tab)) - ((eq (car option) 'indentation::space) - (whitespace-indentation-regexp 'space)) - ((eq (car option) 'space-after-tab) - (whitespace-space-after-tab-regexp)) - ((eq (car option) 'space-after-tab::tab) - (whitespace-space-after-tab-regexp 'tab)) - ((eq (car option) 'space-after-tab::space) - (whitespace-space-after-tab-regexp 'space)) - (t - (cdr option))))) - (and (re-search-forward regexp rend t) - (setq has-bogus t)))) - whitespace-report-list))) - (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) - (whitespace-kill-buffer whitespace-report-buffer-name) - ;; `whitespace-indent-tabs-mode' is local to current buffer - ;; `whitespace-tab-width' is local to current buffer - (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode) - (ws-tab-width whitespace-tab-width)) - (with-current-buffer (get-buffer-create - whitespace-report-buffer-name) - (erase-buffer) - (insert (if ws-indent-tabs-mode - (car whitespace-report-text) - (cdr whitespace-report-text))) - (goto-char (point-min)) - (forward-line 3) - (dolist (option whitespace-report-list) - (forward-line 1) - (whitespace-mark-x - 27 (memq (car option) whitespace-style)) - (whitespace-mark-x 7 (car bogus-list)) - (setq bogus-list (cdr bogus-list))) - (forward-line 1) - (whitespace-insert-value ws-indent-tabs-mode) - (whitespace-insert-value ws-tab-width) - (when has-bogus - (goto-char (point-max)) - (insert (substitute-command-keys - " Type `\\[whitespace-cleanup]'") - " to cleanup the buffer.\n\n" - (substitute-command-keys - " Type `\\[whitespace-cleanup-region]'") - " to cleanup a region.\n\n")) - (whitespace-display-window (current-buffer))))) - has-bogus)))) + (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 'style (car option))) + (goto-char rstart) + (let ((regexp + (cond + ((eq (car option) 'indentation) + (whitespace-indentation-regexp)) + ((eq (car option) 'indentation::tab) + (whitespace-indentation-regexp 'tab)) + ((eq (car option) 'indentation::space) + (whitespace-indentation-regexp 'space)) + ((eq (car option) 'space-after-tab) + (whitespace-space-after-tab-regexp)) + ((eq (car option) 'space-after-tab::tab) + (whitespace-space-after-tab-regexp 'tab)) + ((eq (car option) 'space-after-tab::space) + (whitespace-space-after-tab-regexp 'space)) + (t + (cdr option))))) + (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) + ;; `whitespace-indent-tabs-mode' is local to current buffer + ;; `whitespace-tab-width' is local to current buffer + (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode) + (ws-tab-width whitespace-tab-width)) + (with-current-buffer (get-buffer-create + whitespace-report-buffer-name) + (erase-buffer) + (insert (if ws-indent-tabs-mode + (car whitespace-report-text) + (cdr whitespace-report-text))) + (goto-char (point-min)) + (forward-line 3) + (dolist (option whitespace-report-list) + (forward-line 1) + (whitespace-mark-x + 27 (memq (car option) style)) + (whitespace-mark-x 7 (car bogus-list)) + (setq bogus-list (cdr bogus-list))) + (forward-line 1) + (whitespace-insert-value ws-indent-tabs-mode) + (whitespace-insert-value ws-tab-width) + (when has-bogus + (goto-char (point-max)) + (insert (substitute-command-keys + " Type `\\[whitespace-cleanup]'") + " to cleanup the buffer.\n\n" + (substitute-command-keys + " Type `\\[whitespace-cleanup-region]'") + " to cleanup a region.\n\n")) + (whitespace-display-window (current-buffer))))) + has-bogus))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 8505bef6b12..fdb67ed4a87 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))))) @@ -1407,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)) @@ -1428,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)))))))))) @@ -2600,7 +2797,7 @@ instead." window delta horizontal ignore nil nil nil t))) (window--resize-reset frame horizontal) (window--resize-this-window window delta horizontal ignore t) - (if (and (not window-combination-resize) + (if (and (not (eq window-combination-resize t)) (window-combined-p window horizontal) (setq sibling (or (window-right window) (window-left window))) (window-sizable-p @@ -2633,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))) @@ -3140,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 @@ -3226,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 @@ -3247,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 @@ -3261,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 @@ -3291,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 @@ -3519,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)) @@ -3743,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 @@ -3770,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) @@ -3829,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 @@ -3841,7 +4049,7 @@ that is its frame's root window." (sibling (or (window-left window) (window-right window)))) (window--resize-reset frame horizontal) (cond - ((and (not window-combination-resize) + ((and (not (eq window-combination-resize t)) sibling (window-sizable-p sibling size horizontal nil t)) ;; Resize WINDOW's sibling. (window--resize-this-window sibling size horizontal nil t) @@ -3889,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 @@ -3908,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. @@ -4069,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)) @@ -4079,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)) @@ -4109,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!). @@ -4187,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)) @@ -4196,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)) @@ -4214,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))) @@ -4703,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. @@ -4889,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) @@ -4897,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. @@ -5289,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) @@ -5366,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 @@ -5409,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)) @@ -5465,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 @@ -5487,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 @@ -5497,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)))) @@ -5511,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)) @@ -5541,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) @@ -5635,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'. @@ -6140,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 @@ -6315,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)) @@ -6341,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)) @@ -6378,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) @@ -6603,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 @@ -6693,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. @@ -6757,6 +7096,70 @@ that frame." (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) +(defun display-buffer-reuse-mode-window (buffer alist) + "Return a window based on the mode of the buffer it displays. +Display BUFFER in the returned window. Return nil if no usable +window is found. + +If ALIST contains a `mode' entry, its value is a major mode (a +symbol) or a list of modes. A window is a candidate if it +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 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'." + (let* ((alist-entry (assq 'reusable-frames alist)) + (alist-mode-entry (assq 'mode alist)) + (frames (cond (alist-entry (cdr alist-entry)) + ((if (eq pop-up-frames 'graphic-only) + (display-graphic-p) + pop-up-frames) + 0) + (display-buffer-reuse-frames 0) + (t (last-nonminibuffer-frame)))) + (inhibit-same-window-p (cdr (assq 'inhibit-same-window alist))) + (windows (window-list-1 nil 'nomini frames)) + (buffer-mode (with-current-buffer buffer major-mode)) + (allowed-modes (if alist-mode-entry + (cdr alist-mode-entry) + buffer-mode)) + (curwin (selected-window)) + (curframe (selected-frame))) + (unless (listp allowed-modes) + (setq allowed-modes (list allowed-modes))) + (let (same-mode-same-frame + same-mode-other-frame + derived-mode-same-frame + derived-mode-other-frame) + (dolist (window windows) + (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)))) + (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 + derived-mode-other-frame)))) + (when (window-live-p window) + (prog1 (window--display-buffer buffer window 'reuse alist) + (unless (cdr (assq 'inhibit-switch-frame alist)) + (window--maybe-raise-frame (window-frame window))))))))) + (defun display-buffer--special-action (buffer) "Return special display action for BUFFER, if any. If `special-display-p' returns non-nil for BUFFER, return an @@ -6829,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'. @@ -6844,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)) @@ -6888,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) @@ -7009,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. @@ -7023,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) @@ -7093,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 @@ -7111,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. @@ -7494,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)))) @@ -7542,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 @@ -7562,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))) @@ -8500,9 +8888,9 @@ 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 @@ -8513,17 +8901,17 @@ the given windows." (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. 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 414300cb402..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)) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index a2b64019f97..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 diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 7a0ca8bd551..6443954824c 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -36,14 +36,13 @@ (declare-function make-xwidget "xwidget.c" (type title width height arguments &optional buffer)) -(declare-function xwidget-set-adjustment "xwidget.c" - (xwidget axis relative value)) (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)) @@ -108,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) @@ -123,36 +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." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, 50);")) (defun xwidget-webkit-scroll-down () "Scroll webkit down." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(0, -50);")) (defun xwidget-webkit-scroll-forward () "Scroll webkit forwards." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)) + (xwidget-webkit-execute-script + (xwidget-webkit-current-session) + "window.scrollBy(50, 0);")) (defun xwidget-webkit-scroll-backward () "Scroll webkit backwards." (interactive) - (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)) + (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. @@ -186,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 @@ -276,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) @@ -324,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." @@ -394,18 +437,18 @@ For example, use this to display an anchor." (defun xwidget-webkit-adjust-size-dispatch () "Adjust size according to mode." (interactive) - (xwidget-webkit-adjust-size-to-window) + (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." @@ -420,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* @@ -427,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 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))) @@ -456,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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |