diff options
Diffstat (limited to 'lisp')
421 files changed, 12057 insertions, 17338 deletions
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 29081d3f3cd..2f1957ad0ca 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> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index f33dd011eda..12bb9c7a3ce 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 @@ -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) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index d181d97703e..163dc8e5727 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)))))) @@ -848,7 +848,7 @@ if expansion occurred, else nil.)" "Default function to use for `abbrev-expand-function'. This respects the wrapper hook `abbrev-expand-functions'. 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)) @@ -1005,17 +1005,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/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 52765ce6b31..fe28a02c200 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/auth-source.el @@ -40,8 +40,6 @@ ;;; Code: (require 'password-cache) -(require 'mm-util) -(require 'gnus-util) (eval-when-compile (require 'cl)) (require 'eieio) @@ -372,11 +370,7 @@ with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)." 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") @@ -1092,12 +1086,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. @@ -1601,9 +1593,9 @@ 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 @@ -1715,12 +1707,13 @@ entries for git.gnus.org: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label)) + ;; Filter out ignored keys from the spec + (ignored-keys '(:create :delete :max :backend :label :host :port)) + ;; Build a search spec without the ignored keys (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) - ;; build a search spec without the ignored keys - ;; if a search key is nil or t (match anything), we skip it + ;; 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 +1722,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 +1758,28 @@ entries for git.gnus.org: items))) items)) + +(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 + (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))) + (defun* auth-source-macos-keychain-search-items (coll _type _max + host port &key label type - host user port + user &allow-other-keys) - (let* ((keychain-generic (eq type 'macos-keychain-generic)) (args `(,(if keychain-generic "find-generic-password" @@ -1784,29 +1808,32 @@ 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))) + (lexical-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)))) @@ -1856,9 +1883,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))) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index b8693dfb210..1129af8a2fa 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -51,6 +51,12 @@ ;; Emacs. You should never even notice that this package is active ;; (except that your buffers will be reverted, of course). ;; +;; If the file exists, Auto-Revert Mode updates the buffer based on +;; its (possibly empty) contents. If the file no longer exists, then +;; there is nothing to revert, so it does not modify the buffer. Once +;; a deleted file corresponding to a buffer in Auto-Revert Mode +;; reappears, Auto-Revert Mode continues to work. +;; ;; If Emacs is compiled with file notification support, notifications ;; are used instead of checking the time stamp of the files. You can ;; disable this by setting the user option `auto-revert-use-notify' to @@ -58,19 +64,19 @@ ;; excluded from file notifications can be specified by ;; `auto-revert-notify-exclude-dir-regexp'. ;; -;; After reverting a file buffer, Auto Revert Mode normally puts point +;; After reverting a file buffer, Auto-Revert Mode normally puts point ;; at the same position that a regular manual revert would. However, ;; there is one exception to this rule. If point is at the end of the ;; buffer before reverting, it stays at the end. Similarly if point ;; is displayed at the end of a file buffer in any window, it will stay ;; at the end of the buffer in that window, even if the window is not -;; selected. This way, you can use Auto Revert Mode to `tail' a file. +;; selected. This way, you can use Auto-Revert Mode to `tail' a file. ;; Just put point at the end of the buffer and it will stay there. ;; These rules apply to file buffers. For non-file buffers, the ;; behavior may be mode dependent. ;; -;; While you can use Auto Revert Mode to tail a file, this package -;; contains a third minor mode, Auto Revert Tail Mode, which does so +;; While you can use Auto-Revert Mode to tail a file, this package +;; contains a third minor mode, Auto-Revert Tail Mode, which does so ;; more efficiently, as long as you are sure that the file will only ;; change by growing at the end. It only appends the new output, ;; instead of reverting the entire buffer. It does so even if the @@ -112,8 +118,8 @@ (defgroup auto-revert nil "Revert individual buffers when files on disk change. -Auto-Revert mode enables auto-revert in individual buffers. -Global Auto-Revert mode does so in all buffers." +Auto-Revert Mode enables auto-revert in individual buffers. +Global Auto-Revert Mode does so in all buffers." :group 'files :group 'convenience) @@ -144,7 +150,7 @@ If a timer is already active, there are two ways to make sure that the new value will take effect immediately. You can set this variable through Custom or you can call the command `auto-revert-set-timer' after setting the variable. Otherwise, -the new value will take effect the first time Auto Revert Mode +the new value will take effect the first time Auto-Revert Mode calls `auto-revert-set-timer' for internal reasons or in your next editing session." :group 'auto-revert @@ -176,7 +182,7 @@ When non-nil, a message is generated whenever a file is reverted." "String to display in the mode line when Auto-Revert Mode is active. \(When the string is not empty, make sure that it has a leading space.)" - :tag "Auto Revert Mode Text" ; To separate it from `global-...' + :tag "Auto-Revert Mode Text" ; To separate it from `global-...' :group 'auto-revert :type 'string) @@ -190,7 +196,7 @@ When non-nil, a message is generated whenever a file is reverted." (defcustom auto-revert-mode-hook nil "Functions to run when Auto-Revert Mode is activated." - :tag "Auto Revert Mode Hook" ; To separate it from `global-...' + :tag "Auto-Revert Mode Hook" ; To separate it from `global-...' :group 'auto-revert :type 'hook) @@ -209,11 +215,11 @@ would only waste precious space." :type 'hook) (defcustom global-auto-revert-non-file-buffers nil - "When nil, Global Auto-Revert mode operates only on file-visiting buffers. + "When nil, Global Auto-Revert Mode operates only on file-visiting buffers. When non-nil, both file buffers and buffers with a custom `revert-buffer-function' and a `buffer-stale-function' are -reverted by Global Auto-Revert mode. These include the Buffer +reverted by Global Auto-Revert Mode. These include the Buffer List buffer displayed by `buffer-menu', and Dired buffers showing complete local directories. The Buffer List buffer reverts every `auto-revert-interval' seconds; Dired buffers when the file list of @@ -240,8 +246,8 @@ For more information, see Info node `(emacs)Autorevert'." :type 'hook) (defcustom auto-revert-check-vc-info nil - "If non-nil Auto Revert Mode reliably updates version control info. -Auto Revert Mode updates version control info whenever the buffer + "If non-nil Auto-Revert Mode reliably updates version control info. +Auto-Revert Mode updates version control info whenever the buffer needs reverting, regardless of the value of this variable. However, the version control state can change without changes to the work file. If the change is made from the current Emacs @@ -271,7 +277,7 @@ This variable becomes buffer local when set in any fashion.") :version "24.4") (defcustom auto-revert-use-notify t - "If non-nil Auto Revert Mode uses file notification functions. + "If non-nil Auto-Revert Mode uses file notification functions. You should set this variable through Custom." :group 'auto-revert :type 'boolean @@ -337,12 +343,12 @@ This has been reported by a file notification event.") ;;;###autoload (define-minor-mode auto-revert-mode - "Toggle reverting buffer when the file changes (Auto Revert mode). -With a prefix argument ARG, enable Auto Revert mode if ARG is + "Toggle reverting buffer when the file changes (Auto-Revert Mode). +With a prefix argument ARG, enable Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Auto Revert mode is a minor mode that affects only the current +Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on disk changes. @@ -351,8 +357,14 @@ Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer." :group 'auto-revert :lighter auto-revert-mode-text (if auto-revert-mode - (if (not (memq (current-buffer) auto-revert-buffer-list)) - (push (current-buffer) auto-revert-buffer-list)) + (when (not (memq (current-buffer) auto-revert-buffer-list)) + (push (current-buffer) auto-revert-buffer-list) + (add-hook + 'kill-buffer-hook + (lambda () + (setq auto-revert-buffer-list + (delq (current-buffer) auto-revert-buffer-list))) + nil t)) (when auto-revert-use-notify (auto-revert-notify-rm-watch)) (setq auto-revert-buffer-list (delq (current-buffer) auto-revert-buffer-list))) @@ -374,11 +386,11 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode auto-revert-tail-mode "Toggle reverting tail of buffer when the file grows. -With a prefix argument ARG, enable Auto-Revert Tail mode if ARG +With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -When Auto Revert Tail mode is enabled, the tail of the file is +When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This means that whenever the file grows on disk (presumably because some background process is appending to it from time to time), @@ -428,7 +440,7 @@ Perform a full revert? ") ;;;###autoload (defun turn-on-auto-revert-tail-mode () - "Turn on Auto-Revert Tail mode. + "Turn on Auto-Revert Tail Mode. This function is designed to be added to hooks, for example: (add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode)" @@ -437,12 +449,12 @@ This function is designed to be added to hooks, for example: ;;;###autoload (define-minor-mode global-auto-revert-mode - "Toggle Global Auto Revert mode. -With a prefix argument ARG, enable Global Auto Revert mode if ARG + "Toggle Global Auto-Revert Mode. +With a prefix argument ARG, enable Global Auto-Revert Mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Global Auto Revert mode is a global minor mode that reverts any +Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use `auto-revert-mode' to revert a particular buffer. @@ -458,11 +470,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 @@ -577,16 +585,19 @@ no more reverts are possible until the next call of (if (eq action 'stopped) ;; File notification has stopped. Continue with polling. - (cl-dolist (buffer buffers) + (cl-dolist (buffer + (if global-auto-revert-mode + (buffer-list) auto-revert-buffer-list)) (with-current-buffer buffer - (when (or - ;; A buffer associated with a file. - (and (stringp buffer-file-name) - (string-equal - (file-name-nondirectory file) - (file-name-nondirectory buffer-file-name))) - ;; A buffer w/o a file, like dired. - (null buffer-file-name)) + (when (and (equal descriptor auto-revert-notify-watch-descriptor) + (or + ;; A buffer associated with a file. + (and (stringp buffer-file-name) + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory buffer-file-name))) + ;; A buffer w/o a file, like dired. + (null buffer-file-name))) (auto-revert-notify-rm-watch) (setq-local auto-revert-use-notify nil)))) @@ -740,7 +751,7 @@ To avoid starvation, the buffers in `auto-revert-remaining-buffers' are checked first the next time this function is called. This function is also responsible for removing buffers no longer in -Auto-Revert mode from `auto-revert-buffer-list', and for canceling +Auto-Revert Mode from `auto-revert-buffer-list', and for canceling the timer when no buffers need to be checked." (setq auto-revert-buffers-counter diff --git a/lisp/battery.el b/lisp/battery.el index b5e312f6c3e..1b58489161e 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -38,8 +38,12 @@ :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 "25.2" + :type 'regexp + :group 'battery) (defcustom battery-status-function (cond ((and (eq system-type 'gnu/linux) @@ -51,7 +55,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 +449,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))) 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/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/parse-time.el b/lisp/calendar/parse-time.el index 6ba26a4a00d..b62f9fa7941 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -48,7 +48,9 @@ ((eq char ?:) ?d))) (defun parse-time-tokenize (string) - "Tokenize STRING into substrings." + "Tokenize STRING into substrings. +Each substring is a run of \"valid\" characters, i.e., lowercase +letters, digits, plus or minus signs or colons." (let ((start nil) (end (length string)) (all-digits nil) @@ -59,7 +61,8 @@ (while (and (< index end) ;Skip invalid characters. (not (setq c (parse-time-string-chars (aref string index))))) (cl-incf index)) - (setq start index all-digits (eq c ?0)) + (setq start index + all-digits (eq c ?0)) (while (and (< (cl-incf index) end) ;Scan valid characters. (setq c (parse-time-string-chars (aref string index)))) (setq all-digits (and all-digits (eq c ?0)))) @@ -143,8 +146,12 @@ ;;;###autoload (defun parse-time-string (string) "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -The values are identical to those of `decode-time', but any values that are -unknown are returned as nil." +STRING should be on something resembling an RFC2822 string, a la +\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is +somewhat liberal in what format it accepts, and will attempt to +return a \"likely\" value even for somewhat malformed strings. +The values returned are identical to those of `decode-time', but +any values that are unknown are returned as nil." (let ((time (list nil nil nil nil nil nil nil nil nil)) (temp (parse-time-tokenize (downcase string)))) (while temp diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index c78d2bbf519..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/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/symref.el b/lisp/cedet/semantic/symref.el index 516a4f30414..0c1fe7e449b 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") @@ -109,7 +111,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 +273,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 +286,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 +392,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 +435,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 +466,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 +479,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 +575,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/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..88fc0b2d197 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -345,14 +345,15 @@ 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" "[sudo]" "Repeat" "Bad" "Retype") + t) " +\\)" "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, 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 "25.2" :type 'regexp :group 'comint) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d7db3530099..a1eb1d20016 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1164,7 +1164,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. @@ -1544,27 +1544,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. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 001d638ca14..c830ed83d1d 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -312,6 +312,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/dired-aux.el b/lisp/dired-aux.el index b9111a8d5b4..8d6f6656a9a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -39,6 +39,7 @@ ;; We need macros in dired.el to compile properly, ;; and we call subroutines in it too. (require 'dired) +(require 'cl-lib) ; for cl-mapcan (defvar dired-create-files-failures nil "Variable where `dired-create-files' records failing file names. @@ -729,26 +730,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 @@ -901,6 +928,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 @@ -2785,7 +2813,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 088ca81ed8d..be762e6e306 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1666,7 +1666,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 b838e649848..38979b5244d 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)) @@ -1535,6 +1538,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) @@ -3916,583 +3920,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" "8346506b9ef7167fd55b5eac7e6617a1") -;;; 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. -You are prompted for the archive name. -The archiving command is chosen based on the archive 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" "f00ad5ec7383d017263855ad8add60a3") -;;; 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/gnus/ecomplete.el b/lisp/ecomplete.el index 084895c32a5..cb50cce6056 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/ecomplete.el @@ -27,11 +27,6 @@ (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) @@ -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/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index ea01253d1ea..c0da59c81cb 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1832,7 +1832,7 @@ Redefining advices affect the construction of an advised definition." ;; @@ Interactive input functions: ;; =============================== -(declare-function 'function-called-at-point "help") +(declare-function function-called-at-point "help") (defun ad-read-advised-function (&optional prompt predicate default) "Read name of advised function with completion from the minibuffer. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index eb6b746bd80..80f5c28f3ec 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,93 @@ 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) - +(defun autoload--split-prefixes-1 (strs) + (let ((prefixes ())) + (dolist (str strs) + (string-match "\\`[^-:/_]*[-:/_]*" str) + (let* ((prefix (match-string 0 str)) + (tail (substring str (match-end 0))) + (cell (assoc prefix prefixes))) + (cond + ((null cell) (push (list prefix tail) prefixes)) + ((equal (cadr cell) tail) nil) + (t (setcdr cell (cons tail (cdr cell))))))) + prefixes)) + +(defun autoload--split-prefixes (prefixes) + (apply #'nconc + (mapcar (lambda (cell) + (let ((prefix (car cell))) + (mapcar (lambda (cell) + (cons (concat prefix (car cell)) (cdr cell))) + (autoload--split-prefixes-1 (cdr cell))))) + prefixes))) + +(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-defs-autoload-max-size 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).") + +(defvar autoload-popular-prefixes nil) + +(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 ((prefixes (autoload--split-prefixes-1 defs)) + (again t)) + ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes)) + (while again + (setq again nil) + (let ((newprefixes + (sort + (mapcar (lambda (cell) + (cons cell + (autoload--split-prefixes-1 (cdr cell)))) + prefixes) + (lambda (x y) (< (length (cdr x)) (length (cdr y))))))) + (setq prefixes nil) + (while newprefixes + (let ((x (pop newprefixes))) + (if (or (equal '("") (cdar x)) + (and (cddr x) + (not (member (caar x) + autoload-popular-prefixes)) + (> (+ (length prefixes) (length newprefixes) + (length (cdr x))) + autoload-defs-autoload-max-size))) + ;; Nothing to split or would split too deep. + (push (car x) prefixes) + ;; (message "Expand %S to %S" (caar x) (cdr x)) + (setq again t) + (setq prefixes + (nconc (mapcar (lambda (cell) + (cons (concat (caar x) + (car cell)) + (cdr cell))) + (cdr x)) + prefixes))))))) + ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) + (when prefixes + `(if (fboundp 'register-definition-prefixes) + (register-definition-prefixes ,file ',(mapcar #'car prefixes)))))) (defun autoload--setup-output (otherbuf outbuf absfile load-name) (let ((outbuf @@ -529,11 +664,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 @@ -592,13 +727,73 @@ FILE's modification time." ;; 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" + ;; Hmm... this is getting ugly: + "define-widget" + "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 + (nth 5 (file-attributes absfile))) + (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 +819,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 +852,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 +871,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 +891,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 +918,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)))) @@ -768,12 +985,13 @@ write its autoloads into the specified file instead." (dolist (suf (get-load-suffixes)) (unless (string-match "\\.elc" 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 occured. (last-time) ;; Files with no autoload cookies or whose autoloads go to other ;; files because of file-local autoload-generated-file settings. @@ -782,13 +1000,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) @@ -800,14 +1021,15 @@ 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. @@ -815,13 +1037,19 @@ write its autoloads into the specified file instead." ;; If the file is actually excluded. (member (expand-file-name file) autoload-excludes)) ;; 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. @@ -841,7 +1069,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. @@ -850,11 +1079,17 @@ 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. + (when changed + (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)))) @@ -886,7 +1121,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/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b3bf4a58849..dbaf2bc6f6a 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -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/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1526e2fdeb9..aa13210b633 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1360,31 +1360,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. @@ -2956,23 +2958,24 @@ for symbols generated by the byte compiler itself." (list body)))) ;; Special macro-expander used during byte-compilation. -(defun byte-compile-macroexpand-declare-function (fn file &rest args) - (let ((gotargs (and (consp args) (listp (car args)))) +(defun byte-compile-macroexpand-declare-function (fn file &optional arglist + fileonly) + (let ((gotargs (listp arglist)) (unresolved (assq fn byte-compile-unresolved-functions))) (when unresolved ; function was called before declaration (if (and gotargs (byte-compile-warning-enabled-p 'callargs)) - (byte-compile-arglist-warn fn (car args) nil) + (byte-compile-arglist-warn fn arglist nil) (setq byte-compile-unresolved-functions (delq unresolved byte-compile-unresolved-functions)))) (push (cons fn (if gotargs - (list 'declared (car args)) + (list 'declared arglist) t)) ; Arglist not specified. byte-compile-function-environment)) ;; We are stating that it _will_ be defined at runtime. (setq byte-compile-noruntime-functions (delq fn byte-compile-noruntime-functions)) ;; Delegate the rest to the normal macro definition. - (macroexpand `(declare-function ,fn ,file ,@args))) + (macroexpand `(declare-function ,fn ,file ,arglist ,fileonly))) ;; This is the recursive entry point for compiling each subform of an 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..3a81adeb6a6 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1638,6 +1638,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 +1809,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-generic.el b/lisp/emacs-lisp/cl-generic.el index 37edf45df38..0144daf3793 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -410,7 +410,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))))) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index a615f9a5854..0f7691af0f4 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -137,6 +137,9 @@ BODY can start with a bunch of keyword arguments. The following keyword :abbrev-table TABLE Use TABLE instead of the default (CHILD-abbrev-table). A nil value means to simply use the same abbrev-table as the parent. +:after-hook FORM + A single lisp form which is evaluated after the mode hooks have been + run. It should not be quoted. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: @@ -184,7 +187,8 @@ See Info node `(elisp)Derived Modes' for more details." (declare-abbrev t) (declare-syntax t) (hook (derived-mode-hook-name child)) - (group nil)) + (group nil) + (after-hook nil)) ;; Process the keyword args. (while (keywordp (car body)) @@ -192,6 +196,7 @@ See Info node `(elisp)Derived Modes' for more details." (`:group (setq group (pop body))) (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil)) (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil)) + (`:after-hook (setq after-hook (pop body))) (_ (pop body)))) (setq docstring (derived-mode-make-docstring @@ -272,7 +277,11 @@ No problems result if this variable is not bound. ,@body ) ;; Run the hooks, if any. - (run-mode-hooks ',hook))))) + (run-mode-hooks ',hook) + ,@(when after-hook + `((if delay-mode-hooks + (push ',after-hook delayed-after-hook-forms) + ,after-hook))))))) ;; PUBLIC: find the ultimate class of a derived mode. @@ -344,7 +353,7 @@ which more-or-less shadow%s %s's corresponding table%s." (format "`%s' " parent)) "might have run,\nthis mode ")) (format "runs the hook `%s'" hook) - ", as the final step\nduring initialization."))) + ", as the final or penultimate step\nduring initialization."))) (unless (string-match "\\\\[{[]" docstring) ;; And don't forget to put the mode's keymap. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 05229d2df04..38295c302ea 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -108,9 +108,10 @@ Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), or an expression that returns either a keymap or a list of - arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP - argument that is not a symbol, this macro defines the variable - MODE-map and gives it the value that KEYMAP specifies. + (KEY . BINDING) pairs where KEY and BINDING are suitable for + `define-key'. If you supply a KEYMAP argument that is not a + symbol, this macro defines the variable MODE-map and gives it + the value that KEYMAP specifies. BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e8484fa1f94..c283c168b5e 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 "25.2") + ;;; Form spec utilities. (defun get-edebug-spec (symbol) @@ -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))) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 6d4798b92f9..7ee897093b2 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -265,7 +265,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 631e4a437f2..fd8ae2abecb 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)))) @@ -1100,98 +1095,6 @@ method invocation orders of the involved classes." (cl-defmethod cl-generic-generalizers ((_specializer (head subclass))) (list eieio--generic-subclass-generalizer)) - -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "6aca3c1b5f751a01331761da45fc4f5c") -;;; 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..80ac8eff322 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 "25.2") (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 "25.2")) ;; 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 "25.2") ;; 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/ert-x.el b/lisp/emacs-lisp/ert-x.el index 2a2418fa7d2..67cb102a67c 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -285,6 +285,46 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (kill-buffer clone))))))) +(defmacro ert-with-function-mocked (name mock &rest body) + "Mocks function NAME with MOCK and run BODY. + +Once BODY finishes (be it normally by returning a value or +abnormally by throwing or signaling), the old definition of +function NAME is restored. + +BODY may further change the mock with `fset'. + +If MOCK is nil, the function NAME is mocked with a function +`ert-fail'ing when called. + +For example: + + ;; Regular use, function is mocked inside the BODY: + (should (eq 2 (+ 1 1))) + (ert-with-function-mocked ((+ (lambda (a b) (- a b)))) + (should (eq 0 (+ 1 1)))) + (should (eq 2 (+ 1 1))) + + ;; Macro correctly recovers from a throw or signal: + (should + (catch 'done + (ert-with-function-mocked ((+ (lambda (a b) (- a b)))) + (should (eq 0 (+ 1 1)))) + (throw 'done t))) + (should (eq 2 (+ 1 1))) +" + (declare (indent 2)) + (let ((old-var (make-symbol "old-var")) + (mock-var (make-symbol "mock-var"))) + `(let ((,old-var (symbol-function (quote ,name))) (,mock-var ,mock)) + (fset (quote ,name) + (or ,mock-var (lambda (&rest _) + (ert-fail (concat "`" ,(symbol-name name) + "' unexpectedly called."))))) + (unwind-protect + (progn ,@body) + (fset (quote ,name) ,old-var))))) + (provide 'ert-x) ;;; ert-x.el ends here diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7a914da3977..0308c9cd37c 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1470,7 +1470,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 +1490,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 +1517,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 +2481,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 f174a64fcba..71437ce89bd 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,11 +320,17 @@ LIBRARY should be a string (the name of the library)." (when (and def (not (test-completion def table))) (setq def nil)) (list - (completing-read (if def (format "Library name (default %s): " def) + (completing-read (if def + (format "Library name (default %s): " def) "Library name: ") - table nil nil nil nil def)))) - (let ((buf (find-file-noselect (find-library-name library)))) - (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) + table nil nil nil nil def) + current-prefix-arg))) + (prog1 + (funcall (if other-window + 'pop-to-buffer + 'pop-to-buffer-same-window) + (find-file-noselect (find-library-name library))) + (run-hooks 'find-function-after-hook))) ;;;###autoload (defun find-function-search-for-symbol (symbol type library) diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index e400b499036..3507a395436 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 @@ -134,7 +137,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 315b3d56343..4f3af2a7d7f 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/package.el b/lisp/emacs-lisp/package.el index 58973dfa920..8afe18f8d94 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." @@ -905,12 +906,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) @@ -2297,7 +2301,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/seq.el b/lisp/emacs-lisp/seq.el index 8362ddafd3f..92f0ad78566 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.14 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -144,6 +144,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)) @@ -206,6 +218,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 '())) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 654f234fa62..31fc67ec815 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -417,6 +417,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 +435,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 +572,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/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/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 93cf3b0fb10..6951dbb708b 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 @@ -1903,6 +1902,7 @@ Undo previous insertion and inserts new." "Quote string: " nil 'viper-quote-region-history + ;; FIXME: Use comment-region. (cond ((string-match "tex.*-mode" (symbol-name major-mode)) "%%") ((string-match "java.*-mode" (symbol-name major-mode)) "//") ((string-match "perl.*-mode" (symbol-name major-mode)) "#") @@ -1984,13 +1984,13 @@ Undo previous insertion and inserts new." (funcall hook) )) -;; This is a temp hook that uses free variables init-message and viper-initial. +;; This is a temp hook that uses free variables viper--init-message and viper-initial. ;; A dirty feature, but it is the simplest way to have it do the right thing. -;; The INIT-MESSAGE and VIPER-INITIAL vars come from the scope set by +;; The VIPER--INIT-MESSAGE and VIPER-INITIAL vars come from the scope set by ;; viper-read-string-with-history (defun viper-minibuffer-standard-hook () - (if (stringp init-message) - (viper-tmp-insert-at-eob init-message)) + (if (stringp viper--init-message) + (viper-tmp-insert-at-eob viper--init-message)) (when (stringp viper-initial) ;; don't wait if we have unread events or in kbd macro (or unread-command-events @@ -2054,7 +2054,7 @@ To turn this feature off, set this variable to nil." (viper-minibuffer-real-start) (point-max))) found key cmd suff) (goto-char (point-max)) - (if (and viper-smart-suffix-list (string-match "\\.$" file)) + (if (and viper-smart-suffix-list (string-match "\\.\\'" file)) (progn (while (and (not found) (< count len)) (setq suff (nth count viper-smart-suffix-list) @@ -2098,10 +2098,10 @@ problems." ;;; Reading string with history -(defun viper-read-string-with-history (prompt &optional viper-initial +(defun viper-read-string-with-history (prompt &optional initial history-var default keymap init-message) - ;; Read string, prompting with PROMPT and inserting the VIPER-INITIAL + ;; Read string, prompting with PROMPT and inserting the INITIAL ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the ;; input is an empty string. ;; Default value is displayed until the user types something in the @@ -2109,14 +2109,16 @@ problems." ;; KEYMAP is used, if given, instead of minibuffer-local-map. ;; INIT-MESSAGE is the message temporarily displayed after entering the ;; minibuffer. - (let ((minibuffer-setup-hook + (let ((viper-initial initial) + (viper--init-message init-message) + (minibuffer-setup-hook ;; stolen from add-hook (let ((old (if (boundp 'minibuffer-setup-hook) minibuffer-setup-hook nil))) (cons - 'viper-minibuffer-standard-hook + #'viper-minibuffer-standard-hook (if (or (not (listp old)) (eq (car old) 'lambda)) (list old) old)))) (val "") @@ -2124,14 +2126,15 @@ problems." temp-msg) (setq keymap (or keymap minibuffer-local-map) - viper-initial (or viper-initial "") + initial (or initial "") + viper-initial initial temp-msg (if default (format "(default %s) " default) "")) (setq viper-incomplete-ex-cmd nil) (setq val (read-from-minibuffer prompt - (concat temp-msg viper-initial val padding) + (concat temp-msg initial val padding) keymap nil history-var)) (setq minibuffer-setup-hook nil padding (viper-array-to-string (this-command-keys)) @@ -2832,7 +2835,7 @@ On reaching beginning of line, stop and signal error." (viper-looking-at-alphasep)))))) -(defun viper-end-of-word (arg &optional careful) +(defun viper-end-of-word (arg &optional _careful) "Move point to end of current word." (interactive "P") (viper-leave-region-active) @@ -3668,17 +3671,14 @@ the Emacs binding of `/'." (setq msg "Search style remains unchanged"))) (princ msg t))) -(defun viper-set-searchstyle-toggling-macros (unset &optional major-mode) +(defun viper-set-searchstyle-toggling-macros (unset &optional mode) "Set the macros for toggling the search style in Viper's vi-state. The macro that toggles case sensitivity is bound to `//', and the one that toggles regexp search is bound to `///'. With a prefix argument, this function unsets the macros. -If MAJOR-MODE is set, set the macros only in that major mode." +If MODE is set, set the macros only in that major mode." (interactive "P") - (let (scope) - (if (and major-mode (symbolp major-mode)) - (setq scope major-mode) - (setq scope 't)) + (let ((scope (if (and mode (symbolp mode)) mode t))) (or noninteractive (if (not unset) (progn @@ -4871,33 +4871,36 @@ Please, specify your level now: ")) ;;; Bug Report +(defvar reporter-prompt-for-summary-p) + (defun viper-submit-report () "Submit bug report on Viper." (interactive) + (defvar viper-device-type) + (defvar viper-color-display-p) + (defvar viper-frame-parameters) + (defvar viper-minibuffer-emacs-face) + (defvar viper-minibuffer-vi-face) + (defvar viper-minibuffer-insert-face) (let ((reporter-prompt-for-summary-p t) (viper-device-type (viper-device-type)) - color-display-p frame-parameters - minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face - varlist salutation window-config) - - ;; If mode info is needed, add variable to `let' and then set it below, - ;; like we did with color-display-p. - (setq color-display-p (if (viper-window-display-p) + (viper-color-display-p (if (viper-window-display-p) (viper-color-display-p) - 'non-x) - minibuffer-vi-face (if (viper-has-face-support-p) - (viper-get-face viper-minibuffer-vi-face) - 'non-x) - minibuffer-insert-face (if (viper-has-face-support-p) - (viper-get-face - viper-minibuffer-insert-face) - 'non-x) - minibuffer-emacs-face (if (viper-has-face-support-p) - (viper-get-face - viper-minibuffer-emacs-face) - 'non-x) - frame-parameters (if (fboundp 'frame-parameters) - (frame-parameters (selected-frame)))) + 'non-x)) + (viper-frame-parameters (if (fboundp 'frame-parameters) + (frame-parameters (selected-frame)))) + (viper-minibuffer-emacs-face (if (viper-has-face-support-p) + (viper-get-face + viper-minibuffer-emacs-face) + 'non-x)) + (viper-minibuffer-vi-face (if (viper-has-face-support-p) + (viper-get-face viper-minibuffer-vi-face) + 'non-x)) + (viper-minibuffer-insert-face (if (viper-has-face-support-p) + (viper-get-face + viper-minibuffer-insert-face) + 'non-x)) + varlist salutation window-config) (setq varlist (list 'viper-vi-minibuffer-minor-mode 'viper-insert-minibuffer-minor-mode @@ -4942,11 +4945,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-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..a0bba9a22e6 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,15 @@ 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 (list function advice) viper--advice-list)) + +(defun viper--deactivate-advice-list () + (mapc #'advice-remove viper--advice-list) + (setq viper--advice-list nil)) (defun viper-go-away () "De-Viperize Emacs. @@ -697,7 +697,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 +769,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 +781,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 +813,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 +823,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 +869,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 +887,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 +916,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 +932,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 +952,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 +971,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 +994,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 +1050,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 +1073,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 +1085,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 +1100,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 @@ -1318,97 +1295,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.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..9179e04dcc1 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -81,57 +81,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/erc/erc-backend.el b/lisp/erc/erc-backend.el index 6d508e203f4..bbb7ccbc99d 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' hashtable." (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' hashtable." " " (erc-response.command parsed) " " - (mapconcat 'identity (erc-response.command-args parsed) + (mapconcat #'identity (erc-response.command-args parsed) " ")))) (erc-display-message parsed 'notice proc line))) @@ -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 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..9152527d4be 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -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-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-mode.el b/lisp/eshell/esh-mode.el index 388bc747367..074b94cc75d 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) 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 fddc036c13e..4193c1e27e8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -98,7 +98,31 @@ a font height that isn't optimal." (defcustom face-font-family-alternatives (mapcar (lambda (arg) (mapcar 'purecopy arg)) '(("Monospace" "courier" "fixed") + + ;; Monospace Serif is an Emacs invention, intended to work around + ;; portability problems when using Courier. It should work well + ;; when combined with Monospaced and with other standard fonts. + ("Monospace Serif" + + ;; This looks good on GNU/Linux. + "Courier 10 Pitch" + ;; This looks good on MS-Windows and OS X. + "Consolas" + ;; This looks good on OS X. "Courier" looks good too, but is + ;; jagged on GNU/Linux and so is listed later as "courier". + "Courier Std" + ;; Although these are anti-aliased, they are a bit faint compared + ;; to the above. + "FreeMono" "Nimbus Mono L" + ;; These are aliased and look jagged. + "courier" "fixed" + ;; Omit Courier New, as it is the default MS-Windows font and so + ;; would look no different, and is pretty faint on other platforms. + ) + + ;; This is present for backward compatibility. ("courier" "CMU Typewriter Text" "fixed") + ("Sans Serif" "helv" "helvetica" "arial" "fixed") ("helv" "helvetica" "arial" "fixed"))) "Alist of alternative font family names. @@ -979,31 +1003,41 @@ of the default face. Value is FACE." "Read one or more face names, prompting with PROMPT. PROMPT should not end in a space or a colon. -Return DEFAULT if the user enters the empty string. -If DEFAULT is non-nil, it should be a single face or a list of face names -\(symbols or strings). In the latter case, return the `car' of DEFAULT -\(if MULTIPLE is nil, see below), or DEFAULT (if MULTIPLE is non-nil). - -If MULTIPLE is non-nil, this function uses `completing-read-multiple' -to read multiple faces with \"[ \\t]*,[ \\t]*\" as the separator regexp -and it returns a list of face names. Otherwise, it reads and returns -a single face name." - (if (and default (not (stringp default))) - (setq default - (cond ((symbolp default) - (symbol-name default)) - (multiple - (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) - default ", ")) - ;; If we only want one, and the default is more than one, - ;; discard the unwanted ones. - (t (symbol-name (car default)))))) +If DEFAULT is non-nil, it should be a face (a symbol) or a face +name (a string). It can also be a list of faces or face names. + +If MULTIPLE is non-nil, the return value from this function is a +list of faces. Otherwise a single face is returned. + +If the user enter the empty string at the prompt, DEFAULT is +returned after a possible transformation according to MULTIPLE. +That is, if DEFAULT is a list and MULTIPLE is nil, the first +element of DEFAULT is returned. If DEFAULT isn't a list, but +MULTIPLE is non-nil, a one-element list containing DEFAULT is +returned. Otherwise, DEFAULT is returned verbatim." + (unless (listp default) + (setq default (list default))) + (when default + (setq default + (if multiple + (mapconcat (lambda (f) (if (symbolp f) (symbol-name f) f)) + default ", ") + ;; If we only want one, and the default is more than one, + ;; discard the unwanted ones. + (setq default (car default)) + (if (symbolp default) + (symbol-name default) + default)))) (when (and default (not multiple)) (require 'crm) ;; For compatibility with `completing-read-multiple' use `crm-separator' ;; to define DEFAULT if MULTIPLE is nil. (setq default (car (split-string default crm-separator t)))) + ;; Older versions of `read-face-name' did not append ": " to the + ;; prompt, so there are third party libraries that have that in the + ;; prompt. If so, remove it. + (setq prompt (replace-regexp-in-string ": ?\\'" "" prompt)) (let ((prompt (if default (format-message "%s (default `%s'): " prompt default) (format "%s: " prompt))) @@ -1792,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) @@ -1896,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))) @@ -2280,6 +2342,11 @@ If you set `term-file-prefix' to nil, this function does nothing." "The basic fixed-pitch face." :group 'basic-faces) +(defface fixed-pitch-serif + '((t :family "Monospace Serif")) + "The basic fixed-pitch face with serifs." + :group 'basic-faces) + (defface variable-pitch '((((type w32)) ;; This is a kludgy workaround for an issue discussed in @@ -2411,6 +2478,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 "25.2") + (defgroup mode-line-faces nil "Faces used in the mode line." :group 'mode-line @@ -2674,6 +2749,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 Apropos output." + :group 'basic-faces + :version "25.2") + ;; Faces for TTY menus. (defface tty-menu-enabled-face '((t diff --git a/lisp/ffap.el b/lisp/ffap.el index 8343b475c1b..7013e6e8ba4 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -570,7 +570,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) diff --git a/lisp/files-x.el b/lisp/files-x.el index f0102fd83af..05ad7f57c57 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. diff --git a/lisp/files.el b/lisp/files.el index a18832899c9..b737c101588 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2316,14 +2316,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 @@ -3297,11 +3304,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. @@ -3319,7 +3330,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. @@ -3327,18 +3338,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 + (eq handle-mode t))) + (eq handle-mode t))) ;; Look for "Local variables:" line in last page. (save-excursion (goto-char (point-max)) @@ -3393,7 +3405,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" @@ -3410,7 +3422,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. @@ -3432,6 +3444,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) @@ -3440,8 +3453,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))))) @@ -3668,7 +3681,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) @@ -3720,8 +3733,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. @@ -3736,78 +3782,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." @@ -3830,17 +3893,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 @@ -6616,11 +6679,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 "25.2" + :group 'convenience) (defcustom confirm-kill-emacs nil "How to ask for confirmation when leaving Emacs. @@ -6679,7 +6745,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. @@ -7036,6 +7103,78 @@ 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-attribute'. +The value is either t for directory, string (name linked to) for +symbolic link, or nil." + (nth 0 attributes)) + +(defsubst file-attribute-link-number (attributes) + "Return the number of links in ATTRIBUTES returned by `file-attribute'." + (nth 1 attributes)) + +(defsubst file-attribute-user-id (attributes) + "The UID field in ATTRIBUTES returned by `file-attribute'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 2 attributes)) + +(defsubst file-attribute-group-id (attributes) + "The GID field in ATTRIBUTES returned by `file-attribute'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 3 attributes)) + +(defsubst file-attribute-access-time (attributes) + "The last access time in ATTRIBUTES returned by `file-attribute'. +This a list of integers (HIGH LOW USEC PSEC) in the same style +as (current-time)." + (nth 4 attributes)) + +(defsubst file-attribute-modification-time (attributes) + "The modification time in ATTRIBUTES returned by `file-attribute'. +This is the time of the last change to the file's contents, and +is a list of integers (HIGH LOW USEC PSEC) in the same style +as (current-time)." + (nth 5 attributes)) + +(defsubst file-attribute-status-change-time (attributes) + "The status modification time in ATTRIBUTES returned by `file-attribute'. +This is the time of last change to the file's attributes: owner +and group, access mode bits, etc, and is a list of integers (HIGH +LOW USEC PSEC) in the same style as (current-time)." + (nth 6 attributes)) + +(defsubst file-attribute-size (attributes) + "The size (in bytes) in ATTRIBUTES returned by `file-attribute'. +This is a floating point number if the size is too large for an integer." + (nth 7 attributes)) + +(defsubst file-attribute-modes (attributes) + "The file modes in ATTRIBUTES returned by `file-attribute'. +This is a string of ten letters or dashes as in ls -l." + (nth 8 attributes)) + +(defsubst file-attribute-inode-number (attributes) + "The inode number in ATTRIBUTES returned by `file-attribute'. +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-attribute'. +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)) + (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/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/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..7aa52794e4c 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 + "25.2") (provide 'gmm-utils) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 80753c11813..6c1915ba909 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" @@ -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))) @@ -2713,7 +2679,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 66b1e38da2e..c103e1cbb91 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -266,18 +266,11 @@ 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 -")) +; 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." @@ -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) @@ -711,13 +702,6 @@ The following additional specs are available: :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." :type 'hook @@ -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))) @@ -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 "25.2" :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 "25.2" :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,30 +7616,28 @@ 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 locale library `%s'." url) (find-file-read-only file)))) @@ -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..ba72d820431 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -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..050e8cd7895 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -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..4f05d2ee9d5 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) @@ -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-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..2f387fc336b 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -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..12ca9fcad66 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -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-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..c1dd333ee50 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -28,7 +28,6 @@ (require 'cl)) (require 'mm-util) -(require 'gnus-ems) (require 'gnus-util) (require 'gnus) 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..53a4ca75042 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) @@ -224,11 +223,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 @@ -427,8 +421,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. @@ -535,10 +528,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 +622,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 @@ -798,32 +788,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 +889,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 +944,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 +961,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 +1079,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 +1141,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 +1203,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 +1368,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 +1392,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 +1484,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 +1568,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 +1596,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 +1642,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 +1755,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 +1982,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 +2194,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 +2356,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 +2442,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 +2720,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 +2838,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 +2909,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 +3052,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 +3131,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 +3237,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 +3998,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 +4120,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 +4492,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 +4530,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 +4634,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-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..8cabe01168b 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -28,7 +28,6 @@ (eval-when-compile (require 'cl)) (require 'gnus) -(require 'gnus-ems) (require 'message) (require 'gnus-art) (require 'gnus-util) @@ -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..1b0acd24030 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -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..c636c7eb32b 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 @@ -1036,7 +1030,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..fc85bd69baf 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) @@ -47,9 +44,6 @@ :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." :type 'boolean @@ -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 @@ -419,11 +403,6 @@ Two predefined functions are available: :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 d3a1139902b..14059ac566b 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) @@ -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..30c7debc8e5 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -156,7 +156,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 @@ -280,10 +280,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) @@ -310,7 +308,7 @@ The following commands are available: " (cloud)" ""))) (beginning-of-line) - (gnus-add-text-properties + (add-text-properties (point) (prog1 (1+ (point)) ;; Insert the text. @@ -804,7 +802,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (mm-string-as-unibyte + (string-as-unibyte (buffer-substring (point) (progn @@ -817,7 +815,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 +863,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 +880,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) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 34a5ff6cbac..a57797260ad 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -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..67b4268dbd9 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) @@ -948,13 +944,6 @@ This hook is run before any variables are set in the summary buffer." :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." :group 'gnus-summary-visual @@ -1072,9 +1061,7 @@ automatically when it is selected." :group 'gnus-summary :type 'hook) -(defcustom gnus-summary-display-arrow - (and (fboundp 'display-graphic-p) - (display-graphic-p)) +(defcustom gnus-summary-display-arrow (display-graphic-p) "*If non-nil, display an arrow highlighting the current article." :version "22.1" :group 'gnus-summary @@ -1171,14 +1158,19 @@ which it may alter in any way." (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." +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 @@ -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] @@ -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. @@ -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. @@ -7814,9 +7763,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 +7791,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 +8315,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 +8617,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 +9029,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 +9078,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 +9381,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 +9556,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 +9646,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 +9807,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 +9816,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 +9930,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 +9940,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 +10523,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 +10763,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 +11117,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 +11649,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 +12053,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 +12224,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 +12253,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 +12379,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 +12523,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 +12836,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 +13037,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 index cd8a753607a..249eb087b0b 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el @@ -201,27 +201,6 @@ KVDATA must be an alist." (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") diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 24ae4cfae48..39236594eb7 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, @@ -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..7d3c7089225 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 "25.2")) + (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. @@ -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) @@ -1770,25 +1603,6 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp (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..f199d1659d9 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -217,11 +217,8 @@ 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) @@ -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..9c950a9e3e9 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -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..edf46f173b1 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." @@ -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. @@ -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..ebc9c97b656 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -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..1ca7c5cafef 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -40,16 +40,17 @@ ;; 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) -(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 @@ -296,7 +297,7 @@ any confusion." regexp)) (defcustom message-subject-re-regexp - "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" + "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" "*Regexp matching \"Re: \" in the subject line." :group 'message-various :link '(custom-manual "(message)Message Headers") @@ -1249,11 +1250,7 @@ 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)) + mail-default-headers) "*A string of header lines to be inserted in outgoing mails." :version "23.2" :group 'message-headers @@ -1346,20 +1343,23 @@ If nil, Message won't auto-save." :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" "25.2") -(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,7 +1368,9 @@ 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. @@ -1630,11 +1632,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 +1673,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 +1687,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. @@ -1761,25 +1757,9 @@ no, only reply back to the author." :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 "25.2" :group 'message-headers :link '(custom-manual "(message)IDNA") :type '(choice (const :tag "Ask" ask) @@ -1910,12 +1890,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 +1898,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 +1906,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 +1920,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 +2141,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 +2180,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 +2598,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 +2705,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 +2741,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 +2762,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 +2815,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 +2850,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 +2947,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 +2985,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 +3007,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 +3099,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 +3414,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 +3701,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 +3863,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 +3960,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 +4131,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") @@ -4371,8 +4219,7 @@ conformance." (const "invalid") (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 +4265,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 +4279,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 +4327,24 @@ 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 + (when (or (string= "" address) (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)))) + (string-match "@.*@" 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 +4361,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 @@ -5452,7 +5294,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? ") @@ -5818,10 +5660,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 +5753,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 +5839,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 +5851,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 +5885,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 +5959,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 +5970,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 +6086,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 +6229,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 behaviour 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 +6362,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 +6372,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 +6790,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 +7085,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 +7117,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 +7204,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 +7350,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 +7413,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 +7551,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 +7626,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 +7805,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 +7865,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)))) @@ -8065,10 +7923,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)) @@ -8114,41 +7970,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 +7999,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 +8092,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 +8103,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 +8197,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 +8310,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)) @@ -8582,7 +8399,7 @@ Used in `message-simplify-recipients'." (goto-char (point-min)) (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t) (let ((file (match-string 1)) - (edges (message-window-inside-pixel-edges + (edges (window-inside-pixel-edges (get-buffer-window (current-buffer))))) (put-image (create-image @@ -8594,10 +8411,6 @@ Used in `message-simplify-recipients'." (match-beginning 0) " "))))))) -(when (featurep 'xemacs) - (require 'messagexmas) - (message-xmas-redefine)) - (provide 'message) (run-hooks 'message-load-hook) 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 3ea63c74034..f45337dc042 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) @@ -778,7 +767,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 +851,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 +882,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 +909,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 +939,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 +1138,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 +1301,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 +1347,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 +1445,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 +1561,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 +1781,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 +1805,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)) @@ -1894,6 +1835,7 @@ If RECURSIVE, search recursively." ,(point-max-marker)))))))) (defvar shr-map) +(defvar shr-image-map) (autoload 'widget-convert-button "wid-edit") @@ -1907,7 +1849,8 @@ If RECURSIVE, search recursively." (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - :keymap shr-map + ;;; FIXME Should only use the image map on images. + :keymap shr-image-map (get-text-property start 'shr-url)) (put-text-property start end 'local-map nil) (dolist (overlay (overlays-at start)) 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..69192667948 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -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) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 106d010a3dc..c0f8742504e 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,8 +414,7 @@ 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 @@ -887,45 +441,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 +474,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 +490,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 +551,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 +592,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 +607,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 +629,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 +636,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 +665,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 +694,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 +711,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 +754,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 "25.2") (defvar mm-image-load-path-cache nil) @@ -1455,54 +776,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 +861,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 +883,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..049890e2e30 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -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..c62ea958da6 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,17 @@ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided) +(defvar mm-w3m-standalone-supports-m17n-p 'undecided "*T means the w3m command supports the m17n feature.") (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 +260,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 +440,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 +458,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 +492,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..97cc87d06e3 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) @@ -636,6 +631,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 +641,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 +654,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 +664,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 +1103,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 +1146,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 +1161,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 +1349,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 +1545,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 +1560,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 +1570,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..ffe788133e4 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 @@ -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..f10b6fa3df8 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -203,12 +203,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..191a90892f3 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. @@ -621,8 +622,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 +727,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 +779,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 +821,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." @@ -898,7 +877,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 +981,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 +1071,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 +1087,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..6c2d11396cb 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -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..94589e1734d 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -368,34 +368,7 @@ messages will be shown to indicate the current status." :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") @@ -628,14 +601,7 @@ 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)))) +(defvar nnmail-pathname-coding-system nil "*Coding system for file name.") (defun nnmail-find-file (file) @@ -697,7 +663,7 @@ 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) @@ -1173,7 +1139,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 +1245,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"))) @@ -1957,10 +1923,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 +2018,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..cebdc95876f 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)) @@ -537,8 +537,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 +656,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 +848,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 +955,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 +986,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 +1117,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 +1279,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 +1397,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 +1491,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..6168e5a281b 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -37,10 +37,7 @@ (require 'mm-url) (require 'rfc2047) (require 'mml) -(eval-when-compile - (ignore-errors - (require 'xml))) -(eval '(require 'xml)) +(require 'xml) (nnoo-declare nnrss) @@ -114,11 +111,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 +240,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 +291,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 +368,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 +411,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 +582,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 +756,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 +803,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 +953,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..fa5f0e6c582 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 @@ -344,16 +337,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 +1260,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 +1292,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/smiley.el b/lisp/gnus/smiley.el index 403447f3963..b5450a82bdd 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)) @@ -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..9bec58a46f2 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -120,25 +120,10 @@ (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) @@ -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 6e8a108b506..040152a2c9f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -699,17 +699,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: ") + obarray + (lambda (vv) + ;; In case the variable only exists in the buffer + ;; the command we switch back to that buffer before + ;; we examine the variable. + (with-current-buffer orig-buffer + (or (get vv 'variable-documentation) + (and (boundp vv) (not (keywordp vv)))))) + t nil nil + (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) (let (file-name) @@ -758,9 +764,8 @@ it is displayed along with the global value." (unless valvoid (with-current-buffer standard-output (setq val-start-pos (point)) - (princ "value is ") - (let ((from (point)) - (line-beg (line-beginning-position)) + (princ "value is") + (let ((line-beg (line-beginning-position)) (print-rep (let ((rep (let ((print-quoted t)) @@ -769,17 +774,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))) @@ -910,29 +915,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")))) @@ -1098,7 +1109,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)))) @@ -1125,6 +1142,7 @@ BUFFER should be a buffer or a buffer name." "character(s)\tcategory mnemonics\n" "------------\t------------------") (describe-vector table 'help-describe-category-set) + (set-marker help-button-cache (point)) (insert "Legend of category mnemonics:\n") (dotimes (i 95) (let ((elt (aref docs i))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7b95e5fb04e..e008698618c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -202,6 +202,7 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun type file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) @@ -231,6 +232,7 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let ((location (find-variable-noselect var file))) (pop-to-buffer (car location)) + (run-hooks 'find-function-after-hook) (if (cdr location) (goto-char (cdr location)) (message "Unable to find location in file")))) diff --git a/lisp/help.el b/lisp/help.el index 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/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/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 fc309bd62ee..431300c81c2 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -90,6 +90,8 @@ ;; (`font-lock-fontify-region') (require 'cus-edit) +(require 'htmlfontify-loaddefs) + (defconst htmlfontify-version 0.21) (defconst hfy-meta-tags @@ -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..6052bf32ce3 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1403,7 +1403,7 @@ You can then feed the file name(s) to other commands with \\[yank]." (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) + (type (cond ((or (null arg) (zerop arg)) 'full) ((= arg 4) 'relative) @@ -1412,20 +1412,23 @@ You can then feed the file name(s) to other commands with \\[yank]." (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))) - "")) - " ")))) + (concat ibuffer-copy-filename-as-kill-result + (let ((name (buffer-file-name buf))) + (cond (name + (concat + (pcase type + (`full + name) + (`relative + (file-relative-name + name (or ibuffer-default-directory + default-directory))) + (_ + (file-name-nondirectory name))) " ")) + (t ""))))))) + (when (not (zerop (length ibuffer-copy-filename-as-kill-result))) + (setq ibuffer-copy-filename-as-kill-result + (substring ibuffer-copy-filename-as-kill-result 0 -1))) (kill-new ibuffer-copy-filename-as-kill-result)))) (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) @@ -1598,7 +1601,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/ibuffer.el b/lisp/ibuffer.el index 9d23e64cd81..dd2687c4d8c 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) @@ -699,16 +701,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"))) @@ -819,6 +815,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)) @@ -1742,7 +1741,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 @@ -2611,382 +2616,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/image-dired.el b/lisp/image-dired.el index a8274f52521..67b023dfd70 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1143,7 +1143,8 @@ image." (defun image-dired-next-line () "Move to next line and display properties." (interactive) - (forward-line 1) + (let ((goal-column (current-column))) + (next-line)) ;; 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 +1156,8 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." (interactive) - (forward-line -1) + (let ((goal-column (current-column))) + (previous-line)) ;; 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 diff --git a/lisp/image-mode.el b/lisp/image-mode.el index e549b49001e..a18b07ebe6a 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 @@ -372,8 +372,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) @@ -406,6 +406,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 +476,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 +493,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 +533,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 +562,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 +588,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 +619,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 +756,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." diff --git a/lisp/image.el b/lisp/image.el index 663afa7764e..ad219361366 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) @@ -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 "25.2") + +;; 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. @@ -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,11 @@ 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. + (when (> (- (float-time) target-time) 2) + (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 +817,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 +905,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 +942,95 @@ 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)) + 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.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 (+ (or (plist-get (cdr image) :rotation) 0) 90))))) + +(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/info.el b/lisp/info.el index 6426cfcf9ed..5a1cec11dd2 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -192,12 +192,8 @@ A header-line does not scroll with the rest of the buffer." (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes ;; Subdirectories in each directory tree that may contain info - ;; directories. Most of these are rather outdated. - ;; It ought to be fine to stop checking the "emacs" ones now, - ;; since this is Emacs and we have not installed info files - ;; into such directories for a looong time... - '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" - "emacs/" "lib/" "lib/emacs/")) + ;; directories. + '("share/" "")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) @@ -4236,7 +4232,7 @@ With a zero prefix arg, put the name inside a function call to `info'." "Syntax table used in `Info-mode'.") (defface Info-quoted - '((t :family "courier")) + '((t :inherit fixed-pitch-serif)) "Face used for quoted elements.") (defvar Info-mode-font-lock-keywords diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 00f68f0fbbf..58695654665 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1397,10 +1397,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/mule-cmds.el b/lisp/international/mule-cmds.el index e7c7049cd0a..28eec4f0df9 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) @@ -2978,6 +2978,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 @@ -2991,9 +3012,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 @@ -3006,13 +3029,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/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/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/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/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/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/ldefs-boot.el b/lisp/ldefs-boot.el index b1f0432ca9d..c9986bef54c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,7 +3,7 @@ ;;; Code: -;;;### (autoloads nil "5x5" "play/5x5.el" (22330 59913 969323 446000)) +;;;### (autoloads nil "5x5" "play/5x5.el" (0 0 0 0)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -65,8 +65,7 @@ should return a grid vector array that is the new solution. ;;;*** -;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (22330 59913 -;;;;;; 977323 421000)) +;;;### (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" "\ @@ -85,8 +84,7 @@ Ada mode is the major mode for editing Ada code. ;;;*** -;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -96,8 +94,7 @@ Insert a descriptive header at the top of the file. ;;;*** -;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (22331 17372 -;;;;;; 88369 281000)) +;;;### (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" "\ @@ -108,8 +105,7 @@ Completion is available. ;;;*** -;;;### (autoloads nil "add-log" "vc/add-log.el" (22331 17372 121369 -;;;;;; 164000)) +;;;### (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 +148,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. @@ -238,8 +238,7 @@ old-style time formats for entries are supported. ;;;*** -;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (22331 17371 -;;;;;; 987369 640000)) +;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -374,7 +373,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) ;;;*** -;;;### (autoloads nil "align" "align.el" (22331 17371 979369 668000)) +;;;### (autoloads nil "align" "align.el" (0 0 0 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -479,7 +478,7 @@ indented. ;;;*** -;;;### (autoloads nil "allout" "allout.el" (22330 59913 751324 119000)) +;;;### (autoloads nil "allout" "allout.el" (0 0 0 0)) ;;; Generated autoloads from allout.el (push (purecopy '(allout 2 3)) package--builtin-versions) @@ -839,8 +838,8 @@ for details on preparing Emacs for automatic allout activation. ;;;*** -;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (22330 -;;;;;; 59913 751324 119000)) +;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from allout-widgets.el (push (purecopy '(allout-widgets 1 0)) package--builtin-versions) @@ -898,8 +897,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** -;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (22330 59913 952323 -;;;;;; 498000)) +;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (0 0 0 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -920,8 +918,7 @@ directory, so that Emacs will know its current contents. ;;;*** -;;;### (autoloads nil "animate" "play/animate.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "animate" "play/animate.el" (0 0 0 0)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -953,8 +950,7 @@ the buffer *Birthday-Present-for-Name*. ;;;*** -;;;### (autoloads nil "ansi-color" "ansi-color.el" (22330 59913 751324 -;;;;;; 119000)) +;;;### (autoloads nil "ansi-color" "ansi-color.el" (0 0 0 0)) ;;; Generated autoloads from ansi-color.el (push (purecopy '(ansi-color 3 4 2)) package--builtin-versions) @@ -980,8 +976,8 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** -;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (22330 -;;;;;; 59913 978323 418000)) +;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/antlr-mode.el (push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions) @@ -1017,8 +1013,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** -;;;### (autoloads nil "appt" "calendar/appt.el" (22331 17371 981369 -;;;;;; 661000)) +;;;### (autoloads nil "appt" "calendar/appt.el" (0 0 0 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1039,8 +1034,7 @@ ARG is positive, otherwise off. ;;;*** -;;;### (autoloads nil "apropos" "apropos.el" (22331 17371 980369 -;;;;;; 665000)) +;;;### (autoloads nil "apropos" "apropos.el" (0 0 0 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1156,8 +1150,7 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads nil "arc-mode" "arc-mode.el" (22330 59913 751324 -;;;;;; 119000)) +;;;### (autoloads nil "arc-mode" "arc-mode.el" (0 0 0 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1177,7 +1170,7 @@ archive. ;;;*** -;;;### (autoloads nil "array" "array.el" (22330 59913 751324 119000)) +;;;### (autoloads nil "array" "array.el" (0 0 0 0)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1248,8 +1241,7 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads nil "artist" "textmodes/artist.el" (22330 59913 -;;;;;; 988323 387000)) +;;;### (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) @@ -1455,8 +1447,7 @@ Keymap summary ;;;*** -;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1483,9 +1474,8 @@ Special commands: ;;;*** -;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (22331 -;;;;;; 17372 13369 548000)) -;;; 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 @@ -1496,8 +1486,7 @@ let-binding.") ;;;*** -;;;### (autoloads nil "autoarg" "autoarg.el" (22330 59913 751324 -;;;;;; 119000)) +;;;### (autoloads nil "autoarg" "autoarg.el" (0 0 0 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1559,8 +1548,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** -;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1570,8 +1558,7 @@ Major mode for editing Autoconf configure.ac files. ;;;*** -;;;### (autoloads nil "autoinsert" "autoinsert.el" (22330 59913 751324 -;;;;;; 119000)) +;;;### (autoloads nil "autoinsert" "autoinsert.el" (0 0 0 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1610,8 +1597,8 @@ insert a template for the file depending on the mode of the buffer. ;;;*** -;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (22331 -;;;;;; 17371 988369 637000)) +;;;### (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) @@ -1662,17 +1649,16 @@ should be non-nil). ;;;*** -;;;### (autoloads nil "autorevert" "autorevert.el" (22331 17371 980369 -;;;;;; 665000)) +;;;### (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 +1678,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 +1697,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 +1715,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. @@ -1752,7 +1738,7 @@ specifies in the mode line. ;;;*** -;;;### (autoloads nil "avoid" "avoid.el" (22330 59913 751324 119000)) +;;;### (autoloads nil "avoid" "avoid.el" (0 0 0 0)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1790,8 +1776,7 @@ definition of \"random distance\".) ;;;*** -;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (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)) @@ -1809,8 +1794,7 @@ Run script using `bat-run' and `bat-run-args'. ;;;*** -;;;### (autoloads nil "battery" "battery.el" (22331 17371 980369 -;;;;;; 665000)) +;;;### (autoloads nil "battery" "battery.el" (0 0 0 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1846,8 +1830,8 @@ seconds. ;;;*** -;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (22330 -;;;;;; 59913 928323 572000)) +;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1883,8 +1867,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** -;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (22330 59913 -;;;;;; 990323 381000)) +;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1976,7 +1959,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. ;;;*** ;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (22330 59913 990323 381000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1986,8 +1969,7 @@ Major mode for editing BibTeX style files. ;;;*** -;;;### (autoloads nil "binhex" "mail/binhex.el" (22330 59913 947323 -;;;;;; 514000)) +;;;### (autoloads nil "binhex" "mail/binhex.el" (0 0 0 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -2011,8 +1993,7 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads nil "blackbox" "play/blackbox.el" (22330 59913 -;;;;;; 969323 446000)) +;;;### (autoloads nil "blackbox" "play/blackbox.el" (0 0 0 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2131,8 +2112,7 @@ a reflection. ;;;*** -;;;### (autoloads nil "bookmark" "bookmark.el" (22330 59913 737324 -;;;;;; 162000)) +;;;### (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) @@ -2323,9 +2303,9 @@ while loading. If you load a file that doesn't contain a proper bookmark alist, you will corrupt Emacs's bookmark list. Generally, you should only load in files that were created with the bookmark functions in the first -place. Your own personal bookmark file, specified by the variable -`bookmark-default-file', is maintained automatically by Emacs; you -shouldn't need to load it explicitly. +place. Your own personal bookmark file, `~/.emacs.bmk', is +maintained automatically by Emacs; you shouldn't need to load it +explicitly. If you load a file containing bookmarks with the same names as bookmarks already present in your Emacs, the new bookmarks will get @@ -2356,8 +2336,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;*** -;;;### (autoloads nil "browse-url" "net/browse-url.el" (22330 59913 -;;;;;; 952323 498000)) +;;;### (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 "\ @@ -2705,7 +2684,7 @@ from `browse-url-elinks-wrapper'. ;;;*** -;;;### (autoloads nil "bs" "bs.el" (22330 59913 751324 119000)) +;;;### (autoloads nil "bs" "bs.el" (0 0 0 0)) ;;; Generated autoloads from bs.el (push (purecopy '(bs 1 17)) package--builtin-versions) @@ -2746,8 +2725,7 @@ name of buffer configuration. ;;;*** -;;;### (autoloads nil "bubbles" "play/bubbles.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "bubbles" "play/bubbles.el" (0 0 0 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2769,7 +2747,7 @@ columns on its right towards the left. ;;;*** ;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el" -;;;;;; (22330 59913 978323 418000)) +;;;;;; (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))))) @@ -2789,8 +2767,8 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;*** -;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (22331 -;;;;;; 17371 989369 633000)) +;;;### (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) @@ -2910,16 +2888,15 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (22330 -;;;;;; 59913 919323 600000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (22330 59913 -;;;;;; 919323 600000)) +;;;### (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) @@ -2930,8 +2907,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (22331 -;;;;;; 17371 981369 661000)) +;;;### (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" "\ @@ -2943,7 +2920,7 @@ from the cursor position. ;;;*** -;;;### (autoloads nil "calc" "calc/calc.el" (22330 59913 918323 603000)) +;;;### (autoloads nil "calc" "calc/calc.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -3029,8 +3006,7 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (22330 59913 -;;;;;; 918323 603000)) +;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (0 0 0 0)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -3040,8 +3016,7 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads nil "calculator" "calculator.el" (22331 17371 981369 -;;;;;; 661000)) +;;;### (autoloads nil "calculator" "calculator.el" (0 0 0 0)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -3052,8 +3027,7 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads nil "calendar" "calendar/calendar.el" (22330 59913 -;;;;;; 919323 600000)) +;;;### (autoloads nil "calendar" "calendar/calendar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3096,8 +3070,7 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "canlock" "gnus/canlock.el" (22331 17372 13369 -;;;;;; 548000)) +;;;### (autoloads nil "canlock" "gnus/canlock.el" (0 0 0 0)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3114,8 +3087,8 @@ it fails. ;;;*** -;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (22331 -;;;;;; 17372 91369 271000)) +;;;### (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" "\ @@ -3125,8 +3098,7 @@ Return the syntactic context of the current line. ;;;*** -;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (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 "\ @@ -3224,8 +3196,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;*** -;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (22331 17372 -;;;;;; 92369 267000)) +;;;### (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" "\ @@ -3383,8 +3354,8 @@ Key bindings: ;;;*** -;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (22330 -;;;;;; 59913 978323 418000)) +;;;### (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" "\ @@ -3435,8 +3406,7 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (22331 17377 -;;;;;; 953348 450000)) +;;;### (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) @@ -3444,8 +3414,7 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "ccl" "international/ccl.el" (22330 59913 939323 -;;;;;; 538000)) +;;;### (autoloads nil "ccl" "international/ccl.el" (0 0 0 0)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3738,8 +3707,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** -;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3758,15 +3726,13 @@ Add the warnings that closure conversion would encounter. ;;;*** -;;;### (autoloads nil "cedet" "cedet/cedet.el" (22330 59913 920323 -;;;;;; 597000)) +;;;### (autoloads nil "cedet" "cedet/cedet.el" (0 0 0 0)) ;;; Generated autoloads from cedet/cedet.el (push (purecopy '(cedet 2 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cfengine.el (push (purecopy '(cfengine 1 4)) package--builtin-versions) @@ -3795,8 +3761,8 @@ Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents. ;;;*** -;;;### (autoloads nil "character-fold" "character-fold.el" (22330 -;;;;;; 59913 751324 119000)) +;;;### (autoloads nil "character-fold" "character-fold.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from character-fold.el (autoload 'character-fold-to-regexp "character-fold" "\ @@ -3815,15 +3781,14 @@ from which to start. ;;;*** -;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (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) ;;;*** ;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el" -;;;;;; (22331 17371 989369 633000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3840,8 +3805,8 @@ Returns non-nil if any false statements are found. ;;;*** -;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (22331 -;;;;;; 17371 990369 629000)) +;;;### (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) @@ -4051,8 +4016,8 @@ Find package keywords that aren't in `finder-known-keywords'. ;;;*** -;;;### (autoloads nil "china-util" "language/china-util.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (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" "\ @@ -4089,8 +4054,7 @@ Encode the text in the current buffer to HZ. ;;;*** -;;;### (autoloads nil "chistory" "chistory.el" (22330 59913 751324 -;;;;;; 119000)) +;;;### (autoloads nil "chistory" "chistory.el" (0 0 0 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4129,8 +4093,8 @@ and runs the normal hook `command-history-hook'. ;;;*** -;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (22330 -;;;;;; 59913 929323 569000)) +;;;### (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" "\ @@ -4213,8 +4177,7 @@ instead. ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (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) @@ -4232,8 +4195,7 @@ a future Emacs interpreter will be able to use it.") ;;;*** -;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (22330 59913 -;;;;;; 978323 418000)) +;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4253,8 +4215,7 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** -;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (0 0 0 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4274,7 +4235,7 @@ is run). ;;;*** -;;;### (autoloads nil "color" "color.el" (22330 59913 752324 116000)) +;;;### (autoloads nil "color" "color.el" (0 0 0 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4293,7 +4254,7 @@ If FRAME cannot display COLOR, return nil. ;;;*** -;;;### (autoloads nil "comint" "comint.el" (22331 17371 984369 651000)) +;;;### (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) "\ @@ -4394,8 +4355,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** -;;;### (autoloads nil "compare-w" "vc/compare-w.el" (22330 59914 -;;;;;; 8323 325000)) +;;;### (autoloads nil "compare-w" "vc/compare-w.el" (0 0 0 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4431,8 +4391,7 @@ on third call it again advances points to the next difference and so on. ;;;*** -;;;### (autoloads nil "compile" "progmodes/compile.el" (22331 17372 -;;;;;; 94369 260000)) +;;;### (autoloads nil "compile" "progmodes/compile.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4613,8 +4572,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** -;;;### (autoloads nil "completion" "completion.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "completion" "completion.el" (0 0 0 0)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4637,8 +4595,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (22330 -;;;;;; 59913 990323 381000)) +;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4793,8 +4751,7 @@ For details see `conf-mode'. Example: ;;;*** -;;;### (autoloads nil "cookie1" "play/cookie1.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "cookie1" "play/cookie1.el" (0 0 0 0)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4822,8 +4779,8 @@ and subsequent calls on the same file won't go to disk. ;;;*** -;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (22330 -;;;;;; 59913 929323 569000)) +;;;### (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) @@ -4861,8 +4818,8 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** -;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (22330 -;;;;;; 59913 979323 415000)) +;;;### (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) @@ -5060,8 +5017,7 @@ Run a `perldoc' on the word around point. ;;;*** -;;;### (autoloads nil "cpp" "progmodes/cpp.el" (22330 59913 979323 -;;;;;; 415000)) +;;;### (autoloads nil "cpp" "progmodes/cpp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -5079,8 +5035,7 @@ Edit display information for cpp conditionals. ;;;*** -;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (22330 59913 929323 -;;;;;; 569000)) +;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5106,8 +5061,7 @@ with empty strings removed. ;;;*** -;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (22331 17372 -;;;;;; 112369 196000)) +;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5123,8 +5077,7 @@ Major mode to edit \"Sassy CSS\" files. ;;;*** -;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (0 0 0 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5170,8 +5123,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;*** -;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (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" "\ @@ -5183,11 +5135,9 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** ;;;### (autoloads nil "cursor-sensor" "emacs-lisp/cursor-sensor.el" -;;;;;; (22330 59913 927323 575000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/cursor-sensor.el -(defvar cursor-sensor-inhibit nil) - (autoload 'cursor-intangible-mode "cursor-sensor" "\ Keep cursor outside of any `cursor-intangible' text property. @@ -5205,8 +5155,7 @@ is entering the area covered by the text-property property or leaving it. ;;;*** -;;;### (autoloads nil "cus-edit" "cus-edit.el" (22331 17371 985369 -;;;;;; 647000)) +;;;### (autoloads nil "cus-edit" "cus-edit.el" (0 0 0 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5456,6 +5405,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) @@ -5525,8 +5475,7 @@ The format is suitable for use with `easy-menu-define'. ;;;*** -;;;### (autoloads nil "cus-theme" "cus-theme.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "cus-theme" "cus-theme.el" (0 0 0 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5559,8 +5508,7 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** -;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (22330 59914 -;;;;;; 9323 322000)) +;;;### (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" "\ @@ -5570,8 +5518,7 @@ Mode used for cvs status output. ;;;*** -;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (22330 59913 980323 -;;;;;; 412000)) +;;;### (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) @@ -5616,8 +5563,8 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;*** -;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (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" "\ @@ -5645,8 +5592,7 @@ If the argument is nil, we return the display table to its standard state. ;;;*** -;;;### (autoloads nil "dabbrev" "dabbrev.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (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) @@ -5692,8 +5638,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** -;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (22330 59913 -;;;;;; 920323 597000)) +;;;### (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" "\ @@ -5703,7 +5648,7 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads nil "dbus" "net/dbus.el" (22330 59913 952323 498000)) +;;;### (autoloads nil "dbus" "net/dbus.el" (0 0 0 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5716,8 +5661,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (22330 59913 -;;;;;; 980323 412000)) +;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5843,8 +5787,7 @@ There is some minimal font-lock support (see vars ;;;*** -;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5887,8 +5830,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** -;;;### (autoloads nil "decipher" "play/decipher.el" (22330 59913 -;;;;;; 969323 446000)) +;;;### (autoloads nil "decipher" "play/decipher.el" (0 0 0 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5916,8 +5858,7 @@ The most useful commands are: ;;;*** -;;;### (autoloads nil "delim-col" "delim-col.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (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) @@ -5942,7 +5883,7 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads nil "delsel" "delsel.el" (22330 59913 737324 162000)) +;;;### (autoloads nil "delsel" "delsel.el" (0 0 0 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5975,8 +5916,7 @@ information on adapting behavior of commands in Delete Selection mode. ;;;*** -;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (22331 17371 -;;;;;; 991369 626000)) +;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -6042,8 +5982,7 @@ the first time the mode is used. ;;;*** -;;;### (autoloads nil "descr-text" "descr-text.el" (22330 59913 737324 -;;;;;; 162000)) +;;;### (autoloads nil "descr-text" "descr-text.el" (0 0 0 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6092,8 +6031,7 @@ This function is meant to be used as a value of ;;;*** -;;;### (autoloads nil "desktop" "desktop.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "desktop" "desktop.el" (0 0 0 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6321,8 +6259,7 @@ Revert to the last loaded desktop. ;;;*** -;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (22330 59913 -;;;;;; 938323 541000)) +;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (0 0 0 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6354,8 +6291,8 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** -;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (22330 -;;;;;; 59913 919323 600000)) +;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6397,7 +6334,7 @@ Major mode for editing the diary file. ;;;*** -;;;### (autoloads nil "diff" "vc/diff.el" (22330 59913 993323 372000)) +;;;### (autoloads nil "diff" "vc/diff.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-u") "\ @@ -6445,8 +6382,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** -;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (22330 59914 -;;;;;; 9323 322000)) +;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (0 0 0 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6478,7 +6414,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "dig" "net/dig.el" (22330 59913 952323 498000)) +;;;### (autoloads nil "dig" "net/dig.el" (0 0 0 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6489,7 +6425,7 @@ Optional arguments are passed to `dig-invoke'. ;;;*** -;;;### (autoloads nil "dired" "dired.el" (22331 17371 987369 640000)) +;;;### (autoloads nil "dired" "dired.el" (0 0 0 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6615,8 +6551,7 @@ Keybindings: ;;;*** -;;;### (autoloads nil "dirtrack" "dirtrack.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "dirtrack" "dirtrack.el" (0 0 0 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6646,8 +6581,7 @@ from `default-directory'. ;;;*** -;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6661,8 +6595,7 @@ redefine OBJECT if it is a symbol. ;;;*** -;;;### (autoloads nil "disp-table" "disp-table.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "disp-table" "disp-table.el" (0 0 0 0)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6783,8 +6716,7 @@ in `.emacs'. ;;;*** -;;;### (autoloads nil "dissociate" "play/dissociate.el" (22330 59913 -;;;;;; 969323 446000)) +;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6800,7 +6732,7 @@ Default is 2. ;;;*** -;;;### (autoloads nil "dnd" "dnd.el" (22330 59913 752324 116000)) +;;;### (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)) "\ @@ -6820,8 +6752,7 @@ if some action was made, or nil if the URL is ignored.") ;;;*** -;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (22330 59913 -;;;;;; 990323 381000)) +;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6844,8 +6775,7 @@ Locate SOA record and increment the serial field. ;;;*** -;;;### (autoloads nil "doc-view" "doc-view.el" (22330 59913 752324 -;;;;;; 116000)) +;;;### (autoloads nil "doc-view" "doc-view.el" (0 0 0 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6891,8 +6821,7 @@ See the command `doc-view-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "doctor" "play/doctor.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "doctor" "play/doctor.el" (0 0 0 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6902,7 +6831,7 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads nil "double" "double.el" (22330 59913 753324 113000)) +;;;### (autoloads nil "double" "double.el" (0 0 0 0)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6918,8 +6847,7 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads nil "dunnet" "play/dunnet.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0)) ;;; Generated autoloads from play/dunnet.el (push (purecopy '(dunnet 2 2)) package--builtin-versions) @@ -6930,8 +6858,8 @@ Switch to *dungeon* buffer and start game. ;;;*** -;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (22331 -;;;;;; 17371 991369 626000)) +;;;### (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) @@ -6960,9 +6888,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. @@ -7073,8 +7002,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** -;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (22330 -;;;;;; 59913 929323 569000)) +;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7212,8 +7141,7 @@ To implement dynamic menus, either call this from ;;;*** -;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (22330 59913 -;;;;;; 981323 409000)) +;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (push (purecopy '(ebnf2ps 4 4)) package--builtin-versions) @@ -7478,8 +7406,7 @@ See `ebnf-style-database' documentation. ;;;*** -;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (22330 59913 -;;;;;; 981323 409000)) +;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7627,8 +7554,7 @@ Display statistics for a class tree. ;;;*** -;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (0 0 0 0)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7660,8 +7586,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** -;;;### (autoloads nil "echistory" "echistory.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "echistory" "echistory.el" (0 0 0 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7672,9 +7597,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (22331 17372 -;;;;;; 13369 548000)) -;;; Generated autoloads from gnus/ecomplete.el +;;;### (autoloads nil "ecomplete" "ecomplete.el" (0 0 0 0)) +;;; Generated autoloads from ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7683,7 +7607,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ede" "cedet/ede.el" (22330 59913 920323 597000)) +;;;### (autoloads nil "ede" "cedet/ede.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede.el (push (purecopy '(ede 1 2)) package--builtin-versions) @@ -7710,8 +7634,7 @@ an EDE controlled project. ;;;*** -;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (22331 17371 -;;;;;; 992369 622000)) +;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7775,7 +7698,7 @@ Toggle edebugging of all forms. ;;;*** -;;;### (autoloads nil "ediff" "vc/ediff.el" (22331 17372 122369 161000)) +;;;### (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) @@ -8047,8 +7970,7 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (22330 59914 -;;;;;; 9323 322000)) +;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (0 0 0 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -8058,8 +7980,7 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (22330 59914 -;;;;;; 9323 322000)) +;;;### (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" "\ @@ -8071,8 +7992,7 @@ Display Ediff's registry. ;;;*** -;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (22331 17372 -;;;;;; 122369 161000)) +;;;### (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" "\ @@ -8091,8 +8011,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;*** -;;;### (autoloads nil "edmacro" "edmacro.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0)) ;;; Generated autoloads from edmacro.el (push (purecopy '(edmacro 2 1)) package--builtin-versions) @@ -8141,8 +8060,7 @@ or nil, use a compact 80-column format. ;;;*** -;;;### (autoloads nil "edt" "emulation/edt.el" (22330 59913 931323 -;;;;;; 563000)) +;;;### (autoloads nil "edt" "emulation/edt.el" (0 0 0 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8159,7 +8077,7 @@ Turn on EDT Emulation. ;;;*** -;;;### (autoloads nil "ehelp" "ehelp.el" (22330 59913 912323 622000)) +;;;### (autoloads nil "ehelp" "ehelp.el" (0 0 0 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8195,15 +8113,14 @@ BUFFER is put back into its original major mode. ;;;*** -;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (22331 17377 -;;;;;; 951348 457000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (22331 -;;;;;; 17371 993369 619000)) +;;;### (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) @@ -8219,8 +8136,7 @@ It creates an autoload function for CNAME's constructor. ;;;*** -;;;### (autoloads nil "elec-pair" "elec-pair.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "elec-pair" "elec-pair.el" (0 0 0 0)) ;;; Generated autoloads from elec-pair.el (defvar electric-pair-text-pairs '((34 . 34)) "\ @@ -8262,8 +8178,7 @@ Toggle `electric-pair-mode' only in this buffer. ;;;*** -;;;### (autoloads nil "elide-head" "elide-head.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "elide-head" "elide-head.el" (0 0 0 0)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8278,8 +8193,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;*** -;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8314,8 +8228,7 @@ optional prefix argument REINIT is non-nil. ;;;*** -;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (22330 59913 929323 -;;;;;; 569000)) +;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8349,8 +8262,7 @@ displayed. ;;;*** -;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8377,8 +8289,7 @@ Other values are interpreted as usual. ;;;*** -;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (22331 17372 -;;;;;; 50369 416000)) +;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (0 0 0 0)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8391,7 +8302,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;*** -;;;### (autoloads nil "emerge" "vc/emerge.el" (22330 59914 9323 322000)) +;;;### (autoloads nil "emerge" "vc/emerge.el" (0 0 0 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8451,8 +8362,7 @@ Emerge two RCS revisions of a file, with another revision as ancestor. ;;;*** -;;;### (autoloads nil "enriched" "textmodes/enriched.el" (22330 59913 -;;;;;; 990323 381000)) +;;;### (autoloads nil "enriched" "textmodes/enriched.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8487,7 +8397,7 @@ Commands: ;;;*** -;;;### (autoloads nil "epa" "epa.el" (22331 17371 998369 601000)) +;;;### (autoloads nil "epa" "epa.el" (0 0 0 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8675,8 +8585,7 @@ Insert selected KEYS after the point. ;;;*** -;;;### (autoloads nil "epa-dired" "epa-dired.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "epa-dired" "epa-dired.el" (0 0 0 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8701,8 +8610,7 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-file" "epa-file.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "epa-file" "epa-file.el" (0 0 0 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8722,8 +8630,7 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-mail" "epa-mail.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8801,7 +8708,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "epg" "epg.el" (22330 59913 912323 622000)) +;;;### (autoloads nil "epg" "epg.el" (0 0 0 0)) ;;; Generated autoloads from epg.el (push (purecopy '(epg 1 0 0)) package--builtin-versions) @@ -8812,8 +8719,7 @@ Return a context object. ;;;*** -;;;### (autoloads nil "epg-config" "epg-config.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "epg-config" "epg-config.el" (0 0 0 0)) ;;; Generated autoloads from epg-config.el (autoload 'epg-find-configuration "epg-config" "\ @@ -8847,7 +8753,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** -;;;### (autoloads nil "erc" "erc/erc.el" (22331 17372 1369 590000)) +;;;### (autoloads nil "erc" "erc/erc.el" (0 0 0 0)) ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 3)) package--builtin-versions) @@ -8896,36 +8802,32 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (22331 17371 -;;;;;; 999369 597000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (22331 17371 -;;;;;; 999369 597000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (22331 17371 -;;;;;; 999369 597000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (22331 17371 999369 -;;;;;; 597000)) +;;;### (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") @@ -8955,14 +8857,14 @@ that subcommand. ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (22330 59913 933323 557000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) ;;;*** -;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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" "\ @@ -9024,8 +8926,7 @@ Add EZBouncer convenience functions to ERC. ;;;*** -;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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) @@ -9037,8 +8938,7 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** -;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (22330 59913 -;;;;;; 933323 557000)) +;;;### (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") @@ -9059,8 +8959,7 @@ system. ;;;*** -;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (22330 59913 -;;;;;; 933323 557000)) +;;;### (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" "\ @@ -9070,22 +8969,19 @@ system. ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-log" "erc/erc-log.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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) @@ -9114,8 +9010,7 @@ You can save every individual message by putting this function on ;;;*** -;;;### (autoloads nil "erc-match" "erc/erc-match.el" (22331 17371 -;;;;;; 999369 597000)) +;;;### (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") @@ -9161,15 +9056,14 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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") @@ -9180,8 +9074,8 @@ Show who's gone. ;;;*** -;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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" "\ @@ -9198,8 +9092,7 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** -;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (22330 59913 -;;;;;; 933323 557000)) +;;;### (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) @@ -9217,36 +9110,33 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (22330 59913 -;;;;;; 933323 557000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-services" "erc/erc-services.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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) @@ -9263,15 +9153,14 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (22330 59913 -;;;;;; 933323 557000)) +;;;### (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") ;;;*** -;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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" "\ @@ -9282,22 +9171,20 @@ This will add a speedbar major display mode. ;;;*** -;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (22331 17372 -;;;;;; 369 594000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "erc-track" "erc/erc-track.el" (22331 17372 -;;;;;; 369 594000)) +;;;### (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 "\ @@ -9323,8 +9210,8 @@ keybindings will not do anything useful. ;;;*** -;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (22330 -;;;;;; 59913 933323 557000)) +;;;### (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) @@ -9343,8 +9230,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** -;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (22330 59913 933323 -;;;;;; 557000)) +;;;### (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") @@ -9355,8 +9241,7 @@ Add a file to `erc-xdcc-files'. ;;;*** -;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (22331 17371 995369 -;;;;;; 612000)) +;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9425,8 +9310,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** -;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (22331 17371 -;;;;;; 994369 615000)) +;;;### (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) @@ -9438,8 +9322,7 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (22331 17372 -;;;;;; 1369 590000)) +;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (0 0 0 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9449,8 +9332,7 @@ Emacs shell interactive mode. ;;;*** -;;;### (autoloads nil "eshell" "eshell/eshell.el" (22331 17372 2369 -;;;;;; 587000)) +;;;### (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) @@ -9485,8 +9367,7 @@ corresponding to a successful execution. ;;;*** -;;;### (autoloads nil "etags" "progmodes/etags.el" (22330 59913 971323 -;;;;;; 440000)) +;;;### (autoloads nil "etags" "progmodes/etags.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9801,8 +9682,8 @@ for \\[find-tag] (which see). ;;;*** -;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (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" "\ @@ -9970,7 +9851,7 @@ With ARG, insert that many delimiters. ;;;*** -;;;### (autoloads nil "eudc" "net/eudc.el" (22331 17372 58369 388000)) +;;;### (autoloads nil "eudc" "net/eudc.el" (0 0 0 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -10020,12 +9901,11 @@ 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))))))))))) ;;;*** -;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (22330 59913 952323 -;;;;;; 498000)) +;;;### (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" "\ @@ -10060,8 +9940,7 @@ Display a button for the JPEG DATA. ;;;*** -;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (22330 59913 -;;;;;; 952323 498000)) +;;;### (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" "\ @@ -10077,8 +9956,8 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** -;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (22330 -;;;;;; 59913 953323 495000)) +;;;### (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" "\ @@ -10088,8 +9967,7 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (22330 59913 929323 -;;;;;; 569000)) +;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -10115,7 +9993,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;*** -;;;### (autoloads nil "eww" "net/eww.el" (22331 17372 58369 388000)) +;;;### (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) "\ @@ -10162,8 +10040,8 @@ Display the bookmarks. ;;;*** -;;;### (autoloads nil "executable" "progmodes/executable.el" (22330 -;;;;;; 59913 981323 409000)) +;;;### (autoloads nil "executable" "progmodes/executable.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -10198,7 +10076,7 @@ file modes. ;;;*** -;;;### (autoloads nil "expand" "expand.el" (22330 59913 912323 622000)) +;;;### (autoloads nil "expand" "expand.el" (0 0 0 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10247,8 +10125,7 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads nil "f90" "progmodes/f90.el" (22330 59913 981323 -;;;;;; 409000)) +;;;### (autoloads nil "f90" "progmodes/f90.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10315,8 +10192,7 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "face-remap" "face-remap.el" (22330 59913 738324 -;;;;;; 159000)) +;;;### (autoloads nil "face-remap" "face-remap.el" (0 0 0 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10475,8 +10351,7 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;*** -;;;### (autoloads nil "feedmail" "mail/feedmail.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "feedmail" "mail/feedmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/feedmail.el (push (purecopy '(feedmail 11)) package--builtin-versions) @@ -10530,7 +10405,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;*** -;;;### (autoloads nil "ffap" "ffap.el" (22331 17372 3369 583000)) +;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10593,8 +10468,7 @@ Evaluate the forms in variable `ffap-bindings'. ;;;*** -;;;### (autoloads nil "filecache" "filecache.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "filecache" "filecache.el" (0 0 0 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10651,8 +10525,7 @@ the name is considered already unique; only the second substitution ;;;*** -;;;### (autoloads nil "filenotify" "filenotify.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "filenotify" "filenotify.el" (0 0 0 0)) ;;; Generated autoloads from filenotify.el (autoload 'file-notify-handle-event "filenotify" "\ @@ -10667,7 +10540,7 @@ Otherwise, signal a `file-notify-error'. ;;;*** -;;;### (autoloads nil "files-x" "files-x.el" (22331 17372 3369 583000)) +;;;### (autoloads nil "files-x" "files-x.el" (0 0 0 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10732,8 +10605,7 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads nil "filesets" "filesets.el" (22330 59913 912323 -;;;;;; 622000)) +;;;### (autoloads nil "filesets" "filesets.el" (0 0 0 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10744,8 +10616,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads nil "find-cmd" "find-cmd.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (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) @@ -10765,8 +10636,7 @@ result is a string that should be ready for the command line. ;;;*** -;;;### (autoloads nil "find-dired" "find-dired.el" (22331 17372 5369 -;;;;;; 576000)) +;;;### (autoloads nil "find-dired" "find-dired.el" (0 0 0 0)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10806,8 +10676,7 @@ use in place of \"-ls\" as the final argument. ;;;*** -;;;### (autoloads nil "find-file" "find-file.el" (22331 17372 5369 -;;;;;; 576000)) +;;;### (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)))) "\ @@ -10897,15 +10766,18 @@ Visit the file you click on in another window. ;;;*** -;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (22331 -;;;;;; 17377 951348 457000)) +;;;### (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. @@ -11068,8 +10940,7 @@ Define some key bindings for the find-function family of functions. ;;;*** -;;;### (autoloads nil "find-lisp" "find-lisp.el" (22330 59913 738324 -;;;;;; 159000)) +;;;### (autoloads nil "find-lisp" "find-lisp.el" (0 0 0 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -11089,7 +10960,7 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP. ;;;*** -;;;### (autoloads nil "finder" "finder.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "finder" "finder.el" (0 0 0 0)) ;;; Generated autoloads from finder.el (push (purecopy '(finder 1 0)) package--builtin-versions) @@ -11111,8 +10982,7 @@ Find packages matching a given keyword. ;;;*** -;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (0 0 0 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -11133,9 +11003,8 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (22331 17372 -;;;;;; 13369 548000)) -;;; 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" "\ @@ -11149,8 +11018,7 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flymake" "progmodes/flymake.el" (22330 59913 -;;;;;; 981323 409000)) +;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) @@ -11180,8 +11048,7 @@ Turn flymake mode off. ;;;*** -;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (22331 17372 -;;;;;; 113369 193000)) +;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11251,14 +11118,13 @@ Flyspell whole buffer. ;;;*** -;;;### (autoloads nil "foldout" "foldout.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "foldout" "foldout.el" (0 0 0 0)) ;;; Generated autoloads from foldout.el (push (purecopy '(foldout 1 10)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "follow" "follow.el" (22330 59913 738324 159000)) +;;;### (autoloads nil "follow" "follow.el" (0 0 0 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11289,11 +11155,11 @@ virtual window. This is accomplished by two main techniques: makes it possible to walk between windows using normal cursor movement commands. -Follow mode comes to its prime when used on a large screen and two or -more side-by-side windows are used. The user can, with the help of -Follow mode, use these full-height windows as though they were one. -Imagine yourself editing a large function, or section of text, and -being able to use 144 or 216 lines instead of the normal 72... (your +Follow mode comes to its prime when used on a large screen and two +side-by-side windows are used. The user can, with the help of Follow +mode, use two full-height windows as though they would have been +one. Imagine yourself editing a large function, or section of text, +and being able to use 144 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands @@ -11308,34 +11174,6 @@ Keys specific to Follow mode: \(fn &optional ARG)" t nil) -(autoload 'follow-scroll-up-window "follow" "\ -Scroll text in a Follow mode window up by that window's size. -The other windows in the window chain will scroll synchronously. - -If called with no ARG, the `next-screen-context-lines' last lines of -the window will be visible after the scroll. - -If called with an argument, scroll ARG lines up. -Negative ARG means scroll downward. - -Works like `scroll-up' when not in Follow mode. - -\(fn &optional ARG)" t nil) - -(autoload 'follow-scroll-down-window "follow" "\ -Scroll text in a Follow mode window down by that window's size. -The other windows in the window chain will scroll synchronously. - -If called with no ARG, the `next-screen-context-lines' top lines of -the window in the chain will be visible after the scroll. - -If called with an argument, scroll ARG lines down. -Negative ARG means scroll upward. - -Works like `scroll-down' when not in Follow mode. - -\(fn &optional ARG)" t nil) - (autoload 'follow-scroll-up "follow" "\ Scroll text in a Follow mode window chain up. @@ -11380,8 +11218,7 @@ selected if the original window is the first one in the frame. ;;;*** -;;;### (autoloads nil "footnote" "mail/footnote.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0)) ;;; Generated autoloads from mail/footnote.el (push (purecopy '(footnote 0 19)) package--builtin-versions) @@ -11400,7 +11237,7 @@ play around with the following keys: ;;;*** -;;;### (autoloads nil "forms" "forms.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "forms" "forms.el" (0 0 0 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11436,8 +11273,7 @@ Visit a file in Forms mode in other window. ;;;*** -;;;### (autoloads nil "fortran" "progmodes/fortran.el" (22330 59913 -;;;;;; 983323 402000)) +;;;### (autoloads nil "fortran" "progmodes/fortran.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11514,8 +11350,7 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "fortune" "play/fortune.el" (22331 17372 87369 -;;;;;; 285000)) +;;;### (autoloads nil "fortune" "play/fortune.el" (0 0 0 0)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11552,6 +11387,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, @@ -11563,8 +11405,7 @@ and choose the directory as the fortune-file. ;;;*** -;;;### (autoloads nil "frameset" "frameset.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (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)) "\ @@ -11750,15 +11591,13 @@ Interactively, reads the register using `register-read-with-preview'. ;;;*** -;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (22330 59913 -;;;;;; 969323 446000)) +;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (0 0 0 0)) ;;; Generated autoloads from play/gamegrid.el (push (purecopy '(gamegrid 1 2)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (22330 59913 -;;;;;; 983323 402000)) +;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11836,8 +11675,7 @@ detailed description of this mode. ;;;*** -;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11917,8 +11755,7 @@ regular expression that can be used as an element of ;;;*** -;;;### (autoloads nil "glasses" "progmodes/glasses.el" (22330 59913 -;;;;;; 983323 402000)) +;;;### (autoloads nil "glasses" "progmodes/glasses.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11932,8 +11769,7 @@ add virtual separators (like underscores) at places they belong to. ;;;*** -;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (22331 17372 -;;;;;; 14369 544000)) +;;;### (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" "\ @@ -11987,7 +11823,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** -;;;### (autoloads nil "gnus" "gnus/gnus.el" (22331 17372 26369 502000)) +;;;### (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) @@ -12037,8 +11873,7 @@ prompt the user for the name of an NNTP server to use. ;;;*** -;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (22331 17372 -;;;;;; 14369 544000)) +;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -12128,8 +11963,7 @@ CLEAN is obsolete and ignored. ;;;*** -;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (22331 17372 -;;;;;; 16369 537000)) +;;;### (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" "\ @@ -12139,8 +11973,8 @@ Make the current buffer look like a nice article. ;;;*** -;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (22331 -;;;;;; 17372 16369 537000)) +;;;### (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" "\ @@ -12163,8 +11997,7 @@ deletion, or > if it is flagged for displaying. ;;;*** -;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (22331 17372 -;;;;;; 16369 537000)) +;;;### (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" "\ @@ -12205,8 +12038,7 @@ supported. ;;;*** -;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (22331 17372 -;;;;;; 17369 534000)) +;;;### (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" "\ @@ -12241,8 +12073,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (22331 17372 -;;;;;; 17369 534000)) +;;;### (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" "\ @@ -12257,8 +12088,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (22331 17372 -;;;;;; 17369 534000)) +;;;### (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" "\ @@ -12268,8 +12098,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** -;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (22331 17372 -;;;;;; 17369 534000)) +;;;### (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" "\ @@ -12279,8 +12108,7 @@ Reminder user if there are unsent drafts. ;;;*** -;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (22331 17372 -;;;;;; 17369 534000)) +;;;### (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" "\ @@ -12345,8 +12173,8 @@ Insert a random Face header from `gnus-face-directory'. ;;;*** -;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (22331 -;;;;;; 17372 17369 534000)) +;;;### (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" "\ @@ -12363,8 +12191,7 @@ If gravatars are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (22331 17372 -;;;;;; 18369 530000)) +;;;### (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" "\ @@ -12381,8 +12208,7 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (22331 17372 -;;;;;; 18369 530000)) +;;;### (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" "\ @@ -12397,8 +12223,7 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (22330 59913 -;;;;;; 938323 541000)) +;;;### (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) @@ -12411,8 +12236,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;*** -;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (22331 17372 19369 -;;;;;; 526000)) +;;;### (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" "\ @@ -12435,8 +12259,7 @@ Minor mode for providing mailing-list commands. ;;;*** -;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (22330 59913 -;;;;;; 938323 541000)) +;;;### (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" "\ @@ -12536,8 +12359,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** -;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (22331 17372 -;;;;;; 19369 526000)) +;;;### (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" "\ @@ -12564,7 +12386,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (22331 17372 19369 526000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12580,8 +12402,7 @@ This is typically a function to add in ;;;*** -;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (22331 17372 -;;;;;; 19369 526000)) +;;;### (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" "\ @@ -12604,8 +12425,7 @@ If picons are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (22330 59913 -;;;;;; 938323 541000)) +;;;### (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" "\ @@ -12672,8 +12492,8 @@ Add NUM into sorted LIST by side effect. ;;;*** -;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (22331 -;;;;;; 17372 19369 526000)) +;;;### (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" "\ @@ -12688,8 +12508,7 @@ Install the registry hooks. ;;;*** -;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (22330 59913 -;;;;;; 938323 541000)) +;;;### (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" "\ @@ -12716,8 +12535,7 @@ See the documentation for these variables and functions for details. ;;;*** -;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (22331 17372 -;;;;;; 20369 523000)) +;;;### (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" "\ @@ -12727,8 +12545,7 @@ Update the format specification near point. ;;;*** -;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (22331 17372 -;;;;;; 21369 519000)) +;;;### (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" "\ @@ -12738,8 +12555,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** -;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (22331 17372 -;;;;;; 24369 509000)) +;;;### (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" "\ @@ -12750,8 +12566,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (22331 17372 -;;;;;; 24369 509000)) +;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (0 0 0 0)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -12766,8 +12581,7 @@ Install the sync hooks. ;;;*** -;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (22331 17372 -;;;;;; 25369 505000)) +;;;### (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" "\ @@ -12777,8 +12591,7 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** -;;;### (autoloads nil "gnutls" "net/gnutls.el" (22331 17372 58369 -;;;;;; 388000)) +;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12794,8 +12607,7 @@ A value of nil says to use the default GnuTLS value.") ;;;*** -;;;### (autoloads nil "gomoku" "play/gomoku.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "gomoku" "play/gomoku.el" (0 0 0 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12821,8 +12633,7 @@ Use \\[describe-mode] for more info. ;;;*** -;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (22330 59913 -;;;;;; 953323 495000)) +;;;### (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") @@ -12863,9 +12674,8 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** -;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (22331 17372 -;;;;;; 26369 502000)) -;;; 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. @@ -12880,8 +12690,7 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;*** -;;;### (autoloads nil "grep" "progmodes/grep.el" (22331 17372 94369 -;;;;;; 260000)) +;;;### (autoloads nil "grep" "progmodes/grep.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -13048,7 +12857,7 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'. ;;;*** -;;;### (autoloads nil "gs" "gs.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "gs" "gs.el" (0 0 0 0)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -13061,8 +12870,7 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** -;;;### (autoloads nil "gud" "progmodes/gud.el" (22331 17372 95369 -;;;;;; 256000)) +;;;### (autoloads nil "gud" "progmodes/gud.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -13158,8 +12966,7 @@ it if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (22330 59913 929323 -;;;;;; 569000)) +;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -13261,8 +13068,7 @@ binding mode. ;;;*** -;;;### (autoloads nil "handwrite" "play/handwrite.el" (22330 59913 -;;;;;; 969323 446000)) +;;;### (autoloads nil "handwrite" "play/handwrite.el" (0 0 0 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -13279,8 +13085,7 @@ Variables: `handwrite-linespace' (default 12) ;;;*** -;;;### (autoloads nil "hanoi" "play/hanoi.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "hanoi" "play/hanoi.el" (0 0 0 0)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -13307,8 +13112,7 @@ to be updated. ;;;*** -;;;### (autoloads nil "hashcash" "mail/hashcash.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "hashcash" "mail/hashcash.el" (0 0 0 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13350,8 +13154,7 @@ Prefix arg sets default accept amount temporarily. ;;;*** -;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (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" "\ @@ -13478,8 +13281,7 @@ different regions. With numeric argument ARG, behaves like ;;;*** -;;;### (autoloads nil "help-fns" "help-fns.el" (22331 17372 37369 -;;;;;; 462000)) +;;;### (autoloads nil "help-fns" "help-fns.el" (0 0 0 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13566,8 +13368,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** -;;;### (autoloads nil "help-macro" "help-macro.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "help-macro" "help-macro.el" (0 0 0 0)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13581,8 +13382,7 @@ gives the window that lists the options.") ;;;*** -;;;### (autoloads nil "help-mode" "help-mode.el" (22331 17372 37369 -;;;;;; 462000)) +;;;### (autoloads nil "help-mode" "help-mode.el" (0 0 0 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13683,8 +13483,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13699,7 +13498,7 @@ Provide help for current mode. ;;;*** -;;;### (autoloads nil "hexl" "hexl.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "hexl" "hexl.el" (0 0 0 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13793,8 +13592,7 @@ This discards the buffer's undo information. ;;;*** -;;;### (autoloads nil "hi-lock" "hi-lock.el" (22330 59913 739324 -;;;;;; 156000)) +;;;### (autoloads nil "hi-lock" "hi-lock.el" (0 0 0 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13962,8 +13760,7 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** -;;;### (autoloads nil "hideif" "progmodes/hideif.el" (22330 59913 -;;;;;; 983323 402000)) +;;;### (autoloads nil "hideif" "progmodes/hideif.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -14010,8 +13807,7 @@ Several variables affect how the hiding is done: ;;;*** -;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (22331 17372 -;;;;;; 95369 256000)) +;;;### (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))) "\ @@ -14073,8 +13869,7 @@ Unconditionally turn off `hs-minor-mode'. ;;;*** -;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (0 0 0 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -14206,8 +14001,7 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;*** -;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (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) @@ -14239,8 +14033,7 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** -;;;### (autoloads nil "hl-line" "hl-line.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "hl-line" "hl-line.el" (0 0 0 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -14290,8 +14083,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;*** -;;;### (autoloads nil "holidays" "calendar/holidays.el" (22330 59913 -;;;;;; 920323 597000)) +;;;### (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"))) "\ @@ -14401,9 +14193,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads nil "html2text" "gnus/html2text.el" (22331 17372 -;;;;;; 26369 502000)) -;;; 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. @@ -14412,8 +14203,7 @@ Convert HTML to plain text in the current buffer. ;;;*** -;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (22331 17372 -;;;;;; 38369 459000)) +;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0)) ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -14446,8 +14236,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** -;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (0 0 0 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14549,7 +14338,7 @@ bound to the current value of the filter. ;;;*** -;;;### (autoloads nil "ibuffer" "ibuffer.el" (22331 17372 39369 455000)) +;;;### (autoloads nil "ibuffer" "ibuffer.el" (0 0 0 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14588,8 +14377,8 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;*** -;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (22330 -;;;;;; 59913 920323 597000)) +;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/icalendar.el (push (purecopy '(icalendar 0 19)) package--builtin-versions) @@ -14642,8 +14431,7 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads nil "icomplete" "icomplete.el" (22331 17372 39369 -;;;;;; 455000)) +;;;### (autoloads nil "icomplete" "icomplete.el" (0 0 0 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14683,8 +14471,7 @@ completions: ;;;*** -;;;### (autoloads nil "icon" "progmodes/icon.el" (22330 59913 983323 -;;;;;; 402000)) +;;;### (autoloads nil "icon" "progmodes/icon.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14724,8 +14511,8 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (22330 -;;;;;; 59913 984323 399000)) +;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14750,8 +14537,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** -;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (22330 59913 -;;;;;; 984323 399000)) +;;;### (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) @@ -14880,7 +14666,7 @@ The main features of this mode are ;;;*** -;;;### (autoloads nil "ido" "ido.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "ido" "ido.el" (0 0 0 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -15142,7 +14928,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads nil "ielm" "ielm.el" (22330 59913 913323 619000)) +;;;### (autoloads nil "ielm" "ielm.el" (0 0 0 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -15154,7 +14940,7 @@ See `inferior-emacs-lisp-mode' for details. ;;;*** -;;;### (autoloads nil "iimage" "iimage.el" (22330 59913 913323 619000)) +;;;### (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") @@ -15170,7 +14956,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** -;;;### (autoloads nil "image" "image.el" (22331 17372 40369 452000)) +;;;### (autoloads nil "image" "image.el" (0 0 0 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15363,8 +15149,7 @@ If Emacs is compiled without ImageMagick support, this does nothing. ;;;*** -;;;### (autoloads nil "image-dired" "image-dired.el" (22331 17372 -;;;;;; 39369 455000)) +;;;### (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) @@ -15501,8 +15286,7 @@ easy-to-use form. ;;;*** -;;;### (autoloads nil "image-file" "image-file.el" (22330 59913 913323 -;;;;;; 619000)) +;;;### (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")) "\ @@ -15565,14 +15349,13 @@ An image file is one whose name has an extension in ;;;*** -;;;### (autoloads nil "image-mode" "image-mode.el" (22331 17372 40369 -;;;;;; 452000)) +;;;### (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} @@ -15591,20 +15374,12 @@ 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. +A non-mage major mode found from `auto-mode-alist' or fundamental mode +displays an image file as text. -See commands `image-mode' and `image-minor-mode' for more information -on these modes. - -\(fn)" t nil) +\(fn)" nil nil) (autoload 'image-bookmark-jump "image-mode" "\ @@ -15613,7 +15388,7 @@ on these modes. ;;;*** -;;;### (autoloads nil "imenu" "imenu.el" (22330 59913 739324 156000)) +;;;### (autoloads nil "imenu" "imenu.el" (0 0 0 0)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15751,8 +15526,7 @@ for more information. ;;;*** -;;;### (autoloads nil "ind-util" "language/ind-util.el" (22330 59913 -;;;;;; 941323 532000)) +;;;### (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" "\ @@ -15782,8 +15556,7 @@ Convert old Emacs Devanagari characters to UCS. ;;;*** -;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (22330 59913 -;;;;;; 984323 399000)) +;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15801,7 +15574,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;*** -;;;### (autoloads nil "info" "info.el" (22331 17372 41369 448000)) +;;;### (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))))) "\ @@ -16013,8 +15786,7 @@ completion alternatives to currently visited manuals. ;;;*** -;;;### (autoloads nil "info-look" "info-look.el" (22330 59913 740324 -;;;;;; 153000)) +;;;### (autoloads nil "info-look" "info-look.el" (0 0 0 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -16061,8 +15833,7 @@ Perform completion on file preceding point. ;;;*** -;;;### (autoloads nil "info-xref" "info-xref.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (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) @@ -16145,8 +15916,7 @@ the sources handy. ;;;*** -;;;### (autoloads nil "informat" "informat.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "informat" "informat.el" (0 0 0 0)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -16191,8 +15961,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;*** -;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (22330 59913 -;;;;;; 929323 569000)) +;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/inline.el (autoload 'define-inline "inline" "\ @@ -16206,8 +15975,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;*** -;;;### (autoloads nil "inversion" "cedet/inversion.el" (22330 59913 -;;;;;; 920323 597000)) +;;;### (autoloads nil "inversion" "cedet/inversion.el" (0 0 0 0)) ;;; Generated autoloads from cedet/inversion.el (push (purecopy '(inversion 1 3)) package--builtin-versions) @@ -16219,8 +15987,8 @@ Only checks one based on which kind of Emacs is being run. ;;;*** -;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (22330 -;;;;;; 59913 939323 538000)) +;;;### (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" "\ @@ -16240,8 +16008,7 @@ Toggle input method in interactive search. ;;;*** -;;;### (autoloads nil "isearchb" "isearchb.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "isearchb" "isearchb.el" (0 0 0 0)) ;;; Generated autoloads from isearchb.el (push (purecopy '(isearchb 1 5)) package--builtin-versions) @@ -16255,8 +16022,8 @@ accessed via isearchb. ;;;*** -;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (22330 -;;;;;; 59913 939323 538000)) +;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -16347,15 +16114,14 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (22330 59913 939323 538000)) +;;;;;; (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) ;;;*** -;;;### (autoloads nil "ispell" "textmodes/ispell.el" (22331 17372 -;;;;;; 114369 189000)) +;;;### (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)))) @@ -16395,7 +16161,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{}. @@ -16575,10 +16341,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: @@ -16588,8 +16354,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads nil "japan-util" "language/japan-util.el" (22330 -;;;;;; 59913 941323 532000)) +;;;### (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" "\ @@ -16666,8 +16432,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** -;;;### (autoloads nil "jka-compr" "jka-compr.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "jka-compr" "jka-compr.el" (0 0 0 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16690,8 +16455,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads nil "js" "progmodes/js.el" (22331 17377 954348 -;;;;;; 447000)) +;;;### (autoloads nil "js" "progmodes/js.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/js.el (push (purecopy '(js 9)) package--builtin-versions) @@ -16718,14 +16482,13 @@ locally, like so: ;;;*** -;;;### (autoloads nil "json" "json.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "json" "json.el" (0 0 0 0)) ;;; Generated autoloads from json.el (push (purecopy '(json 1 4)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "keypad" "emulation/keypad.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (autoloads nil "keypad" "emulation/keypad.el" (0 0 0 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16780,8 +16543,8 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** -;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (22330 -;;;;;; 59913 939323 538000)) +;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16802,8 +16565,7 @@ the context of text formatting. ;;;*** -;;;### (autoloads nil "kkc" "international/kkc.el" (22330 59913 940323 -;;;;;; 535000)) +;;;### (autoloads nil "kkc" "international/kkc.el" (0 0 0 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16825,7 +16587,7 @@ and the return value is the length of the conversion. ;;;*** -;;;### (autoloads nil "kmacro" "kmacro.el" (22331 17372 42369 445000)) +;;;### (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) @@ -16937,8 +16699,8 @@ If kbd macro currently being defined end it before activating it. ;;;*** -;;;### (autoloads nil "korea-util" "language/korea-util.el" (22330 -;;;;;; 59913 941323 532000)) +;;;### (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" "")) "\ @@ -16952,8 +16714,7 @@ The kind of Korean keyboard for Korean input method. ;;;*** -;;;### (autoloads nil "lao-util" "language/lao-util.el" (22330 59913 -;;;;;; 941323 532000)) +;;;### (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" "\ @@ -16990,8 +16751,8 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;*** -;;;### (autoloads nil "latexenc" "international/latexenc.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (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))) "\ @@ -17023,7 +16784,7 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el" -;;;;;; (22330 59913 940323 535000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -17064,8 +16825,8 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** -;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (22330 -;;;;;; 59913 984323 399000)) +;;;### (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" "\ @@ -17075,8 +16836,8 @@ A major mode to edit GNU ld script files ;;;*** -;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (22331 -;;;;;; 17371 995369 612000)) +;;;### (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) @@ -17115,7 +16876,7 @@ displayed in the example above. ;;;*** -;;;### (autoloads nil "life" "play/life.el" (22330 59913 969323 446000)) +;;;### (autoloads nil "life" "play/life.el" (0 0 0 0)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -17128,7 +16889,7 @@ generations (this defaults to 1). ;;;*** -;;;### (autoloads nil "linum" "linum.el" (22331 17372 49369 420000)) +;;;### (autoloads nil "linum" "linum.el" (0 0 0 0)) ;;; Generated autoloads from linum.el (push (purecopy '(linum 0 9 24)) package--builtin-versions) @@ -17166,8 +16927,7 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads nil "loadhist" "loadhist.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "loadhist" "loadhist.el" (0 0 0 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -17198,7 +16958,7 @@ something strange, such as redefining an Emacs function. ;;;*** -;;;### (autoloads nil "locate" "locate.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "locate" "locate.el" (0 0 0 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -17250,8 +17010,7 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads nil "log-edit" "vc/log-edit.el" (22330 59914 9323 -;;;;;; 322000)) +;;;### (autoloads nil "log-edit" "vc/log-edit.el" (0 0 0 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -17282,8 +17041,7 @@ done. Otherwise, it uses the current buffer. ;;;*** -;;;### (autoloads nil "log-view" "vc/log-view.el" (22330 59914 8323 -;;;;;; 325000)) +;;;### (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" "\ @@ -17293,13 +17051,13 @@ Major mode for browsing CVS log output. ;;;*** -;;;### (autoloads nil "lpr" "lpr.el" (22331 17372 50369 416000)) +;;;### (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") "\ @@ -17388,7 +17146,7 @@ for further customization of the printer command. ;;;*** -;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (22331 17372 50369 416000)) +;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (0 0 0 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17399,8 +17157,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads nil "lunar" "calendar/lunar.el" (22330 59913 920323 -;;;;;; 597000)) +;;;### (autoloads nil "lunar" "calendar/lunar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -17412,8 +17169,7 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (22330 59913 -;;;;;; 984323 399000)) +;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17423,7 +17179,7 @@ A major mode to edit m4 macro files. ;;;*** -;;;### (autoloads nil "macros" "macros.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "macros" "macros.el" (0 0 0 0)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17512,8 +17268,7 @@ and then select the region of un-tablified names and use ;;;*** -;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (22331 17372 -;;;;;; 51369 413000)) +;;;### (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" "\ @@ -17543,8 +17298,7 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;*** -;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (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" "\ @@ -17573,8 +17327,7 @@ This function normally would be called when the message is sent. ;;;*** -;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (0 0 0 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17648,8 +17401,7 @@ matches may be returned from the message body. ;;;*** -;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17699,8 +17451,7 @@ double-quotes. ;;;*** -;;;### (autoloads nil "mailalias" "mail/mailalias.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "mailalias" "mail/mailalias.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17753,8 +17504,7 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. ;;;*** -;;;### (autoloads nil "mailclient" "mail/mailclient.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "mailclient" "mail/mailclient.el" (0 0 0 0)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17766,8 +17516,8 @@ The mail client is taken to be the handler of mailto URLs. ;;;*** -;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (22330 -;;;;;; 59913 984323 399000)) +;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17884,8 +17634,7 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads nil "makesum" "makesum.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "makesum" "makesum.el" (0 0 0 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17896,7 +17645,7 @@ Previous contents of that buffer are killed first. ;;;*** -;;;### (autoloads nil "man" "man.el" (22330 59913 741324 150000)) +;;;### (autoloads nil "man" "man.el" (0 0 0 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17934,7 +17683,7 @@ otherwise look like a page name. An \"apropos\" query with -k gives a buffer of matching page names or descriptions. The pattern argument is usually an -\"grep -E\" style regexp. +\"egrep\" style regexp. -k pattern @@ -17952,14 +17701,13 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads nil "map" "emacs-lisp/map.el" (22330 59913 930323 -;;;;;; 566000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "master" "master.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "master" "master.el" (0 0 0 0)) ;;; Generated autoloads from master.el (push (purecopy '(master 1 0 2)) package--builtin-versions) @@ -17982,8 +17730,7 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** -;;;### (autoloads nil "mb-depth" "mb-depth.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "mb-depth" "mb-depth.el" (0 0 0 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -18011,14 +17758,13 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;*** -;;;### (autoloads nil "md4" "md4.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "md4" "md4.el" (0 0 0 0)) ;;; Generated autoloads from md4.el (push (purecopy '(md4 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "message" "gnus/message.el" (22331 17372 28369 -;;;;;; 494000)) +;;;### (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) @@ -18183,8 +17929,8 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (22330 -;;;;;; 59913 984323 399000)) +;;;### (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) @@ -18200,8 +17946,7 @@ Major mode for editing MetaPost sources. ;;;*** -;;;### (autoloads nil "metamail" "mail/metamail.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "metamail" "mail/metamail.el" (0 0 0 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -18244,8 +17989,7 @@ redisplayed as output is inserted. ;;;*** -;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (22331 17372 56369 -;;;;;; 395000)) +;;;### (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" "\ @@ -18335,9 +18079,9 @@ delete the draft message. ;;;*** -;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (22331 17372 56369 395000)) +;;;### (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) @@ -18352,8 +18096,7 @@ Display version information about MH-E and the MH mail handling system. ;;;*** -;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (22330 59913 -;;;;;; 949323 508000)) +;;;### (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" "\ @@ -18434,8 +18177,7 @@ perform the operation on all messages in that region. ;;;*** -;;;### (autoloads nil "midnight" "midnight.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "midnight" "midnight.el" (0 0 0 0)) ;;; Generated autoloads from midnight.el (defvar midnight-mode nil "\ @@ -18476,8 +18218,7 @@ to its second argument TM. ;;;*** -;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (22330 59913 -;;;;;; 914323 615000)) +;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (0 0 0 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18507,7 +18248,7 @@ is modified to remove the default indication. ;;;*** -;;;### (autoloads nil "misc" "misc.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "misc" "misc.el" (0 0 0 0)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -18535,8 +18276,7 @@ The return value is always nil. ;;;*** -;;;### (autoloads nil "misearch" "misearch.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "misearch" "misearch.el" (0 0 0 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18624,8 +18364,8 @@ whose file names match the specified wildcard. ;;;*** -;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (22330 -;;;;;; 59913 984323 399000)) +;;;### (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) @@ -18636,8 +18376,7 @@ Major mode for the mixal asm language. ;;;*** -;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (22330 59913 -;;;;;; 939323 538000)) +;;;### (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" "\ @@ -18647,8 +18386,7 @@ Return a default encoding for FILE. ;;;*** -;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (22330 59913 -;;;;;; 939323 538000)) +;;;### (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" "\ @@ -18666,8 +18404,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (22331 17372 -;;;;;; 28369 494000)) +;;;### (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" "\ @@ -18680,8 +18417,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (22331 17372 28369 -;;;;;; 494000)) +;;;### (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" "\ @@ -18697,8 +18433,7 @@ Insert file contents of URL using `mm-url-program'. ;;;*** -;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (22331 17372 29369 -;;;;;; 491000)) +;;;### (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" "\ @@ -18717,7 +18452,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** -;;;### (autoloads nil "mml" "gnus/mml.el" (22331 17372 30369 487000)) +;;;### (autoloads nil "mml" "gnus/mml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18742,8 +18477,7 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (22331 17372 30369 -;;;;;; 487000)) +;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18758,8 +18492,7 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (22331 17372 30369 -;;;;;; 487000)) +;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18799,16 +18532,14 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (22330 59913 -;;;;;; 920323 597000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "modula2" "progmodes/modula2.el" (22330 59913 -;;;;;; 984323 399000)) +;;;### (autoloads nil "modula2" "progmodes/modula2.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18841,8 +18572,7 @@ followed by the first character of the construct. ;;;*** -;;;### (autoloads nil "morse" "play/morse.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "morse" "play/morse.el" (0 0 0 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18867,8 +18597,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** -;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (0 0 0 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18915,7 +18644,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads nil "mpc" "mpc.el" (22331 17372 57369 391000)) +;;;### (autoloads nil "mpc" "mpc.el" (0 0 0 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18925,7 +18654,7 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads nil "mpuz" "play/mpuz.el" (22330 59913 969323 446000)) +;;;### (autoloads nil "mpuz" "play/mpuz.el" (0 0 0 0)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18935,7 +18664,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads nil "msb" "msb.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "msb" "msb.el" (0 0 0 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18961,8 +18690,8 @@ different buffer menu using the function `msb'. ;;;*** -;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (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" "\ @@ -19094,8 +18823,8 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;*** -;;;### (autoloads nil "mule-util" "international/mule-util.el" (22330 -;;;;;; 59913 940323 535000)) +;;;### (autoloads nil "mule-util" "international/mule-util.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -19254,8 +18983,7 @@ QUALITY can be: ;;;*** -;;;### (autoloads nil "net-utils" "net/net-utils.el" (22331 17372 -;;;;;; 58369 388000)) +;;;### (autoloads nil "net-utils" "net/net-utils.el" (0 0 0 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -19349,8 +19077,7 @@ Open a network connection to HOST on PORT. ;;;*** -;;;### (autoloads nil "netrc" "net/netrc.el" (22330 59913 953323 -;;;;;; 495000)) +;;;### (autoloads nil "netrc" "net/netrc.el" (0 0 0 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -19362,8 +19089,8 @@ listed in the PORTS list. ;;;*** -;;;### (autoloads nil "network-stream" "net/network-stream.el" (22331 -;;;;;; 17372 58369 388000)) +;;;### (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" "\ @@ -19379,8 +19106,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: @@ -19450,17 +19177,23 @@ 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) ;;;*** -;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (22331 -;;;;;; 17372 59369 384000)) +;;;### (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" "\ @@ -19482,7 +19215,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el" -;;;;;; (22330 59913 953323 495000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19492,8 +19225,8 @@ Start newsticker plainview. ;;;*** -;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (22330 -;;;;;; 59913 953323 495000)) +;;;### (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" "\ @@ -19503,8 +19236,8 @@ Start reading news. You may want to bind this to a key. ;;;*** -;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (22330 -;;;;;; 59913 953323 495000)) +;;;### (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" "\ @@ -19524,8 +19257,8 @@ running already. ;;;*** -;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (22330 -;;;;;; 59913 953323 495000)) +;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (0 +;;;;;; 0 0 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19535,8 +19268,7 @@ Start newsticker treeview. ;;;*** -;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (22331 17372 30369 -;;;;;; 487000)) +;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19546,8 +19278,7 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (22331 17372 31369 -;;;;;; 484000)) +;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19561,8 +19292,7 @@ symbol in the alist. ;;;*** -;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (22331 17372 -;;;;;; 31369 484000)) +;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19573,7 +19303,7 @@ This command does not work if you use short group names. ;;;*** -;;;### (autoloads nil "nnml" "gnus/nnml.el" (22331 17372 33369 477000)) +;;;### (autoloads nil "nnml" "gnus/nnml.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19583,7 +19313,7 @@ Generate NOV databases in all nnml directories. ;;;*** -;;;### (autoloads nil "novice" "novice.el" (22330 59913 914323 615000)) +;;;### (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") @@ -19615,8 +19345,8 @@ future sessions. ;;;*** -;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (22330 -;;;;;; 59913 990323 381000)) +;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19630,27 +19360,13 @@ closing requests for requests that are used in matched pairs. ;;;*** -;;;### (autoloads nil "ntlm" "net/ntlm.el" (22330 59913 953323 495000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (22331 17372 -;;;;;; 65369 363000)) -;;; Generated autoloads from nxml/nxml-glyph.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. - -\(fn N FACE)" nil nil) - -;;;*** - -;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (22331 17372 -;;;;;; 65369 363000)) +;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (0 0 0 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19710,21 +19426,7 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (22331 17372 -;;;;;; 66369 359000)) -;;; Generated autoloads from nxml/nxml-uchnm.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'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "octave" "progmodes/octave.el" (22330 59913 -;;;;;; 985323 396000)) +;;;### (autoloads nil "octave" "progmodes/octave.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/octave.el (autoload 'octave-mode "octave" "\ @@ -19761,8 +19463,7 @@ startup file, `~/.emacs-octave'. ;;;*** -;;;### (autoloads nil "opascal" "progmodes/opascal.el" (22330 59913 -;;;;;; 985323 396000)) +;;;### (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") @@ -19797,7 +19498,7 @@ Coloring: ;;;*** -;;;### (autoloads nil "org" "org/org.el" (22331 17372 87369 285000)) +;;;### (autoloads nil "org" "org/org.el" (0 0 0 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -20018,8 +19719,7 @@ Call the customize function with org as argument. ;;;*** -;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (22331 17372 -;;;;;; 77369 320000)) +;;;### (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" "\ @@ -20292,8 +19992,7 @@ to override `appt-message-warning-time'. ;;;*** -;;;### (autoloads nil "org-capture" "org/org-capture.el" (22330 59913 -;;;;;; 965323 458000)) +;;;### (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" "\ @@ -20335,8 +20034,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. ;;;*** -;;;### (autoloads nil "org-colview" "org/org-colview.el" (22331 17372 -;;;;;; 78369 317000)) +;;;### (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" "\ @@ -20399,8 +20097,7 @@ Turn on or update column view in the agenda. ;;;*** -;;;### (autoloads nil "org-compat" "org/org-compat.el" (22331 17372 -;;;;;; 78369 317000)) +;;;### (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" "\ @@ -20410,8 +20107,7 @@ Try very hard to provide sensible version strings. ;;;*** -;;;### (autoloads nil "org-macs" "org/org-macs.el" (22331 17372 79369 -;;;;;; 313000)) +;;;### (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" "\ @@ -20421,8 +20117,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;;*** -;;;### (autoloads nil "org-version" "org/org-version.el" (22330 59913 -;;;;;; 966323 455000)) +;;;### (autoloads nil "org-version" "org/org-version.el" (0 0 0 0)) ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ @@ -20439,8 +20134,7 @@ The Git version of org-mode. ;;;*** -;;;### (autoloads nil "outline" "outline.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (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) @@ -20483,8 +20177,7 @@ See the command `outline-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "package" "emacs-lisp/package.el" (22331 17377 -;;;;;; 952348 454000)) +;;;### (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) @@ -20602,7 +20295,7 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads nil "paren" "paren.el" (22330 59913 914323 615000)) +;;;### (autoloads nil "paren" "paren.el" (0 0 0 0)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20629,22 +20322,25 @@ matching parenthesis is highlighted in `show-paren-style' after ;;;*** -;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (22331 -;;;;;; 17371 982369 658000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "pascal" "progmodes/pascal.el" (22330 59913 -;;;;;; 985323 396000)) +;;;### (autoloads nil "pascal" "progmodes/pascal.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20693,8 +20389,8 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and ;;;*** -;;;### (autoloads nil "password-cache" "password-cache.el" (22330 -;;;;;; 59913 914323 615000)) +;;;### (autoloads nil "password-cache" "password-cache.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20715,8 +20411,7 @@ Check if KEY is in the cache. ;;;*** -;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (22330 59913 -;;;;;; 930323 566000)) +;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20836,8 +20531,7 @@ to this macro. ;;;*** -;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20847,8 +20541,7 @@ Completion rules for the `cvs' command. ;;;*** -;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (22331 17372 87369 -;;;;;; 285000)) +;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20871,12 +20564,16 @@ 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) ;;;*** -;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (22330 59913 -;;;;;; 914323 615000)) +;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20896,8 +20593,7 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20907,8 +20603,7 @@ Completion for the `rpm' command. ;;;*** -;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -20963,8 +20658,7 @@ Includes files as well as host names followed by a colon. ;;;*** -;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (0 0 0 0)) ;;; Generated autoloads from pcmpl-x.el (autoload 'pcomplete/tlmgr "pcmpl-x" "\ @@ -20988,8 +20682,7 @@ Completion for the `ag' command. ;;;*** -;;;### (autoloads nil "pcomplete" "pcomplete.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "pcomplete" "pcomplete.el" (0 0 0 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -21046,7 +20739,7 @@ Setup `shell-mode' to use pcomplete. ;;;*** -;;;### (autoloads nil "pcvs" "vc/pcvs.el" (22330 59914 12323 313000)) +;;;### (autoloads nil "pcvs" "vc/pcvs.el" (0 0 0 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -21121,8 +20814,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (22330 59914 -;;;;;; 9323 322000)) +;;;### (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)) "\ @@ -21130,8 +20822,8 @@ Global menu used by PCL-CVS.") ;;;*** -;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (22330 -;;;;;; 59913 985323 396000)) +;;;### (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) @@ -21192,8 +20884,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** -;;;### (autoloads nil "picture" "textmodes/picture.el" (22330 59913 -;;;;;; 990323 381000)) +;;;### (autoloads nil "picture" "textmodes/picture.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -21273,8 +20964,7 @@ they are not by default assigned to keys. ;;;*** -;;;### (autoloads nil "pinentry" "net/pinentry.el" (22330 59913 953323 -;;;;;; 495000)) +;;;### (autoloads nil "pinentry" "net/pinentry.el" (0 0 0 0)) ;;; Generated autoloads from net/pinentry.el (push (purecopy '(pinentry 0 1)) package--builtin-versions) @@ -21291,9 +20981,8 @@ will not be shown. ;;;*** -;;;### (autoloads nil "plstore" "gnus/plstore.el" (22331 17372 34369 -;;;;;; 473000)) -;;; 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. @@ -21307,8 +20996,7 @@ Major mode for editing PLSTORE files. ;;;*** -;;;### (autoloads nil "po" "textmodes/po.el" (22330 59913 990323 -;;;;;; 381000)) +;;;### (autoloads nil "po" "textmodes/po.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -21319,7 +21007,7 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads nil "pong" "play/pong.el" (22330 59913 969323 446000)) +;;;### (autoloads nil "pong" "play/pong.el" (0 0 0 0)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -21335,8 +21023,8 @@ pong-mode keybindings:\\<pong-mode-map> ;;;*** -;;;### (autoloads nil "pop3" "gnus/pop3.el" (22331 17372 35369 469000)) -;;; 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. @@ -21346,8 +21034,7 @@ Use streaming commands. ;;;*** -;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (22330 59913 930323 -;;;;;; 566000)) +;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -21397,8 +21084,7 @@ Ignores leading comment characters. ;;;*** -;;;### (autoloads nil "printing" "printing.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "printing" "printing.el" (0 0 0 0)) ;;; Generated autoloads from printing.el (push (purecopy '(printing 6 9 3)) package--builtin-versions) @@ -21986,7 +21672,7 @@ are both set to t. ;;;*** -;;;### (autoloads nil "proced" "proced.el" (22331 17372 88369 281000)) +;;;### (autoloads nil "proced" "proced.el" (0 0 0 0)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -22004,8 +21690,7 @@ Proced buffers. ;;;*** -;;;### (autoloads nil "profiler" "profiler.el" (22330 59913 914323 -;;;;;; 615000)) +;;;### (autoloads nil "profiler" "profiler.el" (0 0 0 0)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -22033,8 +21718,7 @@ Open profile FILENAME. ;;;*** -;;;### (autoloads nil "project" "progmodes/project.el" (22330 59913 -;;;;;; 975323 427000)) +;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el (autoload 'project-current "project" "\ @@ -22076,8 +21760,7 @@ recognized. ;;;*** -;;;### (autoloads nil "prolog" "progmodes/prolog.el" (22331 17372 -;;;;;; 97369 249000)) +;;;### (autoloads nil "prolog" "progmodes/prolog.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -22110,7 +21793,7 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** -;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (22330 59913 914323 615000)) +;;;### (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")) "\ @@ -22121,8 +21804,7 @@ The default value is (\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (22331 17372 -;;;;;; 97369 249000)) +;;;### (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) @@ -22168,8 +21850,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;*** -;;;### (autoloads nil "ps-print" "ps-print.el" (22331 17372 104369 -;;;;;; 224000)) +;;;### (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) @@ -22366,8 +22047,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** -;;;### (autoloads nil "pulse" "cedet/pulse.el" (22330 59913 920323 -;;;;;; 597000)) +;;;### (autoloads nil "pulse" "cedet/pulse.el" (0 0 0 0)) ;;; Generated autoloads from cedet/pulse.el (push (purecopy '(pulse 1 0)) package--builtin-versions) @@ -22385,8 +22065,7 @@ Optional argument FACE specifies the face to do the highlighting. ;;;*** -;;;### (autoloads nil "python" "progmodes/python.el" (22331 17372 -;;;;;; 98369 246000)) +;;;### (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) @@ -22423,8 +22102,8 @@ Major mode for editing Python files. ;;;*** -;;;### (autoloads nil "qp" "gnus/qp.el" (22331 17372 35369 469000)) -;;; 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. @@ -22442,8 +22121,7 @@ them into characters should be done separately. ;;;*** -;;;### (autoloads nil "quail" "international/quail.el" (22330 59913 -;;;;;; 940323 535000)) +;;;### (autoloads nil "quail" "international/quail.el" (0 0 0 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22673,8 +22351,8 @@ of each directory. ;;;*** -;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (22330 -;;;;;; 59913 945323 520000)) +;;;### (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" "\ @@ -22687,7 +22365,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'. ;;;*** ;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el" -;;;;;; (22330 59913 945323 520000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from leim/quail/uni-input.el (autoload 'ucs-input-activate "quail/uni-input" "\ @@ -22701,8 +22379,7 @@ While this input method is active, the variable ;;;*** -;;;### (autoloads nil "quickurl" "net/quickurl.el" (22330 59913 953323 -;;;;;; 495000)) +;;;### (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" "\ @@ -22773,7 +22450,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** -;;;### (autoloads nil "rcirc" "net/rcirc.el" (22331 17372 59369 384000)) +;;;### (autoloads nil "rcirc" "net/rcirc.el" (0 0 0 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22790,7 +22467,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. @@ -22812,8 +22489,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (22330 -;;;;;; 59913 930323 566000)) +;;;### (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) @@ -22831,8 +22508,7 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads nil "recentf" "recentf.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "recentf" "recentf.el" (0 0 0 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22859,7 +22535,7 @@ were operated on recently. ;;;*** -;;;### (autoloads nil "rect" "rect.el" (22331 17372 104369 224000)) +;;;### (autoloads nil "rect" "rect.el" (0 0 0 0)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -22999,8 +22675,7 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** -;;;### (autoloads nil "refill" "textmodes/refill.el" (22330 59913 -;;;;;; 990323 381000)) +;;;### (autoloads nil "refill" "textmodes/refill.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -23020,8 +22695,7 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** -;;;### (autoloads nil "reftex" "textmodes/reftex.el" (22331 17372 -;;;;;; 117369 178000)) +;;;### (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") @@ -23074,8 +22748,8 @@ This enforces rescanning the buffer on next use. ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (22330 -;;;;;; 59913 990323 381000)) +;;;### (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)))) @@ -23084,8 +22758,8 @@ This enforces rescanning the buffer on next use. ;;;*** -;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (22330 -;;;;;; 59913 930323 566000)) +;;;### (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" "\ @@ -23114,15 +22788,13 @@ This means the number of non-shy regexp grouping constructs ;;;*** -;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (22330 59913 930323 -;;;;;; 566000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "remember" "textmodes/remember.el" (22330 59913 -;;;;;; 991323 378000)) +;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/remember.el (push (purecopy '(remember 2 0)) package--builtin-versions) @@ -23176,7 +22848,7 @@ to turn the *scratch* buffer into your notes buffer. ;;;*** -;;;### (autoloads nil "repeat" "repeat.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0)) ;;; Generated autoloads from repeat.el (push (purecopy '(repeat 0 51)) package--builtin-versions) @@ -23199,8 +22871,7 @@ recently executed command not bound to an input event\". ;;;*** -;;;### (autoloads nil "reporter" "mail/reporter.el" (22330 59913 -;;;;;; 947323 514000)) +;;;### (autoloads nil "reporter" "mail/reporter.el" (0 0 0 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -23231,8 +22902,7 @@ mail-sending package is used for editing and sending the message. ;;;*** -;;;### (autoloads nil "reposition" "reposition.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "reposition" "reposition.el" (0 0 0 0)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -23258,7 +22928,7 @@ first comment line visible (if point is in a comment). ;;;*** -;;;### (autoloads nil "reveal" "reveal.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "reveal" "reveal.el" (0 0 0 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -23294,8 +22964,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (22330 59913 930323 -;;;;;; 566000)) +;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -23310,8 +22979,7 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads nil "rlogin" "net/rlogin.el" (22330 59913 953323 -;;;;;; 495000)) +;;;### (autoloads nil "rlogin" "net/rlogin.el" (0 0 0 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -23355,8 +23023,7 @@ variable. ;;;*** -;;;### (autoloads nil "rmail" "mail/rmail.el" (22331 17372 51369 -;;;;;; 413000)) +;;;### (autoloads nil "rmail" "mail/rmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -23364,9 +23031,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.") @@ -23553,8 +23220,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** -;;;### (autoloads nil "rmailout" "mail/rmailout.el" (22330 59913 -;;;;;; 948323 511000)) +;;;### (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) @@ -23618,8 +23284,7 @@ than appending to it. Deletes the message after writing if ;;;*** -;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (22331 17372 -;;;;;; 66369 359000)) +;;;### (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" "\ @@ -23630,8 +23295,7 @@ Return a pattern. ;;;*** -;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (22331 17372 -;;;;;; 67369 356000)) +;;;### (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" "\ @@ -23643,8 +23307,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** -;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (22331 17372 -;;;;;; 67369 356000)) +;;;### (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" "\ @@ -23674,20 +23337,19 @@ to use for finding the schema. ;;;*** -;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (22331 17372 67369 -;;;;;; 356000)) +;;;### (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 @@ -23702,8 +23364,7 @@ must be equal. ;;;*** -;;;### (autoloads nil "robin" "international/robin.el" (22330 59913 -;;;;;; 940323 535000)) +;;;### (autoloads nil "robin" "international/robin.el" (0 0 0 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23735,7 +23396,7 @@ Start using robin package NAME, which is a string. ;;;*** -;;;### (autoloads nil "rot13" "rot13.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "rot13" "rot13.el" (0 0 0 0)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ @@ -23772,8 +23433,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** -;;;### (autoloads nil "rst" "textmodes/rst.el" (22330 59913 991323 -;;;;;; 378000)) +;;;### (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))) @@ -23803,8 +23463,8 @@ for modes derived from Text mode, like Mail mode. ;;;*** -;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (22331 -;;;;;; 17377 954348 447000)) +;;;### (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) @@ -23821,8 +23481,7 @@ Major mode for editing Ruby code. ;;;*** -;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (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) @@ -23840,8 +23499,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (22330 59913 930323 -;;;;;; 566000)) +;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24152,15 +23810,13 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (22330 59913 -;;;;;; 953323 495000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "savehist" "savehist.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) @@ -24193,8 +23849,7 @@ histories, which is probably undesirable. ;;;*** -;;;### (autoloads nil "saveplace" "saveplace.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "saveplace" "saveplace.el" (0 0 0 0)) ;;; Generated autoloads from saveplace.el (defvar save-place-mode nil "\ @@ -24232,8 +23887,7 @@ file: ;;;*** -;;;### (autoloads nil "scheme" "progmodes/scheme.el" (22331 17372 -;;;;;; 98369 246000)) +;;;### (autoloads nil "scheme" "progmodes/scheme.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24272,8 +23926,7 @@ that variable's value is a string. ;;;*** -;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (22330 59913 -;;;;;; 939323 538000)) +;;;### (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" "\ @@ -24286,8 +23939,7 @@ This mode is an extended emacs-lisp mode. ;;;*** -;;;### (autoloads nil "scroll-all" "scroll-all.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "scroll-all" "scroll-all.el" (0 0 0 0)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -24313,8 +23965,7 @@ one window apply to all visible windows in the same frame. ;;;*** -;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (22330 59913 -;;;;;; 915323 612000)) +;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (0 0 0 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -24330,16 +23981,14 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (22330 59913 954323 -;;;;;; 492000)) +;;;### (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)) ;;;*** -;;;### (autoloads nil "semantic" "cedet/semantic.el" (22330 59913 -;;;;;; 920323 597000)) +;;;### (autoloads nil "semantic" "cedet/semantic.el" (0 0 0 0)) ;;; Generated autoloads from cedet/semantic.el (push (purecopy '(semantic 2 2)) package--builtin-versions) @@ -24398,7 +24047,7 @@ Semantic mode. ;;;*** ;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el" -;;;;;; (22330 59913 922323 591000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -24409,7 +24058,7 @@ Major mode for editing Bovine grammars. ;;;*** ;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el" -;;;;;; (22330 59913 923323 588000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -24419,8 +24068,7 @@ Major mode for editing Wisent grammars. ;;;*** -;;;### (autoloads nil "sendmail" "mail/sendmail.el" (22330 59913 -;;;;;; 948323 511000)) +;;;### (autoloads nil "sendmail" "mail/sendmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24701,14 +24349,13 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** -;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (22331 17371 996369 -;;;;;; 608000)) +;;;### (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 14)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "server" "server.el" (22331 17372 105369 221000)) +;;;### (autoloads nil "server" "server.el" (0 0 0 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24776,7 +24423,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads nil "ses" "ses.el" (22331 17372 106369 217000)) +;;;### (autoloads nil "ses" "ses.el" (0 0 0 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24820,8 +24467,8 @@ formula: ;;;*** -;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (22331 -;;;;;; 17372 117369 178000)) +;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24886,8 +24533,8 @@ To work around that, do: ;;;*** -;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (22331 -;;;;;; 17372 99369 242000)) +;;;### (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) @@ -24952,8 +24599,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** -;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (22330 59913 -;;;;;; 930323 566000)) +;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -25002,8 +24648,7 @@ function, `load-path-shadows-find'. ;;;*** -;;;### (autoloads nil "shadowfile" "shadowfile.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "shadowfile" "shadowfile.el" (0 0 0 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -25041,7 +24686,7 @@ Set up file shadowing. ;;;*** -;;;### (autoloads nil "shell" "shell.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "shell" "shell.el" (0 0 0 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25089,7 +24734,7 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads nil "shr" "net/shr.el" (22331 17372 60369 381000)) +;;;### (autoloads nil "shr" "net/shr.el" (0 0 0 0)) ;;; Generated autoloads from net/shr.el (autoload 'shr-render-region "shr" "\ @@ -25106,9 +24751,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve" "gnus/sieve.el" (22331 17372 35369 -;;;;;; 469000)) -;;; Generated autoloads from gnus/sieve.el +;;;### (autoloads nil "sieve" "net/sieve.el" (0 0 0 0)) +;;; Generated autoloads from net/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -25132,9 +24776,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (22331 17372 -;;;;;; 35369 469000)) -;;; 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. @@ -25148,8 +24791,7 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads nil "simula" "progmodes/simula.el" (22330 59913 -;;;;;; 985323 396000)) +;;;### (autoloads nil "simula" "progmodes/simula.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25197,8 +24839,7 @@ with no arguments, if that value is non-nil. ;;;*** -;;;### (autoloads nil "skeleton" "skeleton.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "skeleton" "skeleton.el" (0 0 0 0)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25317,16 +24958,15 @@ twice for the others. ;;;*** -;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (22331 17372 -;;;;;; 123369 157000)) +;;;### (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. @@ -25345,8 +24985,7 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** -;;;### (autoloads nil "smiley" "gnus/smiley.el" (22331 17372 36369 -;;;;;; 466000)) +;;;### (autoloads nil "smiley" "gnus/smiley.el" (0 0 0 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -25363,8 +25002,7 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** -;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (22331 17372 -;;;;;; 53369 406000)) +;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -25379,8 +25017,7 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads nil "snake" "play/snake.el" (22331 17372 87369 -;;;;;; 285000)) +;;;### (autoloads nil "snake" "play/snake.el" (0 0 0 0)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -25403,8 +25040,7 @@ Snake mode keybindings: ;;;*** -;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (22330 59913 -;;;;;; 954323 492000)) +;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (0 0 0 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -25433,15 +25069,13 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads nil "soap-client" "net/soap-client.el" (22331 17372 -;;;;;; 61369 377000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "solar" "calendar/solar.el" (22331 17371 982369 -;;;;;; 658000)) +;;;### (autoloads nil "solar" "calendar/solar.el" (0 0 0 0)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -25456,8 +25090,7 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "solitaire" "play/solitaire.el" (22330 59913 -;;;;;; 970323 443000)) +;;;### (autoloads nil "solitaire" "play/solitaire.el" (0 0 0 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -25532,7 +25165,7 @@ Pick your favorite shortcuts: ;;;*** -;;;### (autoloads nil "sort" "sort.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "sort" "sort.el" (0 0 0 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25707,7 +25340,7 @@ is non-nil, it also prints a message describing the number of deletions. ;;;*** -;;;### (autoloads nil "spam" "gnus/spam.el" (22331 17372 36369 466000)) +;;;### (autoloads nil "spam" "gnus/spam.el" (0 0 0 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25721,8 +25354,8 @@ installed through `spam-necessary-extra-headers'. ;;;*** -;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (22331 -;;;;;; 17372 36369 466000)) +;;;### (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" "\ @@ -25764,8 +25397,7 @@ Spam reports will be queued with the method used when ;;;*** -;;;### (autoloads nil "speedbar" "speedbar.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "speedbar" "speedbar.el" (0 0 0 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25789,8 +25421,7 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** -;;;### (autoloads nil "spook" "play/spook.el" (22330 59913 970323 -;;;;;; 443000)) +;;;### (autoloads nil "spook" "play/spook.el" (0 0 0 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25805,8 +25436,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;*** -;;;### (autoloads nil "sql" "progmodes/sql.el" (22331 17372 100369 -;;;;;; 239000)) +;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/sql.el (push (purecopy '(sql 3 5)) package--builtin-versions) @@ -26272,15 +25902,14 @@ Run vsql as an inferior process. ;;;*** -;;;### (autoloads nil "srecode" "cedet/srecode.el" (22330 59913 920323 -;;;;;; 597000)) +;;;### (autoloads nil "srecode" "cedet/srecode.el" (0 0 0 0)) ;;; Generated autoloads from cedet/srecode.el (push (purecopy '(srecode 1 2)) package--builtin-versions) ;;;*** ;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (22330 59913 926323 578000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -26292,9 +25921,8 @@ Major-mode for writing SRecode macros. ;;;*** -;;;### (autoloads nil "starttls" "gnus/starttls.el" (22331 17372 -;;;;;; 36369 466000)) -;;; 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. @@ -26316,8 +25944,7 @@ GnuTLS requires a port number. ;;;*** -;;;### (autoloads nil "strokes" "strokes.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -26431,8 +26058,7 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** -;;;### (autoloads nil "studly" "play/studly.el" (22330 59913 969323 -;;;;;; 446000)) +;;;### (autoloads nil "studly" "play/studly.el" (0 0 0 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -26452,8 +26078,7 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads nil "subword" "progmodes/subword.el" (22330 59913 -;;;;;; 985323 396000)) +;;;### (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") @@ -26547,8 +26172,7 @@ See `superword-mode' for more information on Superword mode. ;;;*** -;;;### (autoloads nil "supercite" "mail/supercite.el" (22330 59913 -;;;;;; 948323 511000)) +;;;### (autoloads nil "supercite" "mail/supercite.el" (0 0 0 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26580,8 +26204,7 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** -;;;### (autoloads nil "t-mouse" "t-mouse.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (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") @@ -26614,7 +26237,7 @@ GPM. This is due to limitations in GPM and the Linux kernel. ;;;*** -;;;### (autoloads nil "tabify" "tabify.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "tabify" "tabify.el" (0 0 0 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26643,8 +26266,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;*** -;;;### (autoloads nil "table" "textmodes/table.el" (22331 17372 118369 -;;;;;; 175000)) +;;;### (autoloads nil "table" "textmodes/table.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/table.el (autoload 'table-insert "table" "\ @@ -27215,7 +26837,7 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads nil "talk" "talk.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "talk" "talk.el" (0 0 0 0)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -27230,8 +26852,7 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads nil "tar-mode" "tar-mode.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "tar-mode" "tar-mode.el" (0 0 0 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27254,8 +26875,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** -;;;### (autoloads nil "tcl" "progmodes/tcl.el" (22330 59913 985323 -;;;;;; 396000)) +;;;### (autoloads nil "tcl" "progmodes/tcl.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27303,8 +26923,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads nil "telnet" "net/telnet.el" (22330 59913 954323 -;;;;;; 492000)) +;;;### (autoloads nil "telnet" "net/telnet.el" (0 0 0 0)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -27329,7 +26948,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** -;;;### (autoloads nil "term" "term.el" (22331 17372 109369 207000)) +;;;### (autoloads nil "term" "term.el" (0 0 0 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -27371,8 +26990,8 @@ use in that buffer. ;;;*** -;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (22330 -;;;;;; 59913 930323 566000)) +;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (0 0 +;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -27382,8 +27001,7 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads nil "tetris" "play/tetris.el" (22330 59913 970323 -;;;;;; 443000)) +;;;### (autoloads nil "tetris" "play/tetris.el" (0 0 0 0)) ;;; Generated autoloads from play/tetris.el (push (purecopy '(tetris 2 1)) package--builtin-versions) @@ -27408,8 +27026,7 @@ tetris-mode keybindings: ;;;*** -;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (22331 17372 -;;;;;; 119369 171000)) +;;;### (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 "\ @@ -27710,8 +27327,7 @@ Major mode to edit DocTeX files. ;;;*** -;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (22330 59913 -;;;;;; 991323 378000)) +;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27750,8 +27366,7 @@ if large. You can use `Info-split' to do this manually. ;;;*** -;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (22331 17372 -;;;;;; 119369 171000)) +;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (0 0 0 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27835,8 +27450,8 @@ value of `texinfo-mode-hook'. ;;;*** -;;;### (autoloads nil "thai-util" "language/thai-util.el" (22330 -;;;;;; 59913 941323 532000)) +;;;### (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" "\ @@ -27863,8 +27478,7 @@ Compose Thai characters in the current buffer. ;;;*** -;;;### (autoloads nil "thingatpt" "thingatpt.el" (22331 17372 120369 -;;;;;; 168000)) +;;;### (autoloads nil "thingatpt" "thingatpt.el" (0 0 0 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27928,7 +27542,7 @@ Return the Lisp list at point, or nil if none is found. ;;;*** -;;;### (autoloads nil "thumbs" "thumbs.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "thumbs" "thumbs.el" (0 0 0 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -27962,15 +27576,14 @@ In dired, call the setroot program on the image at point. ;;;*** -;;;### (autoloads nil "thunk" "emacs-lisp/thunk.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (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) ;;;*** -;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (22330 -;;;;;; 59913 941323 532000)) +;;;### (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" "\ @@ -28043,8 +27656,7 @@ See also docstring of the function tibetan-compose-region. ;;;*** -;;;### (autoloads nil "tildify" "textmodes/tildify.el" (22330 59913 -;;;;;; 991323 378000)) +;;;### (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) @@ -28110,7 +27722,7 @@ variable will be set to the representation. ;;;*** -;;;### (autoloads nil "time" "time.el" (22330 59913 743324 144000)) +;;;### (autoloads nil "time" "time.el" (0 0 0 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -28173,8 +27785,8 @@ Return a string giving the duration of the Emacs initialization. ;;;*** -;;;### (autoloads nil "time-date" "calendar/time-date.el" (22331 -;;;;;; 17371 982369 658000)) +;;;### (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" "\ @@ -28277,8 +27889,7 @@ Convert the time interval in seconds to a short string. ;;;*** -;;;### (autoloads nil "time-stamp" "time-stamp.el" (22331 17372 120369 -;;;;;; 168000)) +;;;### (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) @@ -28318,8 +27929,8 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;*** -;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (22331 -;;;;;; 17371 983369 654000)) +;;;### (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) @@ -28429,8 +28040,20 @@ relative only to the time worked today, and not to past time. ;;;*** +;;;### (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.") + +;;;*** + ;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el" -;;;;;; (22330 59913 940323 535000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -28452,7 +28075,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** -;;;### (autoloads nil "tmm" "tmm.el" (22330 59913 743324 144000)) +;;;### (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) @@ -28494,19 +28117,18 @@ Its value should be an event that has a binding in MENU. ;;;*** -;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (22330 -;;;;;; 59913 919323 600000)) +;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-show "todo-mode" "\ Visit a todo file and display one of its categories. -When invoked in Todo mode, Todo Archive mode or Todo Filtered -Items mode, or when invoked anywhere else with a prefix argument, -prompt for which todo file to visit. When invoked outside of a -Todo mode buffer without a prefix argument, visit -`todo-default-todo-file'. Subsequent invocations from outside of -Todo mode revisit this file or, with option +When invoked in Todo mode, prompt for which todo file to visit. +When invoked outside of Todo mode with non-nil prefix argument +SOLICIT-FILE prompt for which todo file to visit; otherwise visit +`todo-default-todo-file'. Subsequent invocations from outside +of Todo mode revisit this file or, with option `todo-show-current-file' non-nil (the default), whichever todo file was last visited. @@ -28535,6 +28157,9 @@ by default. The done items are hidden, but typing items. With non-nil user option `todo-show-with-done' both todo and done items are always shown on visiting a category. +Invoking this command in Todo Archive mode visits the +corresponding todo file, displaying the corresponding category. + \(fn &optional SOLICIT-FILE INTERACTIVE)" t nil) (autoload 'todo-mode "todo-mode" "\ @@ -28560,8 +28185,7 @@ Mode for displaying and reprioritizing top priority Todo. ;;;*** -;;;### (autoloads nil "tool-bar" "tool-bar.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (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" "\ @@ -28631,8 +28255,7 @@ holds a keymap. ;;;*** -;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (22330 59913 931323 -;;;;;; 563000)) +;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28645,8 +28268,7 @@ to a tcp server on another machine. ;;;*** -;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28691,7 +28313,7 @@ the output buffer or changing the window configuration. ;;;*** -;;;### (autoloads nil "tramp" "net/tramp.el" (22331 17372 65369 363000)) +;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28700,26 +28322,24 @@ 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"))) "\ @@ -28740,14 +28360,12 @@ Also see `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"))) "\ @@ -28774,10 +28392,10 @@ pass to the OPERATION." (let* ((inhibit-file-name-handlers (\` (tramp-completion (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)))) +Falls back to normal file name handler if no Tramp file name handler exists." (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and fn tramp-mode (or (eq tramp-syntax (quote sep)) (featurep (quote tramp)) (and (boundp (quote partial-completion-mode)) (symbol-value (quote partial-completion-mode))) (featurep (quote ido)) (featurep (quote icicles)))) (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args)))) (defun tramp-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)) @@ -28806,8 +28424,7 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (22331 17372 -;;;;;; 61369 377000)) +;;;### (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" "\ @@ -28817,15 +28434,13 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "trampver" "net/trampver.el" (22331 17372 65369 -;;;;;; 363000)) +;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 2 13 25 1)) package--builtin-versions) +(push (purecopy '(tramp 2 3 0 -1)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "tutorial" "tutorial.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "tutorial" "tutorial.el" (0 0 0 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28849,8 +28464,7 @@ resumed later. ;;;*** -;;;### (autoloads nil "tv-util" "language/tv-util.el" (22330 59913 -;;;;;; 941323 532000)) +;;;### (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" "\ @@ -28860,8 +28474,8 @@ resumed later. ;;;*** -;;;### (autoloads nil "two-column" "textmodes/two-column.el" (22330 -;;;;;; 59913 991323 378000)) +;;;### (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) @@ -28908,8 +28522,7 @@ First column's text sSs Second column's text ;;;*** -;;;### (autoloads nil "type-break" "type-break.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "type-break" "type-break.el" (0 0 0 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29042,7 +28655,7 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads nil "uce" "mail/uce.el" (22330 59913 948323 511000)) +;;;### (autoloads nil "uce" "mail/uce.el" (0 0 0 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -29056,7 +28669,7 @@ You might need to set `uce-mail-reader' before using this. ;;;*** ;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el" -;;;;;; (22330 59913 940323 535000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -29121,8 +28734,8 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** -;;;### (autoloads nil "underline" "textmodes/underline.el" (22330 -;;;;;; 59913 991323 378000)) +;;;### (autoloads nil "underline" "textmodes/underline.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -29142,8 +28755,7 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "unrmail" "mail/unrmail.el" (22330 59913 948323 -;;;;;; 511000)) +;;;### (autoloads nil "unrmail" "mail/unrmail.el" (0 0 0 0)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -29163,8 +28775,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use. ;;;*** -;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (22330 59913 -;;;;;; 931323 563000)) +;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29176,7 +28787,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** -;;;### (autoloads nil "url" "url/url.el" (22331 17372 121369 164000)) +;;;### (autoloads nil "url" "url/url.el" (0 0 0 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -29218,16 +28829,17 @@ 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) ;;;*** -;;;### (autoloads nil "url-auth" "url/url-auth.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (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" "\ @@ -29268,8 +28880,7 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** -;;;### (autoloads nil "url-cache" "url/url-cache.el" (22330 59913 -;;;;;; 992323 375000)) +;;;### (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" "\ @@ -29290,8 +28901,7 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-cid" "url/url-cid.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-cid" "url/url-cid.el" (0 0 0 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -29301,8 +28911,7 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-dav" "url/url-dav.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (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" "\ @@ -29336,8 +28945,7 @@ added to this list, so most requests can just pass in nil. ;;;*** -;;;### (autoloads nil "url-file" "url/url-file.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-file" "url/url-file.el" (0 0 0 0)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -29347,8 +28955,7 @@ Handle file: and ftp: URLs. ;;;*** -;;;### (autoloads nil "url-gw" "url/url-gw.el" (22331 17372 120369 -;;;;;; 168000)) +;;;### (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" "\ @@ -29369,8 +28976,8 @@ overriding the value of `url-gateway-method'. ;;;*** -;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (22331 -;;;;;; 17372 120369 168000)) +;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -29432,8 +29039,7 @@ if it had been inserted from a file named URL. ;;;*** -;;;### (autoloads nil "url-http" "url/url-http.el" (22331 17372 121369 -;;;;;; 164000)) +;;;### (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") @@ -29445,8 +29051,7 @@ if it had been inserted from a file named URL. ;;;*** -;;;### (autoloads nil "url-irc" "url/url-irc.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-irc" "url/url-irc.el" (0 0 0 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -29456,8 +29061,7 @@ if it had been inserted from a file named URL. ;;;*** -;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (0 0 0 0)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -29470,8 +29074,7 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** -;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (22330 59913 -;;;;;; 992323 375000)) +;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (0 0 0 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -29486,8 +29089,7 @@ Handle the mailto: URL syntax. ;;;*** -;;;### (autoloads nil "url-misc" "url/url-misc.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-misc" "url/url-misc.el" (0 0 0 0)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -29518,8 +29120,7 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-news" "url/url-news.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-news" "url/url-news.el" (0 0 0 0)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29534,8 +29135,7 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-ns" "url/url-ns.el" (22330 59913 992323 -;;;;;; 375000)) +;;;### (autoloads nil "url-ns" "url/url-ns.el" (0 0 0 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -29575,8 +29175,7 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-parse" "url/url-parse.el" (22330 59913 -;;;;;; 992323 375000)) +;;;### (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" "\ @@ -29627,8 +29226,7 @@ parses to ;;;*** -;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (22330 59913 -;;;;;; 992323 375000)) +;;;### (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" "\ @@ -29638,8 +29236,7 @@ Setup variables that expose info about you and your system. ;;;*** -;;;### (autoloads nil "url-queue" "url/url-queue.el" (22331 17372 -;;;;;; 121369 164000)) +;;;### (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" "\ @@ -29653,8 +29250,7 @@ The variable `url-queue-timeout' sets a timeout. ;;;*** -;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (22330 59913 -;;;;;; 992323 375000)) +;;;### (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") "\ @@ -29672,8 +29268,7 @@ would have been passed to OPERATION. ;;;*** -;;;### (autoloads nil "url-util" "url/url-util.el" (22331 17372 121369 -;;;;;; 164000)) +;;;### (autoloads nil "url-util" "url/url-util.el" (0 0 0 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29841,8 +29436,7 @@ This uses `url-current-object', set locally to the buffer. ;;;*** -;;;### (autoloads nil "userlock" "userlock.el" (22330 59913 915323 -;;;;;; 612000)) +;;;### (autoloads nil "userlock" "userlock.el" (0 0 0 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29870,8 +29464,7 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf-7" "international/utf-7.el" (22330 59913 -;;;;;; 940323 535000)) +;;;### (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" "\ @@ -29896,8 +29489,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf7" "gnus/utf7.el" (22331 17372 37369 462000)) -;;; 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. @@ -29906,8 +29499,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;*** -;;;### (autoloads nil "uudecode" "mail/uudecode.el" (22330 59913 -;;;;;; 948323 511000)) +;;;### (autoloads nil "uudecode" "mail/uudecode.el" (0 0 0 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29931,7 +29523,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;*** -;;;### (autoloads nil "vc" "vc/vc.el" (22330 59914 13323 310000)) +;;;### (autoloads nil "vc" "vc/vc.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30247,8 +29839,7 @@ Return the branch part of a revision number REV. ;;;*** -;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (22330 59914 -;;;;;; 13323 310000)) +;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -30287,8 +29878,7 @@ should be applied to the background or to the foreground. ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (22331 17372 123369 -;;;;;; 157000)) +;;;### (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" "\ @@ -30304,8 +29894,7 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (22331 17372 123369 -;;;;;; 157000)) +;;;### (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." @@ -30316,8 +29905,7 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (22330 59914 13323 -;;;;;; 310000)) +;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -30341,8 +29929,8 @@ These are the commands available for use in the file status buffer: ;;;*** -;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (22331 -;;;;;; 17372 124369 153000)) +;;;### (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" "\ @@ -30365,8 +29953,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (22331 17372 124369 -;;;;;; 153000)) +;;;### (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." @@ -30377,7 +29964,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (22331 17372 124369 153000)) +;;;### (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." @@ -30388,8 +29975,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (22330 59914 13323 -;;;;;; 310000)) +;;;### (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" "\ @@ -30405,8 +29991,7 @@ Name of the monotone directory's format file.") ;;;*** -;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (22331 17372 125369 -;;;;;; 150000)) +;;;### (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")) "\ @@ -30419,8 +30004,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** -;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (22330 59914 13323 -;;;;;; 310000)) +;;;### (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)) "\ @@ -30438,8 +30022,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-src" "vc/vc-src.el" (22331 17372 125369 -;;;;;; 150000)) +;;;### (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")) "\ @@ -30452,8 +30035,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (22330 59914 13323 -;;;;;; 310000)) +;;;### (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) @@ -30466,8 +30048,8 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** -;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (22330 -;;;;;; 59913 985323 396000)) +;;;### (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)) @@ -30526,7 +30108,7 @@ Key bindings: ;;;*** ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (22331 17372 102369 231000)) +;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30665,8 +30247,8 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** -;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (22330 -;;;;;; 59913 977323 421000)) +;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -31220,8 +30802,8 @@ Key bindings: ;;;*** -;;;### (autoloads nil "viet-util" "language/viet-util.el" (22330 -;;;;;; 59913 941323 532000)) +;;;### (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" "\ @@ -31265,7 +30847,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;*** -;;;### (autoloads nil "view" "view.el" (22330 59913 915323 612000)) +;;;### (autoloads nil "view" "view.el" (0 0 0 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31521,8 +31103,7 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads nil "viper" "emulation/viper.el" (22331 17371 998369 -;;;;;; 601000)) +;;;### (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) @@ -31539,8 +31120,8 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** -;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (22330 -;;;;;; 59913 931323 563000)) +;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (0 0 0 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31630,7 +31211,7 @@ this is equivalent to `display-warning', using ;;;*** -;;;### (autoloads nil "wdired" "wdired.el" (22331 17372 126369 146000)) +;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0)) ;;; Generated autoloads from wdired.el (push (purecopy '(wdired 2 0)) package--builtin-versions) @@ -31648,8 +31229,7 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads nil "webjump" "net/webjump.el" (22330 59913 954323 -;;;;;; 492000)) +;;;### (autoloads nil "webjump" "net/webjump.el" (0 0 0 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31665,8 +31245,8 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** -;;;### (autoloads nil "which-func" "progmodes/which-func.el" (22331 -;;;;;; 17372 103369 228000)) +;;;### (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) @@ -31697,8 +31277,7 @@ in certain major modes. ;;;*** -;;;### (autoloads nil "whitespace" "whitespace.el" (22330 59913 743324 -;;;;;; 144000)) +;;;### (autoloads nil "whitespace" "whitespace.el" (0 0 0 0)) ;;; Generated autoloads from whitespace.el (push (purecopy '(whitespace 13 2 2)) package--builtin-versions) @@ -32068,8 +31647,7 @@ cleaning up these problems. ;;;*** -;;;### (autoloads nil "wid-browse" "wid-browse.el" (22330 59913 916323 -;;;;;; 609000)) +;;;### (autoloads nil "wid-browse" "wid-browse.el" (0 0 0 0)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -32097,8 +31675,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "wid-edit" "wid-edit.el" (22331 17372 126369 -;;;;;; 146000)) +;;;### (autoloads nil "wid-edit" "wid-edit.el" (0 0 0 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32140,8 +31717,7 @@ Setup current buffer so editing string widgets works. ;;;*** -;;;### (autoloads nil "windmove" "windmove.el" (22330 59913 916323 -;;;;;; 609000)) +;;;### (autoloads nil "windmove" "windmove.el" (0 0 0 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -32193,7 +31769,7 @@ Default MODIFIER is `shift'. ;;;*** -;;;### (autoloads nil "winner" "winner.el" (22330 59913 743324 144000)) +;;;### (autoloads nil "winner" "winner.el" (0 0 0 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -32223,7 +31799,7 @@ you can press `C-c <right>' (calling `winner-redo'). ;;;*** -;;;### (autoloads nil "woman" "woman.el" (22330 59913 916323 609000)) +;;;### (autoloads nil "woman" "woman.el" (0 0 0 0)) ;;; Generated autoloads from woman.el (push (purecopy '(woman 0 551)) package--builtin-versions) @@ -32272,7 +31848,7 @@ Default bookmark handler for Woman buffers. ;;;*** -;;;### (autoloads nil "xml" "xml.el" (22330 59913 916323 609000)) +;;;### (autoloads nil "xml" "xml.el" (0 0 0 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -32328,8 +31904,7 @@ Both features can be combined by providing a cons cell ;;;*** -;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (22331 17372 67369 -;;;;;; 356000)) +;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (0 0 0 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32347,8 +31922,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads nil "xref" "progmodes/xref.el" (22330 59913 977323 -;;;;;; 421000)) +;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/xref.el (autoload 'xref-find-backend "xref" "\ @@ -32415,8 +31989,7 @@ IGNORES is a list of glob patterns. ;;;*** -;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (22330 59913 743324 -;;;;;; 144000)) +;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (0 0 0 0)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -32446,8 +32019,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** -;;;### (autoloads nil "xwidget" "xwidget.el" (22331 17377 954348 -;;;;;; 447000)) +;;;### (autoloads nil "xwidget" "xwidget.el" (0 0 0 0)) ;;; Generated autoloads from xwidget.el (autoload 'xwidget-webkit-browse-url "xwidget" "\ @@ -32459,8 +32031,8 @@ Interactively, URL defaults to the string looking like a url around point. ;;;*** -;;;### (autoloads nil "yenc" "gnus/yenc.el" (22331 17372 37369 462000)) -;;; 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. @@ -32474,7 +32046,7 @@ Extract file name from an yenc header. ;;;*** -;;;### (autoloads nil "zone" "play/zone.el" (22330 59913 970323 443000)) +;;;### (autoloads nil "zone" "play/zone.el" (0 0 0 0)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -32520,16 +32092,14 @@ Zone out, completely. ;;;;;; "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" ;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el" ;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" -;;;;;; "cedet/semantic/bovine/c-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/bovine/c.el" "cedet/semantic/bovine/debug.el" +;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" +;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el" +;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" +;;;;;; "cedet/semantic/db-debug.el" "cedet/semantic/db-ebrowse.el" +;;;;;; "cedet/semantic/db-el.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" +;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-javascript.el" +;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el" ;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate.el" ;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" ;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/ede-grammar.el" @@ -32547,22 +32117,20 @@ Zone out, completely. ;;;;;; "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/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" +;;;;;; "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" @@ -32582,38 +32150,36 @@ Zone out, completely. ;;;;;; "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" +;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" +;;;;;; "gnus/gnus-cloud.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el" +;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-icalendar.el" +;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el" +;;;;;; "gnus/gnus-rfc1843.el" "gnus/gnus-salt.el" "gnus/gnus-score.el" +;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el" +;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el" +;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-source.el" "gnus/messcompat.el" +;;;;;; "gnus/mm-archive.el" "gnus/mm-bodies.el" "gnus/mm-decode.el" +;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" +;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" +;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el" +;;;;;; "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" "gnus/nnmaildir.el" +;;;;;; "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el" +;;;;;; "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" "gnus/nnspool.el" +;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/smime.el" +;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el" "hfy-cmap.el" +;;;;;; "htmlfontify-loaddefs.el" "ibuf-ext.el" "image/compface.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" -;;;;;; "international/uni-brackets.el" "international/uni-category.el" -;;;;;; "international/uni-combining.el" "international/uni-comment.el" -;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" -;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" -;;;;;; "international/uni-mirrored.el" "international/uni-name.el" -;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" -;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" -;;;;;; "kermit.el" "language/hanja-util.el" "language/thai-word.el" -;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/quail/arabic.el" +;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/rfc1843.el" +;;;;;; "international/uni-bidi.el" "international/uni-brackets.el" +;;;;;; "international/uni-category.el" "international/uni-combining.el" +;;;;;; "international/uni-comment.el" "international/uni-decimal.el" +;;;;;; "international/uni-decomposition.el" "international/uni-digit.el" +;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el" +;;;;;; "international/uni-name.el" "international/uni-numeric.el" +;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el" +;;;;;; "international/uni-uppercase.el" "kermit.el" "language/hanja-util.el" +;;;;;; "language/thai-word.el" "ldefs-boot.el" "leim/quail/arabic.el" ;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" ;;;;;; "leim/quail/czech.el" "leim/quail/ethiopic.el" "leim/quail/georgian.el" ;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el" @@ -32627,9 +32193,11 @@ Zone out, completely. ;;;;;; "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/ietf-drums.el" "mail/mail-parse.el" "mail/mail-prsvr.el" +;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2045.el" +;;;;;; "mail/rfc2047.el" "mail/rfc2231.el" "mail/rfc2368.el" "mail/rfc822.el" +;;;;;; "mail/rmail-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" @@ -32640,25 +32208,25 @@ Zone out, completely. ;;;;;; "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" +;;;;;; "net/ldap.el" "net/mailcap.el" "net/mairix.el" "net/newsticker.el" +;;;;;; "net/nsm.el" "net/puny.el" "net/rfc2104.el" "net/sasl-cram.el" +;;;;;; "net/sasl-digest.el" "net/sasl-scram-rfc.el" "net/sasl.el" +;;;;;; "net/shr-color.el" "net/sieve-manage.el" "net/soap-inspect.el" +;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" +;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el" +;;;;;; "net/tramp-gw.el" "net/tramp-loaddefs.el" "net/tramp-sh.el" +;;;;;; "net/tramp-smb.el" "net/tramp-uu.el" "net/zeroconf.el" "notifications.el" +;;;;;; "nxml/nxml-enc.el" "nxml/nxml-maint.el" "nxml/nxml-ns.el" +;;;;;; "nxml/nxml-outln.el" "nxml/nxml-parse.el" "nxml/nxml-rap.el" +;;;;;; "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el" "nxml/rng-maint.el" +;;;;;; "nxml/rng-match.el" "nxml/rng-parse.el" "nxml/rng-pttrn.el" +;;;;;; "nxml/rng-uri.el" "nxml/rng-util.el" "nxml/xsd-regexp.el" +;;;;;; "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" "org/ob-awk.el" +;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-core.el" +;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el" +;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el" +;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el" +;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el" ;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" "org/ob-matlab.el" ;;;;;; "org/ob-maxima.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el" ;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el" @@ -32687,22 +32255,22 @@ Zone out, completely. ;;;;;; "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") (22331 19288 214877 938000)) +;;;;;; "registry.el" "rtree.el" "sb-image.el" "scroll-bar.el" "soundex.el" +;;;;;; "subdirs.el" "svg.el" "tempo.el" "textmodes/bib-mode.el" +;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" +;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" +;;;;;; "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") (0 0 0 0)) ;;;*** diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index 078f9f99fab..138a97ac28a 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -188,6 +188,7 @@ diaeresis | \" | \"i -> ï \"\" -> ¨ tilde | ~ | ~n -> ñ cedilla | ~ | ~c -> ç + middle dot | ~ | ~. -> · symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ " nil t nil nil nil nil nil nil nil nil t) @@ -223,6 +224,7 @@ ("~<" ?\«) ("~!" ?¡) ("~?" ?¿) + ("~." ?·) ("~ " ?~) ) 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..db3c36d1f01 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) @@ -157,9 +161,16 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) +(let ((new (make-hash-table :test 'equal))) + ;; Now that loaddefs has populated definition-prefixes, purify its contents. + (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) + definition-prefixes) + (setq definition-prefixes new)) + (load "emacs-lisp/nadvice") (load "emacs-lisp/cl-preloaded") (load "minibuffer") ;After loaddefs, for define-minor-mode. +(load "obarray") ;abbrev.el is implemented in terms of obarrays. (load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table. (load "simple") diff --git a/lisp/lpr.el b/lisp/lpr.el index 04e3b38ab17..2fe32c7d5e7 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -36,7 +36,7 @@ ;;;###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.") diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 85e91cdadc0..11cbea0b373 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 ce3c50bce2b..18eaa22b34c 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/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..4f3e71d34b8 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -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..4cb10e54393 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -267,7 +267,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 +290,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 +315,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 +351,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 +549,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 +585,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 +609,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 +693,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)) @@ -947,7 +940,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 +956,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 +1080,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 +1098,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..734155e217d 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. @@ -4588,6 +4591,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 +4734,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/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/menu-bar.el b/lisp/menu-bar.el index 6571a4b9d4f..933e2d22f67 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -535,7 +535,9 @@ (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((gui-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t) + (interprogram-paste-function (or interprogram-paste-function + #'gui-selection-value))) (yank))) (defun clipboard-kill-ring-save (beg end &optional region) @@ -543,7 +545,9 @@ If the optional argument REGION is non-nil, the function ignores BEG and END, and saves the current region instead." (interactive "r\np") - (let ((gui-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t) + (interprogram-cut-function (or interprogram-cut-function + #'gui-select-text))) (kill-ring-save beg end region))) (defun clipboard-kill-region (beg end &optional region) @@ -551,7 +555,9 @@ BEG and END, and saves the current region instead." If the optional argument REGION is non-nil, the function ignores BEG and END, and kills the current region instead." (interactive "r\np") - (let ((gui-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t) + (interprogram-cut-function (or interprogram-cut-function + #'gui-select-text))) (kill-region beg end region))) (defun menu-bar-enable-clipboard () @@ -1581,7 +1587,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-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..20029f8e0b5 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 diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1ee05d32de5..9190c1fb203 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1970,7 +1970,7 @@ if there was no valid completion, else t." "Default function to use for `completion-in-region-function'. Its arguments and return value are as specified for `completion-in-region'. This respects the wrapper hook `completion-in-region-functions'." - (with-wrapper-hook + (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) diff --git a/lisp/mouse.el b/lisp/mouse.el index fa355ffeb71..3e3708a2e0d 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -97,35 +97,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 +164,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))))))) 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/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..6a8400320c2 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -31,6 +31,7 @@ (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 @@ -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) @@ -410,7 +418,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 +426,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 +580,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 +669,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)) @@ -703,9 +715,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) @@ -726,10 +740,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 +1533,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 +1559,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) 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..ae49972f5bf 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/net/mailcap.el @@ -32,26 +32,6 @@ (eval-when-compile (require 'cl)) (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) + (setq res (cons (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) + (setq res (cons `((viewer . ,(car entry)) + (type . ,(cadr entry)) + ,@(when (caddr entry) + `((test . ,(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 @@ -726,6 +753,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. @@ -758,41 +799,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) + (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)))) (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 @@ -993,7 +1040,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 +1068,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 +1093,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..b13bece3912 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." diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 11885987ba5..c2845d96a5d 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -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 + "25.2") (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/nsm.el b/lisp/net/nsm.el index d0b55437732..72bff66c381 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -297,19 +297,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 +332,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/gnus/pop3.el b/lisp/net/pop3.el index fc593806bfc..1695bbd3a40 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) @@ -533,13 +527,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 +539,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 +563,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 +631,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/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/shr.el b/lisp/net/shr.el index 2c8ff79763f..9d42fde0756 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -36,6 +36,7 @@ (require 'subr-x) (require 'dom) (require 'seq) +(require 'svg) (defgroup shr nil "Simple HTML Renderer" @@ -64,6 +65,12 @@ fit these criteria." :group 'shr :type 'boolean) +(defcustom shr-use-colors t + "If non-nil, respect color specifications in the HTML." + :version "25.2" + :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 +143,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 +166,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 +186,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 +274,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. @@ -435,11 +452,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 +470,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 @@ -535,6 +554,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)) @@ -545,14 +574,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 " ")) @@ -562,14 +588,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. @@ -952,10 +975,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. @@ -978,21 +1005,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)) @@ -1071,8 +1117,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." @@ -1104,7 +1157,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 @@ -1117,18 +1172,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) @@ -1137,7 +1180,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) @@ -1223,9 +1268,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)) @@ -1245,6 +1287,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 @@ -1388,11 +1448,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 "*")) @@ -1405,7 +1468,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)) @@ -1414,7 +1478,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))) @@ -1422,20 +1487,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 @@ -1444,6 +1515,87 @@ 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 " "))) + (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 srcset ", ")) + (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 image) + (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)) @@ -1510,7 +1662,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. @@ -1573,6 +1727,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 diff --git a/lisp/gnus/sieve-manage.el b/lisp/net/sieve-manage.el index 212a7fd9f35..695bbd860de 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") @@ -202,7 +201,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" diff --git a/lisp/gnus/sieve-mode.el b/lisp/net/sieve-mode.el index 5ea687dd918..77ab44f02db 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -57,7 +57,6 @@ (defcustom sieve-mode-hook nil "Hook run in sieve mode buffers." - :group 'sieve :type 'hook) ;; Font-lock @@ -72,8 +71,7 @@ (((class color) (background light)) (:foreground "Orchid")) (((class color) (background dark)) (:foreground "LightSteelBlue")) (t (:bold t))) - "Face used for Sieve Control Commands." - :group 'sieve) + "Face used for Sieve Control Commands.") ;; backward-compatibility alias (put 'sieve-control-commands-face 'face-alias 'sieve-control-commands) (put 'sieve-control-commands-face 'obsolete-face "22.1") @@ -86,8 +84,7 @@ (((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) + "Face used for Sieve Action Commands.") ;; backward-compatibility alias (put 'sieve-action-commands-face 'face-alias 'sieve-action-commands) (put 'sieve-action-commands-face 'obsolete-face "22.1") @@ -104,8 +101,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) + "Face used for Sieve Test Commands.") ;; backward-compatibility alias (put 'sieve-test-commands-face 'face-alias 'sieve-test-commands) (put 'sieve-test-commands-face 'obsolete-face "22.1") @@ -120,8 +116,7 @@ (((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) (t (:bold t))) - "Face used for Sieve Tagged Arguments." - :group 'sieve) + "Face used for Sieve Tagged Arguments.") ;; backward-compatibility alias (put 'sieve-tagged-arguments-face 'face-alias 'sieve-tagged-arguments) (put 'sieve-tagged-arguments-face 'obsolete-face "22.1") @@ -149,28 +144,27 @@ ;; 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 +176,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 +225,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..2046e53697d 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/net/sieve.el 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 f3ef5e023f9..096ed2adc0d 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/net/starttls.el @@ -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..5940b713958 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -35,10 +35,6 @@ (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." @@ -109,7 +105,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) @@ -162,7 +157,7 @@ It is used for TCP/IP devices." (shell-command . tramp-adb-handle-shell-command) (start-file-process . tramp-adb-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-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,7 +194,7 @@ 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) + (set-process-query-on-exit-flag p nil) (while (eq 'run (process-status p)) (accept-process-output p 0.1)) (accept-process-output p 0.1) @@ -213,7 +208,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 +228,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 @@ -261,8 +253,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)) @@ -312,8 +303,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. @@ -450,9 +440,8 @@ 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 @@ -585,8 +574,7 @@ Emacs dired can't find files." 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 +619,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)) @@ -657,8 +644,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." @@ -736,10 +722,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)) @@ -755,7 +739,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "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 +841,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. @@ -941,9 +921,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 @@ -1008,7 +986,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 +1013,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 +1029,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 @@ -1205,7 +1183,7 @@ connection if a previous connection has died for some reason." (unless (eq 'run (process-status 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 +1228,7 @@ connection if a previous connection has died for some reason." ;; Read the expression. (goto-char (point-min)) (read (current-buffer))) - ":" 'omit-nulls)) + ":" 'omit)) ;; 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..158cfb5cae3 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -75,25 +75,7 @@ details see the info pages." (choice :tag " Value" sexp)))) (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) @@ -241,8 +223,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) @@ -259,8 +243,10 @@ If the value is not set for the connection, returns DEFAULT." ;;;###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 +262,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 +297,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)" @@ -418,8 +403,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..856011fc0ee 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) @@ -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,7 +187,6 @@ 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 @@ -194,8 +195,7 @@ This includes password cache, file cache, connection cache, buffers." '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 +243,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 +264,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." @@ -303,7 +296,7 @@ buffer in your bug report. ;; Non-tramp variables of interest. '(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 +306,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 +315,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. @@ -364,13 +357,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)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 44923aee895..0e9fcb501a7 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,9 +23,8 @@ ;;; 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 25. This +;; package provides compatibility functions for Emacs 23 and Emacs 24. ;;; Code: @@ -33,164 +32,57 @@ (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 '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) + `(when (or (subrp ,function) (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,105 +100,23 @@ (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))) + ;; 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 @@ -320,21 +130,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)." @@ -401,12 +203,10 @@ 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)) @@ -418,42 +218,6 @@ Not actually used. Use `(format \"%o\" i)' instead?" directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) (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 +230,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,135 +240,16 @@ 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))))))))) ;; `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))) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 902b0a4ed86..caca3c0cb4c 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 @@ -104,14 +95,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 +187,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..098d40e7cc0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -422,7 +422,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) @@ -474,7 +473,7 @@ Every entry is a list (NAME ADDRESS).") (shell-command . ignore) (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-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)) @@ -562,8 +561,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. @@ -623,19 +621,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. @@ -693,19 +691,18 @@ 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." @@ -923,7 +920,7 @@ file names." (tramp-error v 'file-error "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) @@ -960,7 +957,7 @@ file names." (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))))) + (number-sequence (length filename) 1 -1))))) ;; Cache expired or no matching cache entry found so we need ;; to perform a remote operation. @@ -1024,9 +1021,9 @@ 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. @@ -1039,7 +1036,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 +1044,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 +1057,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 +1076,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 +1122,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 +1131,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"))) @@ -1203,8 +1200,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 +1289,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)) @@ -1533,7 +1529,7 @@ connection if a previous connection has died for some reason." :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))) + (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) (let* ((method (tramp-file-name-method vec)) @@ -1755,7 +1751,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 ";")) diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index f868bead09a..a1ddceb4682 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -108,7 +108,7 @@ 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) + (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)) @@ -158,7 +158,7 @@ instead of the host name declared in TARGET-VEC." :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) + (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)))) @@ -204,7 +204,7 @@ instead of the host name declared in 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) + (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")) @@ -235,14 +235,14 @@ authentication is requested from proxy server, provide it." (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) + (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! + (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, diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bff6ec31156..14c6f949853 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -32,7 +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) @@ -118,7 +117,7 @@ detected as prompt when being sent on echoing hosts, therefore.") "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. @@ -285,6 +284,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") @@ -300,6 +308,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"))) @@ -380,9 +396,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" @@ -401,7 +416,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. @@ -447,12 +462,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 @@ -471,7 +491,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) @@ -484,7 +506,7 @@ 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 @@ -986,10 +1008,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) @@ -1025,8 +1044,6 @@ 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) @@ -1041,7 +1058,7 @@ of command line.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-sh-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-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)) @@ -1148,10 +1165,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 @@ -1200,9 +1215,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))))) @@ -1355,8 +1369,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? @@ -1370,8 +1384,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,8 +1441,7 @@ target of the symlink differ." (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))) + (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))) @@ -1443,8 +1455,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 @@ -1463,7 +1474,7 @@ 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) @@ -1508,48 +1519,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. @@ -1653,8 +1642,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." @@ -1905,7 +1893,7 @@ be non-negative integers." (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))))) + (number-sequence (length filename) 1 -1))))) ;; Cache expired or no matching cache entry found so we need ;; to perform a remote operation. @@ -1928,14 +1916,7 @@ be non-negative integers." (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))) + (if read-file-name-completion-ignore-case 1 0))) (format (concat "(cd %s 2>&1 && (%s -a %s 2>/dev/null" @@ -2058,19 +2039,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) @@ -2125,7 +2105,8 @@ 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)))) @@ -2291,11 +2272,11 @@ the uid and gid from FILENAME." op)))) (localname1 (if t1 - (tramp-file-name-handler 'file-remote-p filename 'localname) + (file-remote-p filename 'localname) filename)) (localname2 (if t2 - (tramp-file-name-handler 'file-remote-p newname 'localname) + (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -2333,12 +2314,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 @@ -2378,15 +2359,14 @@ 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 + (copy-file localname1 tmpfile t keep-date preserve-uid-gid) (tramp-run-real-handler @@ -2395,8 +2375,7 @@ the uid and gid from FILENAME." ;; 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) @@ -2455,7 +2434,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))))) @@ -2628,7 +2607,7 @@ The method used must be an out-of-band method." orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (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. @@ -2676,7 +2655,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." @@ -2716,51 +2695,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 @@ -2778,8 +2722,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 @@ -2789,8 +2732,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")) @@ -2900,9 +2842,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; 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)) @@ -2929,9 +2869,10 @@ 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)) + (tramp-drop-volume-letter + (tramp-run-real-handler 'expand-file-name (list name nil))) ;; Dissect NAME. (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) @@ -2965,13 +2906,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 @@ -3093,7 +3031,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 @@ -3103,7 +3041,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)))) @@ -3227,12 +3165,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. @@ -3258,7 +3191,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 @@ -3319,30 +3252,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) @@ -3359,14 +3268,13 @@ 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 (nth 2 (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) - (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer)) + (gid (or (nth 3 (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) (if (and (tramp-local-host-p v) @@ -3424,9 +3332,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 @@ -3436,7 +3342,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 @@ -3576,7 +3482,7 @@ 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 @@ -3611,7 +3517,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) @@ -3768,7 +3674,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 @@ -3789,10 +3700,10 @@ 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. @@ -3805,16 +3716,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)) @@ -3831,59 +3743,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: @@ -3899,7 +3817,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) @@ -3972,8 +3890,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)) @@ -4216,45 +4133,36 @@ 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" (tramp-get-connection-property vec "uname" "")) - 'mac 'unix))) - (tramp-send-command vec "echo foo ; echo bar" t) - (goto-char (point-min)) - (when (search-forward "\r" nil t) - (setq cs-decode (tramp-compat-coding-system-change-eol-conversion - cs-decode 'dos))) - ;; Special setting for Mac OS X. - (when (and (string-match - "^Darwin" (tramp-get-connection-property vec "uname" "")) - (memq 'utf-8-hfs (coding-system-list))) - (setq cs-decode 'utf-8-hfs - cs-encode 'utf-8-hfs)) - (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. + ;; Use MULE to select the right EOL convention for communicating + ;; with the process. + (let ((cs (or (and (memq 'utf-8 (coding-system-list)) + (string-match "utf-?8" (tramp-get-remote-locale vec)) + (cons 'utf-8 'utf-8)) + (process-coding-system proc) + (cons 'undecided 'undecided))) + cs-decode cs-encode) + (when (symbolp cs) (setq cs (cons cs cs))) + (setq cs-decode (or (car cs) 'undecided) + cs-encode (or (cdr cs) 'undecided) + cs-encode + (coding-system-change-eol-conversion + cs-encode + (if (string-match + "^Darwin" (tramp-get-connection-property vec "uname" "")) + 'mac 'unix))) + (tramp-send-command vec "echo foo ; echo bar" t) + (goto-char (point-min)) (when (search-forward "\r" nil t) - ;; 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)))) + (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) + ;; Special setting for Mac OS X. + (when (and (string-match + "^Darwin" (tramp-get-connection-property vec "uname" "")) + (memq 'utf-8-hfs (coding-system-list))) + (setq cs-decode 'utf-8-hfs + cs-encode 'utf-8-hfs)) + (set-buffer-process-coding-system cs-decode cs-encode) + (tramp-message + vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) (tramp-send-command vec "set +o vi +o emacs" t) @@ -4311,7 +4219,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) @@ -4324,7 +4232,7 @@ process to set up. VEC specifies the connection." (copy-sequence tramp-remote-process-environment))) 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) @@ -4514,8 +4422,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 @@ -4711,7 +4618,7 @@ Gateway hops are already opened." (push (vector (tramp-file-name-method hop) (tramp-file-name-user hop) - (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil) + (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 @@ -4845,6 +4752,7 @@ connection if a previous connection has died for some reason." (unless (and p (processp p) (memq (process-status p) '(run open))) ;; 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)) @@ -4882,6 +4790,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 unfortune 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. @@ -4899,7 +4810,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)) @@ -5198,12 +5109,12 @@ Return ATTR." (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) (setcar (nthcdr 2 attr) -1)) (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)) (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)) @@ -5224,7 +5135,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)) @@ -5356,7 +5267,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))) @@ -5364,7 +5275,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))) @@ -5570,7 +5481,7 @@ 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))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 509e2e388b8..c4dde050c83 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -224,7 +224,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) @@ -276,7 +275,7 @@ See `tramp-actions-before-shell' for more info.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-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)) @@ -419,12 +418,11 @@ 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) @@ -448,7 +446,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 @@ -510,7 +508,7 @@ 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)) @@ -520,7 +518,7 @@ pass to the OPERATION." ;; 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 @@ -555,7 +553,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 @@ -601,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapc (lambda (file) (if (file-directory-p file) - (tramp-compat-delete-directory file recursive) + (delete-directory file recursive) (delete-file file))) ;; We do not want to delete "." and "..". (directory-files @@ -665,7 +664,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) ;; Remove double entries. - (tramp-compat-delete-dups result))) + (delete-dups result))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -730,7 +729,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"))) @@ -765,11 +764,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) @@ -1068,9 +1066,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. @@ -1240,12 +1236,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,9 +1287,10 @@ 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) @@ -1325,10 +1317,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))) @@ -1364,7 +1356,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 +1379,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))))) @@ -1460,9 +1450,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." "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"))) @@ -1575,10 +1563,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)))))) @@ -1738,7 +1722,7 @@ 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." @@ -1878,7 +1862,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 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 26672d1fabb..28fc9c748bb 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: @@ -102,11 +96,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are :group 'tramp :type 'integer) -;; 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 +107,9 @@ 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")))) (defcustom tramp-auto-save-directory nil "Put auto-save files in this directory, if set. @@ -154,9 +120,7 @@ This setting has precedence over `auto-save-file-name-transforms'." (directory :tag "Auto save directory name"))) (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 @@ -180,16 +144,14 @@ use for the remote host." :type '(file :must-match t)) (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) (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" @@ -329,25 +291,9 @@ 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. @@ -482,6 +428,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. @@ -541,7 +488,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' @@ -559,6 +506,7 @@ This regexp must match both `tramp-initial-end-of-output' and (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")) @@ -677,28 +625,17 @@ 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) + :type '(choice (const :tag "Ange-FTP" ftp) (const :tag "XEmacs" sep))) (defconst tramp-prefix-format @@ -883,15 +820,13 @@ 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 @@ -919,7 +854,6 @@ Also see `tramp-file-name-structure'.") (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 +862,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 +884,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. @@ -1077,9 +1007,10 @@ 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 @@ -1111,11 +1042,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)))) @@ -1230,11 +1160,10 @@ their replacement." ;; 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 +1181,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. @@ -1447,8 +1375,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,7 +1408,6 @@ 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-condition-case-unless-debug" "tramp-debug-message" "tramp-error" @@ -1651,14 +1577,13 @@ 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) (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 +1600,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 +1630,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 +1645,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) @@ -1787,16 +1710,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 +1730,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 +1757,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 +1775,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 +1806,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 +1827,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 +1886,35 @@ 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)) (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 +1925,28 @@ 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)) 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 +1954,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)) @@ -2121,13 +1992,15 @@ Falls back to normal file name handler if no Tramp file name handler exists." (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))) + (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)) - result) + (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 @@ -2191,8 +2064,13 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; Propagate the error. (t (signal (car err) (cdr err)))))) - ;; Nothing to do for us. - (tramp-run-real-handler operation args))))) + ;; Nothing to do for us. However, since we are in + ;; `tramp-mode', we must suppress the volume letter on + ;; MS Windows. + (setq result (tramp-run-real-handler operation args)) + (if (stringp result) + (tramp-drop-volume-letter result) + result))))) ;; When `tramp-mode' is not enabled, we don't do anything. (tramp-run-real-handler operation args))) @@ -2224,17 +2102,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 +2120,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 +2128,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))) @@ -2343,6 +2219,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 +2238,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,24 +2252,7 @@ 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. @@ -2407,10 +2265,25 @@ not in completion mode." (p (tramp-get-connection-process v))) (and p (processp p) (memq (process-status p) '(run open)))))))) +(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 +2356,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 +2547,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 +2659,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 +2683,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 +2729,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 +2771,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 +2780,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 +2790,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) @@ -2946,13 +2841,17 @@ 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-completion @@ -3035,43 +2934,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 @@ -3182,8 +3057,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 +3067,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))) @@ -3251,7 +3123,7 @@ User is always nil." (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))) @@ -3345,9 +3217,7 @@ 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. @@ -3367,14 +3237,6 @@ User is always nil." (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) "/")) - (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." (unless (buffer-file-name) @@ -3403,7 +3265,7 @@ 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) @@ -3454,7 +3316,7 @@ of." (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: @@ -3657,9 +3519,7 @@ for process communication also." ;; 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)))) + (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))))) @@ -3684,11 +3544,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,22 +3565,15 @@ 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 (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))))) (t (while (not found) (tramp-accept-process-output proc 1) @@ -3761,9 +3613,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 +3678,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))))))) @@ -3935,9 +3776,10 @@ This is used internally by `tramp-file-mode-from-int'." ;;;###tramp-autoload (defun tramp-get-local-gid (id-format) + ;; `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)))) + (nth 3 (file-attributes "~/" id-format)))) (defun tramp-get-local-locale (&optional vec) ;; We use key nil for local connection properties. @@ -3979,7 +3821,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) @@ -4050,7 +3892,7 @@ be granted." (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) (with-tramp-connection-property vec "tmpdir" (or (and (file-directory-p dir) (file-writable-p dir) - (tramp-file-name-handler 'file-remote-p dir 'localname)) + (file-remote-p dir 'localname)) (tramp-error vec 'file-error "Directory %s not accessible" dir))) dir)) @@ -4071,7 +3913,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 +3929,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 +3943,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 @@ -4120,61 +3958,8 @@ this file, if that variable is non-nil." ("]" . "_r")) (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. @@ -4268,27 +4053,24 @@ 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) :host tramp-current-host @@ -4298,21 +4080,17 @@ Invokes `password-read' if available, `read-passwd' else." auth-passwd (if (functionp auth-passwd) (funcall auth-passwd) auth-passwd)) - (tramp-compat-funcall - 'auth-source-user-or-password + (tramp-compat-funcall 'auth-source-user-or-password "password" tramp-current-host tramp-current-method)))) ;; Try the password cache. - (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) @@ -4324,11 +4102,10 @@ Invokes `password-read' if available, `read-passwd' else." (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 + (password-cache-remove (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -4351,24 +4128,8 @@ Invokes `password-read' if available, `read-passwd' else." (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))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -4463,7 +4224,6 @@ 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) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index fc65c0a1081..64cc47e26a5 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.1 +;; Version: 2.3.0-pre ;; 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.1" +(defconst tramp-version "2.3.0-pre" "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.1 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.0-pre 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/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..edc7414bfbf 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 @@ -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))) @@ -1880,7 +1758,7 @@ 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") @@ -1909,7 +1787,7 @@ 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. @@ -1974,7 +1852,7 @@ 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. @@ -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) @@ -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..946bf791ff8 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. @@ -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/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/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 8c118ec7dd0..9b6702f01ed 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..b7e8c237256 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -37,7 +37,7 @@ (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)) @@ -46,13 +46,13 @@ (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 with-parsed-tramp-file-name "tramp" (filename var &rest body) + t) (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 +73,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 +310,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 +549,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 +594,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 +691,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 +745,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 +832,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 +901,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 +1026,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 +1543,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 +1697,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 +1735,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) 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..e8bf9703b03 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,8 +409,7 @@ 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 (unless (fboundp 'user-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 61bcb451d70..1d060f871fe 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/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/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..62c50c0f4a1 100644 --- a/lisp/gnus/plstore.el +++ b/lisp/plstore.el @@ -422,7 +422,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 +554,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 +561,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/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/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/cc-defs.el b/lisp/progmodes/cc-defs.el index 4c78bc3975c..64e57017174 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 diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index eb015acf320..2450a5db8b9 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -385,6 +385,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 @@ -1543,7 +1562,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 +1733,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 +1754,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 +1801,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 +1827,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 +1940,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 +1963,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 +2074,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 @@ -5811,13 +5859,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 +5886,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 +6046,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 +6091,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 +6436,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 +6530,14 @@ 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)) + ((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)) @@ -6875,31 +6945,39 @@ 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 (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 +7002,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 @@ -6957,9 +7039,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 +7072,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 +7080,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 @@ -7090,12 +7176,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 +7206,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 +7262,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 +7324,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) @@ -7347,36 +7460,42 @@ comment at the start of cc-engine.el for more info." (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 @@ -7388,7 +7507,7 @@ comment at the start of cc-engine.el for more info." (eq (char-before pos) ?\))) (c-fdoc-shift-type-backward) (goto-char pos) - t)) + t))) (c-forward-syntactic-ws)) @@ -7697,12 +7816,16 @@ comment at the start of cc-engine.el for more info." 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. + (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,6 +7837,7 @@ 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 @@ -7837,9 +7961,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. @@ -8986,6 +9112,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(")) @@ -10246,9 +10378,12 @@ 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)) + (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)))) (setq placeholder (c-point 'boi)) (or (consp special-brace-list) (and (or (save-excursion @@ -10300,9 +10435,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 +11071,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..4e83d6df620 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1336,6 +1336,32 @@ casts and declarations are fontified. Used on level 2 and higher." (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)) @@ -1361,17 +1387,17 @@ casts and declarations are fontified. Used on level 2 and higher." (c-backward-syntactic-ws) (unless (bobp) (c-put-char-property (1- (point)) 'c-type - (if (cdr decl-or-cast) + (if (cadr decl-or-cast) 'c-decl-type-start 'c-decl-id-start))))) (c-font-lock-declarators - (point-max) decl-list (cdr decl-or-cast))) + (point-max) decl-list (cadr 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) + nil)) ;; Restore point, since at this point in the code it has been ;; left undefined by c-forward-decl-or-cast-1 above. @@ -1699,10 +1725,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) ?=)) @@ -1828,7 +1862,7 @@ higher." "\\)\\>" ;; 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 diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index dd1bccf3d96..705f723d55d 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -619,6 +619,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." @@ -1325,6 +1330,14 @@ 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)) + ;;; Syntactic whitespace. @@ -2297,6 +2310,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 @@ -3064,7 +3086,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 '((?{ . ?}) (?\[ . ?\]) (?< . ?>))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 738870b727a..de903b80ade 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 @@ -674,9 +698,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]") @@ -1224,7 +1247,7 @@ Note that the style variables are always made local to the buffer." (backward-char)) ; back over (, [, <. (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 @@ -1476,18 +1499,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 C++ @@ -1531,18 +1552,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 +1603,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 +1662,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 +1708,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 +1757,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 +1783,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 +1818,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..8cad27fd86d 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1632,12 +1632,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. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f060b571b7c..f2e397a4136 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -161,6 +161,13 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning\\(?: [0-9]+\\)?:\\)?\\)" 2 (3 . 4) (5 . 6) (7)) + (cmake + "^CMake \\(?:Error\\|\\(Warning\\)\\) at \\(.*\\):\\([1-9][0-9]*\\) ([^)]+):$" + 2 3 nil (1)) + (cmake-info + "^ \\(?: \\*\\)?\\(.*\\):\\([1-9][0-9]*\\) ([^)]+)$" + 1 2 nil 0) + (comma "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 6c6c3803f9e..2ad22ddd0ff 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. @@ -1055,6 +1052,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/grep.el b/lisp/progmodes/grep.el index f04a7226d18..2b44b58f245 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 "25.2" + :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'" @@ -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 356cd3e0532..9bf739463ed 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1182,36 +1182,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) 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 f024d397ffb..a35c4a31d06 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -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 @@ -2248,7 +2249,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 @@ -3495,6 +3496,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))) @@ -3717,9 +3719,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) @@ -3732,7 +3734,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/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..0bbf67fd37b 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1271,7 +1271,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" 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 2d22bb2ce88..343023f7a09 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -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) @@ -4310,6 +4332,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 @@ -4477,7 +4504,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) @@ -4660,7 +4687,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 @@ -4681,7 +4708,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)) @@ -4697,7 +4724,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) @@ -4714,7 +4741,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/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 4f160e1ad6d..4fe47f026b6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1662,7 +1662,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) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index fd59f4687c6..be7c4ddccf2 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. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 8e0133006d6..fd2e96af48b 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-03-22-7547e76-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 @@ -827,6 +839,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: ;; @@ -1310,8 +1326,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'.") ;; @@ -1363,7 +1384,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) @@ -2937,8 +2958,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 +3036,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 +3244,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 @@ -3854,6 +3880,25 @@ Key bindings specific to `verilog-mode-map' are: (add-hook 'write-contents-hooks 'verilog-auto-save-check nil 'local) ;; verilog-mode-hook call added by define-derived-mode ) + +;;; Integration with the speedbar +;; + +(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: ;; @@ -8074,7 +8119,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")) @@ -8377,18 +8422,18 @@ 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 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 @@ -8573,11 +8618,12 @@ 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)) + (defvar create-lockfiles) + (defvar which-func-modes)) -(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim) +(defun verilog-read-sub-decls-sig (submoddecls 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) @@ -8588,6 +8634,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (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,7 +8644,7 @@ 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")) @@ -8611,7 +8658,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 @@ -8630,7 +8677,7 @@ 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")) @@ -8643,7 +8690,7 @@ 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) @@ -8656,7 +8703,7 @@ 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) @@ -8669,7 +8716,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." "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)) ;; @@ -8683,7 +8730,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (while (setq mstr (pop mlst)) (verilog-read-sub-decls-expr submoddecls 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,10 +8750,15 @@ 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 comment port sig vec multidim mem)))))) (defun verilog-read-sub-decls-line (submoddecls comment) "For `verilog-read-sub-decls', read lines of port defs until none match. @@ -8717,23 +8769,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 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 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-*\\.[^(]*(") @@ -8748,20 +8800,20 @@ Inserts the list of signals found, using submodi to look up each 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 + (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 + (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 + (buffer-substring-no-properties (point) (1- (progn (search-backward "(") ; start at ( (verilog-forward-sexp-ign-cmt 1) (point)))))))) ; expr @@ -8993,7 +9045,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 +9062,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 @@ -9104,7 +9159,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)))) @@ -9894,7 +9949,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 +10014,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 +10058,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 +10248,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 @@ -10224,7 +10279,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 +10565,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 +10610,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 +10740,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 +10765,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 +10794,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-"))) @@ -10791,7 +10862,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 +11125,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 +11150,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 +11239,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") @@ -13316,13 +13398,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 +13603,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-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..2ea0919c686 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -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: @@ -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/rect.el b/lisp/rect.el index 43621d970d2..8803a47215f 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -476,10 +476,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..e8bc6f5545a 100644 --- a/lisp/gnus/registry.el +++ b/lisp/registry.el @@ -129,7 +129,7 @@ :type hash-table :documentation "The data hashtable."))) -(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 +146,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 +155,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,7 +166,7 @@ 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))) @@ -175,11 +175,11 @@ Returns an alist of the key followed by the entry in a list, not a cons cell." 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)))) + (let ((h (gethash tracksym (oref db tracker)))) (if h h (when create @@ -188,8 +188,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 @@ -220,7 +220,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. @@ -241,7 +241,7 @@ The test order is to check :all first, then :member, then :regex." (and regex (registry--match :regex v regex))) collect k)))) -(defmethod registry-delete ((db registry-db) keys assert &rest spec) +(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. @@ -274,17 +274,17 @@ 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." @@ -308,7 +308,7 @@ Errors out if the key exists already." (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)))) @@ -327,7 +327,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 +354,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 diff --git a/lisp/replace.el b/lisp/replace.el index 26e5875dc08..0b25200be57 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1832,6 +1832,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, @@ -1861,6 +1863,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) @@ -1886,7 +1890,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'.") @@ -2142,6 +2146,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) @@ -2338,8 +2346,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 @@ -2352,8 +2380,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)) @@ -2364,7 +2392,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 " "") @@ -2391,6 +2420,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 @@ -2513,9 +2609,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" 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..838f9bf80cd 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). diff --git a/lisp/server.el b/lisp/server.el index 524382073f8..e4cf4312570 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 @@ -655,6 +656,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 diff --git a/lisp/ses.el b/lisp/ses.el index 50101945f34..a87386e1730 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1319,7 +1319,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)) @@ -1539,7 +1539,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 diff --git a/lisp/simple.el b/lisp/simple.el index 97b40bd214e..65664c93666 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1075,7 +1075,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. @@ -1633,6 +1635,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 "25.2") + (defun execute-extended-command--shorter-1 (name length) (cond ((zerop length) (list "")) @@ -1715,7 +1723,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. @@ -3755,8 +3764,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. @@ -4047,7 +4061,8 @@ Its arguments and return value are as specified for `filter-buffer-substring'. This respects the wrapper hook `filter-buffer-substring-functions', 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 @@ -5823,7 +5838,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 @@ -5921,7 +5936,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)) @@ -5938,7 +5953,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. @@ -5946,7 +5961,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) @@ -5956,7 +5971,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. @@ -5988,7 +6003,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 diff --git a/lisp/subr.el b/lisp/subr.el index 3ac61f9a45f..b5d6f6fa01b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -66,6 +66,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. @@ -854,7 +855,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)) @@ -1540,6 +1546,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")) @@ -1730,6 +1740,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.") @@ -1738,12 +1753,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) @@ -1752,7 +1774,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'. @@ -2248,6 +2276,171 @@ keyboard-quit events while waiting for a valid input." (message "%s%s" prompt (char-to-string char)) char)) +(defun read-multiple-choice (prompt choices) + "Ask user a multiple choice question. +PROMPT should be a string that will be displayed as the prompt. + +CHOICES is an alist where the first element in each entry is a +character to be entered, the second element is a short name for +the entry to be displayed while prompting (if there's room, it +might be shortened), and the third, optional entry is a longer +explanation that will be displayed in a help buffer if the user +requests more help. + +This function translates user input into responses by consulting +the bindings in `query-replace-map'; see the documentation of +that variable for more information. In this case, the useful +bindings are `recenter', `scroll-up', and `scroll-down'. If the +user enters `recenter', `scroll-up', or `scroll-down' responses, +perform the requested window recentering or scrolling and ask +again. + +The return value is the matching entry from the CHOICES list. + +Usage example: + +\(read-multiple-choice \"Continue connecting?\" + '((?a \"always\") + (?s \"session only\") + (?n \"no\")))" + (let* ((altered-names nil) + (full-prompt + (format + "%s (%s): " + prompt + (mapconcat + (lambda (elem) + (let* ((name (cadr elem)) + (pos (seq-position name (car elem))) + (altered-name + (cond + ;; Not in the name string. + ((not pos) + (format "[%c] %s" (car elem) name)) + ;; The prompt character is in the name, so highlight + ;; it on graphical terminals... + ((display-supports-face-attributes-p + '(:underline t) (window-frame)) + (setq name (copy-sequence name)) + (put-text-property pos (1+ pos) + 'face 'read-multiple-choice-face + name) + name) + ;; And put it in [bracket] on non-graphical terminals. + (t + (concat + (substring name 0 pos) + "[" + (upcase (substring name pos (1+ pos))) + "]" + (substring name (1+ pos))))))) + (push (cons (car elem) altered-name) + altered-names) + altered-name)) + (append choices '((?? "?"))) + ", "))) + tchar buf wrong-char answer) + (save-window-excursion + (save-excursion + (while (not tchar) + (message "%s%s" + (if wrong-char + "Invalid choice. " + "") + full-prompt) + (setq tchar + (if (and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (x-popup-dialog + t + (cons prompt + (mapcar + (lambda (elem) + (cons (capitalize (cadr elem)) + (car elem))) + choices))) + (condition-case nil + (let ((cursor-in-echo-area t)) + (read-char)) + (error nil)))) + (setq answer (lookup-key query-replace-map (vector tchar) t)) + (setq tchar + (cond + ((eq answer 'recenter) + (recenter) t) + ((eq answer 'scroll-up) + (ignore-errors (scroll-up-command)) t) + ((eq answer 'scroll-down) + (ignore-errors (scroll-down-command)) t) + ((eq answer 'scroll-other-window) + (ignore-errors (scroll-other-window)) t) + ((eq answer 'scroll-other-window-down) + (ignore-errors (scroll-other-window-down)) t) + (t tchar))) + (when (eq tchar t) + (setq wrong-char nil + tchar nil)) + ;; The user has entered an invalid choice, so display the + ;; help messages. + (when (and (not (eq tchar nil)) + (not (assq tchar choices))) + (setq wrong-char (not (memq tchar '(?? ?\C-h))) + tchar nil) + (when wrong-char + (ding)) + (with-help-window (setq buf (get-buffer-create + "*Multiple Choice Help*")) + (with-current-buffer buf + (erase-buffer) + (pop-to-buffer buf) + (insert prompt "\n\n") + (let* ((columns (/ (window-width) 25)) + (fill-column 21) + (times 0) + (start (point))) + (dolist (elem choices) + (goto-char start) + (unless (zerop times) + (if (zerop (mod times columns)) + ;; Go to the next "line". + (goto-char (setq start (point-max))) + ;; Add padding. + (while (not (eobp)) + (end-of-line) + (insert (make-string (max (- (* (mod times columns) + (+ fill-column 4)) + (current-column)) + 0) + ?\s)) + (forward-line 1)))) + (setq times (1+ times)) + (let ((text + (with-temp-buffer + (insert (format + "%c: %s\n" + (car elem) + (cdr (assq (car elem) altered-names)))) + (fill-region (point-min) (point-max)) + (when (nth 2 elem) + (let ((start (point))) + (insert (nth 2 elem)) + (unless (bolp) + (insert "\n")) + (fill-region start (point-max)))) + (buffer-string)))) + (goto-char start) + (dolist (line (split-string text "\n")) + (end-of-line) + (if (bolp) + (insert line "\n") + (insert line)) + (forward-line 1))))))))))) + (when (buffer-live-p buf) + (kill-buffer buf)) + (assq tchar choices))) + (defun sit-for (seconds &optional nodisp obsolete) "Redisplay, then wait for SECONDS seconds. Stop when input is available. SECONDS may be a floating-point value. @@ -4131,8 +4324,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 @@ -4145,8 +4337,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 @@ -4959,6 +5150,17 @@ as a list.") ;;; Misc. + +(defvar definition-prefixes (make-hash-table :test 'equal) + "Hash table mapping prefixes to the files in which they're used. +This can be used to automatically fetch not-yet-loaded definitions.") + +(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..c4f3270ea8a --- /dev/null +++ b/lisp/svg.el @@ -0,0 +1,230 @@ +;;; 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) + +(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--append (svg node) + (let ((old (and (dom-attr node 'id) + (dom-by-id svg + (concat "\\`" (regexp-quote (dom-attr node 'id)) + "\\'"))))) + (if old + (dom-set-attributes old (dom-attributes node)) + (dom-append-child svg node))) + (svg-possibly-update-image svg)) + +(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." + (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)))) + +(provide 'svg) + +;;; svg.el ends here diff --git a/lisp/term.el b/lisp/term.el index 7e44c57228e..28be8c8c530 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) @@ -1204,6 +1208,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~")) @@ -3239,6 +3247,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 e737131d5bf..5080ed0a8f7 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 8ca98c6ec91..031768cec2c 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 134e3106b7b..8f3eaa2c029 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -463,5 +463,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 e06423ccfdd..5a38ebe8e45 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -590,6 +590,19 @@ string bytes that can be copied is 3/4 of this value." (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/css-mode.el b/lisp/textmodes/css-mode.el index b3a41d3822c..060af332179 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -29,11 +29,15 @@ ;; - electric ; and } ;; - filling code with auto-fill-mode -;; - attribute value completion ;; - fix font-lock errors with multi-line selectors +;; - support completion of user-defined classes names and IDs ;;; Code: +(require 'seq) +(require 'sgml-mode) +(require 'smie) + (defgroup css nil "Cascading Style Sheets (CSS) editing mode." :group 'languages) @@ -51,9 +55,20 @@ "Identifiers for pseudo-elements.") (defconst css-at-ids - '("charset" "font-face" "import" "media" "namespace" "page") + '("charset" "font-face" "import" "keyframes" "media" "namespace" + "page") "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 +77,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 +93,498 @@ "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) ;; 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()") + (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: `element-reference', `id', +`identifier', `percentage', and `string'.") + (defcustom css-electric-keys '(?\} ?\;) ;; '() "Self inserting keys which should trigger re-indentation." :version "22.2" @@ -243,9 +650,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 +726,6 @@ :type 'integer :safe 'integerp) -(require 'smie) - (defconst css-smie-grammar (smie-prec2->grammar (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) @@ -377,6 +780,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 +805,90 @@ (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 + (cons "inherit" (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) + +;; TODO: Currently only supports completion of HTML tags. By looking +;; at open HTML mode buffers we should be able to provide completion +;; of user-defined classes and IDs too. +(defun css--complete-selector () + "Complete part of a CSS selector at point." + (when (or (= (nth 0 (syntax-ppss)) 0) css--nested-selectors-allowed) + (save-excursion + (let ((end (point))) + (skip-chars-backward "-[:alnum:]") + (list (point) end 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 +1019,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 +1044,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/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..042b7d40edc 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 "25.2" + :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, @@ -1007,9 +1030,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)))) @@ -1979,9 +2000,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 @@ -2229,9 +2249,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)) @@ -2262,9 +2280,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement." ;;*---------------------------------------------------------------------*/ (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))))) + (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word)) (cor-menu (if (consp corrects) (mapcar (lambda (correct) (vector correct diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0cedf86bb73..0ed6c689429 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,4 +1,4 @@ -;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 +;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*- ;; Copyright (C) 1994-1995, 1997-2016 Free Software Foundation, Inc. @@ -46,9 +46,9 @@ ;; your own dictionaries. ;; Depending on the mail system you use, you may want to include these: -;; (add-hook 'news-inews-hook 'ispell-message) -;; (add-hook 'mail-send-hook 'ispell-message) -;; (add-hook 'mh-before-send-letter-hook 'ispell-message) +;; (add-hook 'news-inews-hook #'ispell-message) +;; (add-hook 'mail-send-hook #'ispell-message) +;; (add-hook 'mh-before-send-letter-hook #'ispell-message) ;; Ispell has a TeX parser and a nroff parser (the default). ;; The parsing is controlled by the variable ispell-parser. Currently @@ -196,54 +196,46 @@ ;; Fixed bug in returning to nroff mode from tex mode. ;;; Compatibility code for XEmacs and (not too) older emacsen: - -(eval-and-compile ;; Protect against declare-function undefined in XEmacs - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -(declare-function ispell-check-minver "ispell" (v1 v2)) -(declare-function ispell-looking-back "ispell" - (regexp &optional limit &rest ignored)) - -(if (fboundp 'version<=) - (defalias 'ispell-check-minver 'version<=) - (defun ispell-check-minver (minver version) - "Check if string VERSION is at least string MINVER. +(defalias 'ispell-check-minver + (if (fboundp 'version<=) 'version<= + (lambda (minver version) + "Check if string VERSION is at least string MINVER. Both must be in [0-9]+.[0-9]+... format. This is a fallback compatibility function in case `version<=' is not available." - (let ((pending t) - (return t) - start-ver start-mver) - ;; Loop until an absolute greater or smaller condition is reached - ;; or until no elements are left in any of version and minver. In - ;; this case version is exactly the minimal, so return OK. - (while pending - (let (ver mver) - (if (string-match "[0-9]+" version start-ver) - (setq start-ver (match-end 0) - ver (string-to-number (match-string 0 version)))) - (if (string-match "[0-9]+" minver start-mver) - (setq start-mver (match-end 0) - mver (string-to-number (match-string 0 minver)))) - - (if (or ver mver) - (progn - (or ver (setq ver 0)) - (or mver (setq mver 0)) - ;; If none of below conditions match, this element is the - ;; same. Go checking next element. - (if (> ver mver) - (setq pending nil) - (if (< ver mver) - (setq pending nil - return nil)))) - (setq pending nil)))) - return))) + (let ((pending t) + (return t) + start-ver start-mver) + ;; Loop until an absolute greater or smaller condition is reached + ;; or until no elements are left in any of version and minver. In + ;; this case version is exactly the minimal, so return OK. + (while pending + (let (ver mver) + (if (string-match "[0-9]+" version start-ver) + (setq start-ver (match-end 0) + ver (string-to-number (match-string 0 version)))) + (if (string-match "[0-9]+" minver start-mver) + (setq start-mver (match-end 0) + mver (string-to-number (match-string 0 minver)))) + + (if (or ver mver) + (progn + (or ver (setq ver 0)) + (or mver (setq mver 0)) + ;; If none of below conditions match, this element is the + ;; same. Go checking next element. + (if (> ver mver) + (setq pending nil) + (if (< ver mver) + (setq pending nil + return nil)))) + (setq pending nil)))) + return)))) ;; XEmacs does not have looking-back -(if (fboundp 'looking-back) - (defalias 'ispell-looking-back 'looking-back) - (defun ispell-looking-back (regexp &optional limit &rest ignored) - "Return non-nil if text before point matches regular expression REGEXP. +(defalias 'ispell-looking-back + (if (fboundp 'looking-back) 'looking-back + (lambda (regexp &optional limit &rest ignored) + "Return non-nil if text before point matches regular expression REGEXP. Like `looking-at' except matches before point, and is slower. LIMIT if non-nil speeds up the search by specifying a minimum starting position, to avoid checking matches that would start @@ -251,8 +243,8 @@ before LIMIT. This is a stripped down compatibility function for use when full featured `looking-back' function is missing." - (save-excursion - (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))) + (save-excursion + (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))) ;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode. (defmacro ispell-with-no-warnings (&rest body) @@ -260,6 +252,8 @@ full featured `looking-back' function is missing." ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar mail-yank-prefix) (defgroup ispell nil @@ -402,19 +396,15 @@ Always stores Fcc copy of message when nil." (defcustom ispell-grep-command - ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they - ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options - ;; below). - (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep") + "grep" "Name of the grep command for search processes." :type 'string :group 'ispell) (defcustom ispell-grep-options - (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i") + "-Ei" "String of options to use when running the program in `ispell-grep-command'. -Should probably be \"-i\" or \"-e\". -Some machines (like the NeXT) don't support \"-i\"." +Should probably be \"-Ei\"." :type 'string :group 'ispell) @@ -942,6 +932,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, @@ -1182,15 +1174,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 +1227,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 +1238,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 +1260,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 +1300,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 +1311,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 +1329,20 @@ entries if a specific dictionary was found." ispell-hunspell-dict-paths-alist)))) (ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n" dict-equiv-key affix-file) - (add-to-list - 'ispell-hunspell-dict-paths-alist - (list dict-equiv-key affix-file)))))) + (cl-pushnew (list dict-equiv-key affix-file) + ispell-hunspell-dict-paths-alist :test #'equal))))) ;; Parse and set values for default dictionary. (setq hunspell-default-dict (car hunspell-default-dict)) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. (setq ispell-hunspell-dictionary-alist - (list (append (list nil) (cdr hunspell-default-dict-entry)))) - (dolist (dict (mapcar 'car ispell-hunspell-dict-paths-alist)) - (if (string= dict hunspell-default-dict) - (add-to-list 'ispell-hunspell-dictionary-alist - hunspell-default-dict-entry) - (add-to-list 'ispell-hunspell-dictionary-alist - (list dict)))))) + (list (cons nil (cdr hunspell-default-dict-entry)))) + (dolist (dict (mapcar #'car ispell-hunspell-dict-paths-alist)) + (cl-pushnew (if (string= dict hunspell-default-dict) + hunspell-default-dict-entry + (list dict)) + ispell-hunspell-dictionary-alist :test #'equal)))) ;; Set params according to the selected spellchecker @@ -1443,17 +1433,17 @@ aspell is used along with Emacs).") (setq skip-dict t))) (unless skip-dict - (add-to-list 'tmp-dicts-alist - (list - dict-name ; dict name - (nth 1 adict) ; casechars - (nth 2 adict) ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - ispell-args ; ispell-args - (nth 6 adict) ; extended-character-mode - (nth 7 adict) ; dict encoding - )))) + (cl-pushnew (list + dict-name ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + ispell-args ; ispell-args + (nth 6 adict) ; extended-character-mode + (nth 7 adict) ; dict encoding + ) + tmp-dicts-alist :test #'equal))) (setq ispell-dictionary-base-alist tmp-dicts-alist)))) (run-hooks 'ispell-initialize-spellchecker-hook) @@ -1463,7 +1453,7 @@ aspell is used along with Emacs).") ispell-base-dicts-override-alist ispell-dictionary-base-alist)) (unless (assoc (car dict) all-dicts-alist) - (add-to-list 'all-dicts-alist dict))) + (push dict all-dicts-alist))) (setq ispell-dictionary-alist all-dicts-alist)) ;; If Emacs flavor supports [:alpha:] use it for global dicts. If @@ -1473,20 +1463,20 @@ aspell is used along with Emacs).") (if ispell-emacs-alpha-regexp (let (tmp-dicts-alist) (dolist (adict ispell-dictionary-alist) - (if (cadr adict) ;; Do not touch hunspell uninitialized entries - (add-to-list 'tmp-dicts-alist - (list - (nth 0 adict) ; dict name - "[[:alpha:]]" ; casechars - "[^[:alpha:]]" ; not-casechars - (nth 3 adict) ; otherchars - (nth 4 adict) ; many-otherchars-p - (nth 5 adict) ; ispell-args - (nth 6 adict) ; extended-character-mode - (if ispell-encoding8-command - 'utf-8 - (nth 7 adict)))) - (add-to-list 'tmp-dicts-alist adict))) + (cl-pushnew (if (cadr adict) ;; Do not touch hunspell uninitialized entries + (list + (nth 0 adict) ; dict name + "[[:alpha:]]" ; casechars + "[^[:alpha:]]" ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + (nth 5 adict) ; ispell-args + (nth 6 adict) ; extended-character-mode + (if ispell-encoding8-command + 'utf-8 + (nth 7 adict))) + adict) + tmp-dicts-alist :test #'equal)) (setq ispell-dictionary-alist tmp-dicts-alist))))) (defun ispell-valid-dictionary-list () @@ -1875,6 +1865,7 @@ Valid forms include: ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ;;("\\\\author" ispell-tex-arg-end) + ("\\\\cref" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) @@ -2427,7 +2418,8 @@ Global `ispell-quit' set to start location to continue spell session." nil) ((or (= char ?a) (= char ?A)) ; accept word without insert (ispell-send-string (concat "@" word "\n")) - (add-to-list 'ispell-buffer-session-localwords word) + (cl-pushnew word ispell-buffer-session-localwords + :test #'equal) (and (fboundp 'flyspell-unhighlight-at) (flyspell-unhighlight-at start)) (or ispell-buffer-local-name ; session localwords might conflict @@ -2682,8 +2674,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 +2752,7 @@ if defined." ;; This is the case when a process dies or fails. The default behavior ;; in this case treats the next input received as fresh input. -(defun ispell-filter (process output) +(defun ispell-filter (_process output) "Output filter function for ispell, grep, and look." (let ((start 0) (continue t) @@ -3040,14 +3032,13 @@ Keeps argument list for future Ispell invocations for no async support." (ispell-send-string "\032\n") ; so Ispell prints version and exits t))) - (defun ispell-init-process () "Check status of Ispell process and start if necessary." (let* (;; Basename of dictionary used by the spell-checker (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) ispell-current-dictionary)) ;; The directory where process was started. - (current-ispell-directory default-directory) + (current-ispell-directory default-directory) ;FIXME: Unused? ;; The default directory for the process. ;; Use "~/" as default-directory unless using Ispell with per-dir ;; personal dictionaries and not in a minibuffer under XEmacs @@ -3150,7 +3141,7 @@ Keeps argument list for future Ispell invocations for no async support." ;; Otherwise we get cool errors like "Can't open ". (sleep-for 1) (ispell-accept-output 3) - (error "%s" (mapconcat 'identity ispell-filter "\n")))) + (error "%s" (mapconcat #'identity ispell-filter "\n")))) (setq ispell-filter nil) ; Discard version ID line (let ((extended-char-mode (ispell-get-extended-character-mode))) (if extended-char-mode ; ~ extended character mode @@ -3206,7 +3197,7 @@ By just answering RET you can find out what the current dictionary is." (list (completing-read "Use new dictionary (RET for current, SPC to complete): " (and (fboundp 'ispell-valid-dictionary-list) - (mapcar 'list (ispell-valid-dictionary-list))) + (mapcar #'list (ispell-valid-dictionary-list))) nil t) current-prefix-arg)) (ispell-set-spellchecker-params) ; Initialize variables and dicts alists @@ -3412,7 +3403,7 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys. Must be called after `ispell-buffer-local-parsing' due to dependence on mode." (mapconcat - 'identity + #'identity (delq nil (list ;; messages @@ -3869,7 +3860,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 +4094,10 @@ The `X' command aborts sending the message so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your init file: - (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5 - (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4 - (add-hook \\='mail-send-hook \\='ispell-message) - (add-hook \\='mh-before-send-letter-hook \\='ispell-message) + (add-hook \\='message-send-hook #\\='ispell-message) ;; GNUS 5 + (add-hook \\='news-inews-hook #\\='ispell-message) ;; GNUS 4 + (add-hook \\='mail-send-hook #\\='ispell-message) + (add-hook \\='mh-before-send-letter-hook #\\='ispell-message) You can bind this to the key C-c i in GNUS or mail by adding to `news-reply-mode-hook' or `mail-mode-hook' the following lambda expression: @@ -4428,6 +4419,7 @@ Both should not be used to define a buffer-local dictionary." (insert comment-end))))) (insert (concat " " word)))))))) +;;FIXME: Use `user-error' instead! (add-to-list 'debug-ignored-errors "^No word found to check!$") (provide 'ispell) diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index c3f39ecd327..505df5d3424 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -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..b5b7d466e9c 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -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..f1d4d6fcba8 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -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..d2500510443 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -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..0ed6f26699a 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -2119,5 +2119,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..1d6fa311d5f 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -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..f5a784bf63d 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -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..02caa67e9a8 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -745,5 +745,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..915acc8382d 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -1111,5 +1111,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.el b/lisp/textmodes/reftex.el index ae9db7de10a..a488ab14b10 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -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. @@ -2394,702 +2395,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/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 98a01e8d83f..990c09bfda7 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -842,6 +842,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 +881,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 +1086,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 +1255,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 +1301,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 +1335,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 +1560,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 +1779,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 +1797,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,6 +1831,9 @@ 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)) @@ -1819,14 +1855,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 +1874,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,8 +1910,14 @@ 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) @@ -1874,24 +1932,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 +1987,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 +2050,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 +2076,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.") diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 653db83107d..3502adf5e29 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -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) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 3ac68bdf790..b38b147b3e5 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) @@ -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 @@ -801,8 +804,7 @@ Not smaller than the value set by `tex-suscript-height-minimum'." (defvar tex-math-face 'tex-math) (defface tex-verbatim - ;; '((t :inherit font-lock-string-face)) - '((t :family "courier")) + '((t :inherit fixed-pitch-serif)) "Face used to highlight TeX verbatim environments." :group 'tex) (define-obsolete-face-alias 'tex-verbatim-face 'tex-verbatim "22.1") @@ -1129,34 +1131,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 @@ -1206,6 +1210,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 () @@ -1217,7 +1223,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{\\(" @@ -1535,8 +1541,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) @@ -1593,17 +1598,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." @@ -2186,7 +2206,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-*")) "&"))) @@ -2368,7 +2388,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 @@ -2753,7 +2774,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))) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index c22f531440d..ed6022f9fbb 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -368,8 +368,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) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 9920fa06d0c..df5c52d4d61 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -603,7 +603,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 ba5792441c4..651dd56779b 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -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-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-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-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..d3be880b382 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -269,7 +269,8 @@ A prefix arg makes KEEP-TIME non-nil." (error "Opening input file: No such file or directory, %s" 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 5832e92c5a3..306b36ae951 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)) @@ -135,6 +137,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 +200,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 +222,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." @@ -307,8 +339,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 +508,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 +622,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 +931,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 +957,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 +1093,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 +1101,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 @@ -1195,34 +1228,40 @@ the end of the document." "Retrieve URL via HTTP asynchronously. URL must be a parsed URL. See `url-generic-parse-url' for details. -When retrieval is completed, execute the function CALLBACK, passing it -an updated value of CBARGS as arguments. The first element in CBARGS -should be a plist describing what has happened so far during the -request, as described in the docstring of `url-retrieve' (if in -doubt, specify nil). +When retrieval is completed, execute the function CALLBACK, +passing it an updated value of CBARGS as arguments. The first +element in CBARGS should be a plist describing what has happened +so far during the request, as described in the docstring of +`url-retrieve' (if in doubt, specify nil). The current buffer +then CALLBACK is executed is the retrieval buffer. Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a previous `url-http' call, which is being re-attempted. Optional arg GATEWAY-METHOD specifies the gateway to be used, -overriding the value of `url-gateway-method'." +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 @@ -1278,13 +1317,72 @@ overriding the value of `url-gateway-method'." (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. @@ -1296,11 +1394,13 @@ overriding the value of `url-gateway-method'." (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 @@ -1362,7 +1462,7 @@ overriding the value of `url-gateway-method'." (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 @@ -1377,7 +1477,7 @@ overriding the value of `url-gateway-method'." 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) @@ -1461,7 +1561,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-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..af18acd8b6a 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -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..f6aae21a838 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 "25.2" :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/vc/add-log.el b/lisp/vc/add-log.el index fa02a5a1f5e..9076d834c7c 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -171,6 +171,14 @@ 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 "25.2" + :type '(repeat file) + :group 'change-log) + (defface change-log-date '((t (:inherit font-lock-string-face))) "Face used to highlight dates in date lines." @@ -582,25 +590,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 "25.2")) + (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 +687,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 +724,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 +899,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/ediff-util.el b/lisp/vc/ediff-util.el index 5419d477810..a6b88d557ba 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 @@ -2523,7 +2522,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 @@ -3480,6 +3479,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. @@ -3527,7 +3527,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) @@ -3546,7 +3546,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) @@ -3945,15 +3945,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 @@ -3970,7 +3973,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 " @@ -4025,7 +4028,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..a4244c941d2 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -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/smerge-mode.el b/lisp/vc/smerge-mode.el index 489ece81bec..5198624ea7f 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 "25.2") +(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 "25.2") +(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 "25.2") + +(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 "25.2") + (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 "25.2") + +(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 "25.2") + +(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 "25.2") + (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..4bcab66fb52 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) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 2dca708dc38..dfe6b293e94 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 f35c84d50c5..16cbeef57ea 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1005,7 +1005,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) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2d8bab70598..78ff56c3ae3 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 "25.2" + :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 "25.2" + :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 "25.2" + :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) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index b3644cc1ac5..6b4cd6acd03 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: @@ -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..dc228870d1e 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) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 472355741b8..4815f4b8c21 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..2e68bec6fd7 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -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 "25.2" + :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. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f0054be4c8b..0a0f4582b32 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -852,8 +852,8 @@ button end points." (define-key map [(shift tab)] 'widget-backward) (put 'widget-backward :advertised-binding [(shift tab)]) (define-key map [backtab] 'widget-backward) - (define-key map [down-mouse-2] 'widget-button-click) - (define-key map [down-mouse-1] 'widget-button-click) + (define-key map [mouse-2] 'widget-button-click) + (define-key map [mouse-1] 'widget-button-click) ;; The following definition needs to avoid using escape sequences that ;; might get converted to ^M when building loaddefs.el (define-key map [(control ?m)] 'widget-button-press) 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 f7a547b915a..bd5275bffc9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6746,6 +6746,71 @@ 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 behaviour 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? frame?) + (with-current-buffer (window-buffer window) + (setq mode? + (cond ((memq major-mode allowed-modes) + 'same) + ((derived-mode-p allowed-modes) + 'derived)))) + (when (and mode? + (not (and inhibit-same-window-p + (eq window curwin)))) + (if (eq curframe (window-frame window)) + (if (eq mode? 'same) + (push window same-mode-same-frame) + (push window derived-mode-same-frame)) + (if (eq mode? 'same) + (push window same-mode-other-frame) + (push window derived-mode-other-frame)))))) + (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 |