commit bbfa9995ff3bdb8a00fe3082bc3249cc1e68e1ab (HEAD, refs/remotes/origin/master) Author: Juanma Barranquero Date: Sat Oct 5 00:31:17 2019 +0200 Improve docstrings auto-generated by `define-minor-mode' * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): When using `easy-mmode--arg-docstring' to auto-generate a docstring, refill it up to `emacs-lisp-docstring-fill-column'. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 5e7b29eddf..ccdb25ef60 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -95,10 +95,18 @@ if ARG is `toggle'; disable the mode otherwise.") \\{%s}" mode-pretty-name keymap-sym)))) (if (string-match-p "\\bARG\\b" doc) doc - (let ((argdoc (format easy-mmode--arg-docstring - mode-pretty-name))) + (let* ((fill-prefix nil) + (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column)) + (fill-column (if (integerp docs-fc) docs-fc 65)) + (argdoc (format easy-mmode--arg-docstring mode-pretty-name)) + (filled (if (fboundp 'fill-region) + (with-temp-buffer + (insert argdoc) + (fill-region (point-min) (point-max) 'left t) + (buffer-string)) + argdoc))) (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" - (concat argdoc "\\1") + (concat filled "\\1") doc nil nil 1))))) ;;;###autoload commit 2ff16a483702ef064babf0823b20b2138fc1571a Author: Eric Abrahamsen Date: Thu Oct 3 16:21:02 2019 -0700 Don't manipulate gnus-newsrc-alist if it hasn't been initalized * lisp/gnus/gnus-group.el (gnus-group-set-info): Packages that use Gnus summary mode without actually booting Gnus might end up in this situation. See bug#36903 diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 915125b655..742f8f4be5 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -4465,12 +4465,14 @@ and the second element is the address." (setcar entry (length (gnus-list-of-unread-articles (car info))))) ;; The above `setcar' will only affect the hashtable, not - ;; the alist: update the alist separately. - (push info (cdr (setq gnus-newsrc-alist - (remove (assoc-string - (gnus-info-group info) - gnus-newsrc-alist) - gnus-newsrc-alist))))) + ;; the alist: update the alist separately, but only if + ;; it's been initialized. + (when gnus-newsrc-alist + (push info (cdr (setq gnus-newsrc-alist + (remove (assoc-string + (gnus-info-group info) + gnus-newsrc-alist) + gnus-newsrc-alist)))))) (error "No such group: %s" (gnus-info-group info)))))) ;; Ad-hoc function for inserting data from a different newsrc.eld commit 8023715cf18d0b9e48fd0a4a72e4455edaa89813 Author: Paul Eggert Date: Fri Oct 4 14:38:22 2019 -0700 Fix bugs found by 2019-09-29 regexp scanner Problems reported by Mattias Engdegård in: https://lists.gnu.org/r/emacs-devel/2019-09/threads.html * lisp/calendar/iso8601.el (iso8601--year-match) (iso8601--full-date-match, iso8601--without-day-match) (iso8601--week-date-match, iso8601--ordinal-date-match) (iso8601--zone-match): * lisp/textmodes/rst.el (rst-re-alist-def): Put ‘-’ at the end of bracketed ranges, following the style suggestion in the Elisp manual. (iso8601--time-match): Use \([0-9]*\) instead of \([0-9]+\)? to pacify the regexp scanner. (iso8601-parse-time): Adjust accordingly. * lisp/language/burmese.el (burmese-composable-pattern): * lisp/language/indian.el (devanagari-composable-pattern) (bengali-composable-pattern, gurmukhi-composable-pattern) (gujarati-composable-pattern, oriya-composable-pattern) (telugu-composable-pattern, kannada-composable-pattern) (malayalam-composable-pattern): Prefer [ab] to [a-b] when the characters differ by 1, to pacify the regexp scanner. * lisp/language/burmese.el (burmese-composable-pattern): Fix missing-‘\u’ typos. * lisp/language/indian.el (gurmukhi-composable-pattern): Fix missing-‘\’ typo. * lisp/language/tibetan.el (tibetan-regexp): Quote ‘+’ in regexp to pacify the regexp scanner. Simplify. * lisp/textmodes/rst.el (rst-re-alist-def): Fix ‘[]-'...]’ typo by putting the ‘-’ at end of the bracketed expression. diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el index 3ff91d910c..78a94d47be 100644 --- a/lisp/calendar/iso8601.el +++ b/lisp/calendar/iso8601.el @@ -62,17 +62,17 @@ regexps "\\|")) (defconst iso8601--year-match - "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)") + "\\([+-]\\)?\\([0-9][0-9][0-9][0-9]\\)") (defconst iso8601--full-date-match - "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)") + "\\([+-]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)") (defconst iso8601--without-day-match - "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)") + "\\([+-]\\)?\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)") (defconst iso8601--outdated-date-match "--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)") (defconst iso8601--week-date-match - "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?") + "\\([+-]\\)?\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?") (defconst iso8601--ordinal-date-match - "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)") + "\\([+-]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)") (defconst iso8601--date-match (iso8601--concat-regexps (list iso8601--year-match @@ -83,10 +83,10 @@ iso8601--ordinal-date-match))) (defconst iso8601--time-match - "\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?[.,]?\\([0-9]+\\)?") + "\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?[.,]?\\([0-9]*\\)") (defconst iso8601--zone-match - "\\(Z\\|\\([-+]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)") + "\\(Z\\|\\([+-]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)") (defconst iso8601--full-time-match (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)" @@ -142,7 +142,7 @@ See `decode-time' for the meaning of FORM." (defun iso8601-parse-date (string) "Parse STRING (in ISO 8601 format) and return a `decode-time' value." (cond - ;; Just a year: [-+]YYYY. + ;; Just a year: [+-]YYYY. ((iso8601--match iso8601--year-match string) (iso8601--decoded-time :year (iso8601--adjust-year (match-string 1 string) @@ -236,7 +236,7 @@ See `decode-time' for the meaning of FORM." (string-to-number (match-string 2 time)))) (second (and (match-string 3 time) (string-to-number (match-string 3 time)))) - (fraction (and (match-string 4 time) + (fraction (and (not (zerop (length (match-string 4 time)))) (string-to-number (match-string 4 time))))) (when (and fraction (eq form t)) diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 25425ec485..7f2a99a41a 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -39,11 +39,11 @@ (defvar burmese-composable-pattern (let ((table '(("K" . "[\u1004\u105A]\u103A\u1039") ; KINZI sequence - ("C" . "[\u1000-\u102A\u103F\u1041-\u1049\u104E\u105A-\u105D\u1061\u1065-\u1066\u106E\u1071\u1075\u1081\u108E\uAA60-\uAA6F\uAA71-\uAA76]") ; consonant and vowel letter + ("C" . "[\u1000-\u102A\u103F\u1041-\u1049\u104E\u105A-\u105D\u1061\u1065\u1066\u106E\u1071\u1075\u1081\u108E\uAA60-\uAA6F\uAA71-\uAA76]") ; consonant and vowel letter ("V" . "\u1039") ; VIRAMA ("A" . "\u103A") ; ASAT ("S" . "[\u1000-\u1019\u101C\u101E\u1020\u1021\u105A]") ; subscript - ("M" . "[\u103B-\u103E\105E-\1060]") ; medial + ("M" . "[\u103B-\u103E\u105E-\u1060]") ; medial ("v" . "[\u102B-\u103A\u103C-\u103E\u1062-\u1064\u1067-\u106D\u1071-\u1074\u1082-\u108D\u108F\u109A\u109C\uAA70]"))) ; vowel sign, etc. (regexp "\\(K\\)?C\\(VS\\)?\\(VS\\)?A?M*v*")) (let ((case-fold-search nil)) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index f1e61a354c..4013faca7c 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -139,14 +139,14 @@ South Indian language Malayalam is supported in this language environment.")) (let ((table '(("a" . "[\u0900-\u0902]") ; vowel modifier (above) ("A" . "\u0903") ; vowel modifier (post) - ("V" . "[\u0904-\u0914\u0960-\u0961\u0972]") ; independent vowel + ("V" . "[\u0904-\u0914\u0960\u0961\u0972]") ; independent vowel ("C" . "[\u0915-\u0939\u0958-\u095F\u0979-\u097F]") ; consonant ("R" . "\u0930") ; RA ("n" . "\u093C") ; NUKTA - ("v" . "[\u093E-\u094C\u094E\u0955\u0962-\u0963]") ; vowel sign + ("v" . "[\u093E-\u094C\u094E\u0955\u0962\u0963]") ; vowel sign ("H" . "\u094D") ; HALANT - ("s" . "[\u0951-\u0952]") ; stress sign - ("t" . "[\u0953-\u0954]") ; accent + ("s" . "[\u0951\u0952]") ; stress sign + ("t" . "[\u0953\u0954]") ; accent ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ ("X" . "[\u0900-\u097F]")))) ; all coverage @@ -166,13 +166,13 @@ South Indian language Malayalam is supported in this language environment.")) (defconst bengali-composable-pattern (let ((table '(("a" . "\u0981") ; SIGN CANDRABINDU - ("A" . "[\u0982-\u0983]") ; SIGN ANUSVARA .. VISARGA - ("V" . "[\u0985-\u0994\u09E0-\u09E1]") ; independent vowel + ("A" . "[\u0982\u0983]") ; SIGN ANUSVARA .. VISARGA + ("V" . "[\u0985-\u0994\u09E0\u09E1]") ; independent vowel ("C" . "[\u0995-\u09B9\u09DC-\u09DF\u09F1]") ; consonant - ("B" . "[\u09AC\u09AF-\u09B0\u09F0]") ; BA, YA, RA + ("B" . "[\u09AC\u09AF\u09B0\u09F0]") ; BA, YA, RA ("R" . "[\u09B0\u09F0]") ; RA ("n" . "\u09BC") ; NUKTA - ("v" . "[\u09BE-\u09CC\u09D7\u09E2-\u09E3]") ; vowel sign + ("v" . "[\u09BE-\u09CC\u09D7\u09E2\u09E3]") ; vowel sign ("H" . "\u09CD") ; HALANT ("T" . "\u09CE") ; KHANDA TA ("N" . "\u200C") ; ZWNJ @@ -195,11 +195,11 @@ South Indian language Malayalam is supported in this language environment.")) (defconst gurmukhi-composable-pattern (let ((table - '(("a" . "[\u0A01-\u0A02\u0A70]") ; SIGN ADAK BINDI .. BINDI, TIPPI + '(("a" . "[\u0A01\u0A02\u0A70]") ; SIGN ADAK BINDI .. BINDI, TIPPI ("A" . "\u0A03") ; SIGN VISARGA ("V" . "[\u0A05-\u0A14]") ; independent vowel ("C" . "[\u0A15-\u0A39\u0A59-\u0A5E]") ; consonant - ("Y" . "[\u0A2F-u0A30\u0A35\u0A39]") ; YA, RA, VA, HA + ("Y" . "[\u0A2F-\u0A30\u0A35\u0A39]") ; YA, RA, VA, HA ("n" . "\u0A3C") ; NUKTA ("v" . "[\u0A3E-\u0A4C]") ; vowel sign ("H" . "\u0A4D") ; VIRAMA @@ -221,13 +221,13 @@ South Indian language Malayalam is supported in this language environment.")) (defconst gujarati-composable-pattern (let ((table - '(("a" . "[\u0A81-\u0A82]") ; SIGN CANDRABINDU .. ANUSVARA + '(("a" . "[\u0A81\u0A82]") ; SIGN CANDRABINDU .. ANUSVARA ("A" . "\u0A83") ; SIGN VISARGA - ("V" . "[\u0A85-\u0A94\u0AE0-\u0AE1]") ; independent vowel + ("V" . "[\u0A85-\u0A94\u0AE0\u0AE1]") ; independent vowel ("C" . "[\u0A95-\u0AB9]") ; consonant ("R" . "\u0AB0") ; RA ("n" . "\u0ABC") ; NUKTA - ("v" . "[\u0ABE-\u0ACC\u0AE2-\u0AE3]") ; vowel sign + ("v" . "[\u0ABE-\u0ACC\u0AE2\u0AE3]") ; vowel sign ("H" . "\u0ACD") ; VIRAMA ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ @@ -248,13 +248,13 @@ South Indian language Malayalam is supported in this language environment.")) (defconst oriya-composable-pattern (let ((table '(("a" . "\u0B01") ; SIGN CANDRABINDU - ("A" . "[\u0B02-\u0B03]") ; SIGN ANUSVARA .. VISARGA - ("V" . "[\u0B05-\u0B14\u0B60-\u0B61]") ; independent vowel - ("C" . "[\u0B15-\u0B39\u0B5C-\u0B5D\u0B71]") ; consonant - ("B" . "[\u0B15-\u0B17\u0B1B-\u0B1D\u0B1F-\u0B21\u0B23-\u0B24\u0B27-\u0B30\u0B32-\u0B35\u0B38-\u0B39]") ; consonant with below form + ("A" . "[\u0B02\u0B03]") ; SIGN ANUSVARA .. VISARGA + ("V" . "[\u0B05-\u0B14\u0B60\u0B61]") ; independent vowel + ("C" . "[\u0B15-\u0B39\u0B5C\u0B5D\u0B71]") ; consonant + ("B" . "[\u0B15-\u0B17\u0B1B-\u0B1D\u0B1F-\u0B21\u0B23\u0B24\u0B27-\u0B30\u0B32-\u0B35\u0B38\u0B39]") ; consonant with below form ("R" . "\u0B30") ; RA ("n" . "\u0B3C") ; NUKTA - ("v" . "[\u0B3E-\u0B4C\u0B56-\u0B57\u0B62-\u0B63]") ; vowel sign + ("v" . "[\u0B3E-\u0B4C\u0B56\u0B57\u0B62\u0B63]") ; vowel sign ("H" . "\u0B4D") ; VIRAMA ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ @@ -296,9 +296,9 @@ South Indian language Malayalam is supported in this language environment.")) (defconst telugu-composable-pattern (let ((table '(("a" . "[\u0C01-\u0C03]") ; SIGN CANDRABINDU .. VISARGA - ("V" . "[\u0C05-\u0C14\u0C60-\u0C61]") ; independent vowel - ("C" . "[\u0C15-\u0C39\u0C58-\u0C59]") ; consonant - ("v" . "[\u0C3E-\u0C4C\u0C55-\u0C56\u0C62-\u0C63]") ; vowel sign + ("V" . "[\u0C05-\u0C14\u0C60\u0C61]") ; independent vowel + ("C" . "[\u0C15-\u0C39\u0C58\u0C59]") ; consonant + ("v" . "[\u0C3E-\u0C4C\u0C55\u0C56\u0C62\u0C63]") ; vowel sign ("H" . "\u0C4D") ; VIRAMA ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ @@ -318,12 +318,12 @@ South Indian language Malayalam is supported in this language environment.")) (defconst kannada-composable-pattern (let ((table - '(("A" . "[\u0C82-\u0C83]") ; SIGN ANUSVARA .. VISARGA - ("V" . "[\u0C85-\u0C94\u0CE0-\u0CE1]") ; independent vowel - ("C" . "[\u0C95-\u0CB9\u0CDE]") ; consonant + '(("A" . "[\u0C82\u0C83]") ; SIGN ANUSVARA .. VISARGA + ("V" . "[\u0C85-\u0C94\u0CE0\u0CE1]") ; independent vowel + ("C" . "[\u0C95-\u0CB9\u0CDE]") ; consonant ("R" . "\u0CB0") ; RA ("n" . "\u0CBC") ; NUKTA - ("v" . "[\u0CBE-\u0CCC\u0CD5-\u0CD6\u0CE2-\u0CE3]") ; vowel sign + ("v" . "[\u0CBE-\u0CCC\u0CD5\u0CD6\u0CE2\u0CE3]") ; vowel sign ("H" . "\u0CCD") ; VIRAMA ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ @@ -343,11 +343,11 @@ South Indian language Malayalam is supported in this language environment.")) (defconst malayalam-composable-pattern (let ((table - '(("A" . "[\u0D02-\u0D03]") ; SIGN ANUSVARA .. VISARGA - ("V" . "[\u0D05-\u0D14\u0D60-\u0D61]") ; independent vowel + '(("A" . "[\u0D02\u0D03]") ; SIGN ANUSVARA .. VISARGA + ("V" . "[\u0D05-\u0D14\u0D60\u0D61]") ; independent vowel ("C" . "[\u0D15-\u0D39]") ; consonant - ("Y" . "[\u0D2F-\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA - ("v" . "[\u0D3E-\u0D4C\u0D57\u0D62-\u0D63]") ; postbase matra + ("Y" . "[\u0D2F\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA + ("v" . "[\u0D3E-\u0D4C\u0D57\u0D62\u0D63]") ; postbase matra ("H" . "\u0D4D") ; SIGN VIRAMA ("N" . "\u200C") ; ZWNJ ("J" . "\u200D") ; ZWJ diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index 4be25cecab..b42a1e8fb8 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -549,19 +549,16 @@ ("སྨ" . ""))) (defconst tibetan-regexp - (let ((l (list tibetan-precomposed-transcription-alist - tibetan-consonant-transcription-alist - tibetan-vowel-transcription-alist - tibetan-modifier-transcription-alist - tibetan-subjoined-transcription-alist)) - (separator "\\|") - tail pattern) - (while l - (setq tail (car l) l (cdr l)) - (while tail - (setq pattern (cons separator (cons (car (car tail)) pattern)) - tail (cdr tail)))) - (apply 'concat (nreverse (cdr pattern)))) + (let (pattern) + (dolist (alist (list tibetan-precomposed-transcription-alist + tibetan-consonant-transcription-alist + tibetan-vowel-transcription-alist + tibetan-modifier-transcription-alist + tibetan-subjoined-transcription-alist) + (apply #'concat (nreverse (cdr pattern)))) + (dolist (key-val alist) + (setq pattern (cons "\\|" (cons (regexp-quote (car key-val)) + pattern)))))) "Regexp matching a Tibetan transcription of a composable Tibetan sequence. The result of matching is to be used for indexing alists at conversion from a roman transcription to the corresponding Tibetan character.") diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 88c44c06da..b7438fbb10 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -388,8 +388,8 @@ in parentheses follows the development revision and the time stamp.") ; item tag. ;; Inline markup (`ilm') - (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]")) - (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]")) + (ilm-pfx (:alt "^" hws-prt "['\"([{<‘“«’/:-]")) + (ilm-sfx (:alt "$" hws-prt "[]'\")}>’”»/:.,;!?\\-]")) ;; Inline markup content (`ilc') (ilcsgl-tag "\\S ") ; A single non-white character. @@ -431,7 +431,7 @@ in parentheses follows the development revision and the time stamp.") (fld-tag ":" fldnam-tag ":") ; A field marker. ;; Options (`opt') - (optsta-tag (:alt "[-+/]" "--")) ; Start of an option. + (optsta-tag (:alt "[+/-]" "--")) ; Start of an option. (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option. (optarg-tag (:shy "[ =]\\S +")) ; Option argument. (optsep-tag (:shy "," hws-prt)) ; Separator between options. @@ -457,7 +457,7 @@ in parentheses follows the development revision and the time stamp.") ; tag. ;; Symbol (`sym') - (sym-prt "[-+.:_]") ; Non-word part of a symbol. + (sym-prt "[+.:_-]") ; Non-word part of a symbol. (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*")) ;; URIs (`uri') commit 81c7f3afb34c28972d80c7d45a47903571f2b59d Author: Paul Eggert Date: Fri Oct 4 12:30:28 2019 -0700 Minor style tweaks for recent tab changes * src/dispextern.h (MR_PARTIALLY_VISIBLE_AT_TOP): * src/window.c (Fwindow_mode_line_height) (Fwindow_header_line_height, Fwindow_tab_line_height) (Fwindow_right_divider_width, Fwindow_bottom_divider_width) (Fwindow_scroll_bar_width, Fwindow_scroll_bar_height): (Fset_window_configuration, Fcurrent_window_configuration): Omit unnecessary parens. * src/dispextern.h (CURRENT_MODE_LINE_HEIGHT) (CURRENT_HEADER_LINE_HEIGHT, CURRENT_TAB_LINE_HEIGHT): Add parens needed to make these macros function-like. * src/window.c (window_resize_check): * src/window.h (WINDOW_TAB_BAR_P): * src/xdisp.c (tab_bar_item_info): Reindent. * src/window.c (window_wants_mode_line) (window_wants_header_line, window_wants_tab_line): Simplify (a && b ? 1 : 0) to (a && b). diff --git a/src/dispextern.h b/src/dispextern.h index 817f8c77d9..7a15e2745b 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1178,7 +1178,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); ((ROW)->height != (ROW)->visible_height) #define MR_PARTIALLY_VISIBLE_AT_TOP(W, ROW) \ - ((ROW)->y < (WINDOW_TAB_LINE_HEIGHT ((W)) + WINDOW_HEADER_LINE_HEIGHT ((W)))) + ((ROW)->y < WINDOW_TAB_LINE_HEIGHT (W) + WINDOW_HEADER_LINE_HEIGHT (W)) #define MR_PARTIALLY_VISIBLE_AT_BOTTOM(W, ROW) \ (((ROW)->y + (ROW)->height - (ROW)->extra_line_spacing) \ @@ -1489,39 +1489,39 @@ struct glyph_string a default based on the height of the font of the face `mode-line'. */ #define CURRENT_MODE_LINE_HEIGHT(W) \ - (W->mode_line_height >= 0 \ - ? W->mode_line_height \ - : (W->mode_line_height \ - = (MATRIX_MODE_LINE_HEIGHT (W->current_matrix) \ - ? MATRIX_MODE_LINE_HEIGHT (W->current_matrix) \ + ((W)->mode_line_height >= 0 \ + ? (W)->mode_line_height \ + : ((W)->mode_line_height \ + = (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ + ? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME (W->frame), CURRENT_MODE_LINE_FACE_ID (W))))) + (XFRAME ((W)->frame), CURRENT_MODE_LINE_FACE_ID (W))))) /* Return the current height of the header line of window W. If not known from W->header_line_height, look at W's current glyph matrix, or return an estimation based on the height of the font of the face `header-line'. */ #define CURRENT_HEADER_LINE_HEIGHT(W) \ - (W->header_line_height >= 0 \ - ? W->header_line_height \ - : (W->header_line_height \ - = (MATRIX_HEADER_LINE_HEIGHT (W->current_matrix) \ - ? MATRIX_HEADER_LINE_HEIGHT (W->current_matrix) \ + ((W)->header_line_height >= 0 \ + ? (W)->header_line_height \ + : ((W)->header_line_height \ + = (MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ + ? MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME (W->frame), HEADER_LINE_FACE_ID)))) + (XFRAME ((W)->frame), HEADER_LINE_FACE_ID)))) /* Return the current height of the tab line of window W. If not known from W->tab_line_height, look at W's current glyph matrix, or return an estimation based on the height of the font of the face `tab-line'. */ #define CURRENT_TAB_LINE_HEIGHT(W) \ - (W->tab_line_height >= 0 \ - ? W->tab_line_height \ - : (W->tab_line_height \ - = (MATRIX_TAB_LINE_HEIGHT (W->current_matrix) \ - ? MATRIX_TAB_LINE_HEIGHT (W->current_matrix) \ + ((W)->tab_line_height >= 0 \ + ? (W)->tab_line_height \ + : ((W)->tab_line_height \ + = (MATRIX_TAB_LINE_HEIGHT ((W)->current_matrix) \ + ? MATRIX_TAB_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME (W->frame), TAB_LINE_FACE_ID)))) + (XFRAME ((W)->frame), TAB_LINE_FACE_ID)))) /* Return the height of the desired mode line of window W. */ diff --git a/src/window.c b/src/window.c index 95197985e8..ba9af3b9b0 100644 --- a/src/window.c +++ b/src/window.c @@ -1120,7 +1120,7 @@ DEFUN ("window-mode-line-height", Fwindow_mode_line_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_MODE_LINE_HEIGHT (decode_live_window (window)))); + return make_fixnum (WINDOW_MODE_LINE_HEIGHT (decode_live_window (window))); } DEFUN ("window-header-line-height", Fwindow_header_line_height, @@ -1129,7 +1129,7 @@ DEFUN ("window-header-line-height", Fwindow_header_line_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_HEADER_LINE_HEIGHT (decode_live_window (window)))); + return make_fixnum (WINDOW_HEADER_LINE_HEIGHT (decode_live_window (window))); } DEFUN ("window-tab-line-height", Fwindow_tab_line_height, @@ -1138,7 +1138,7 @@ DEFUN ("window-tab-line-height", Fwindow_tab_line_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_TAB_LINE_HEIGHT (decode_live_window (window)))); + return make_fixnum (WINDOW_TAB_LINE_HEIGHT (decode_live_window (window))); } DEFUN ("window-right-divider-width", Fwindow_right_divider_width, @@ -1147,7 +1147,7 @@ DEFUN ("window-right-divider-width", Fwindow_right_divider_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_RIGHT_DIVIDER_WIDTH (decode_live_window (window)))); + return make_fixnum (WINDOW_RIGHT_DIVIDER_WIDTH (decode_live_window (window))); } DEFUN ("window-bottom-divider-width", Fwindow_bottom_divider_width, @@ -1156,7 +1156,7 @@ DEFUN ("window-bottom-divider-width", Fwindow_bottom_divider_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_BOTTOM_DIVIDER_WIDTH (decode_live_window (window)))); + return make_fixnum (WINDOW_BOTTOM_DIVIDER_WIDTH (decode_live_window (window))); } DEFUN ("window-scroll-bar-width", Fwindow_scroll_bar_width, @@ -1165,7 +1165,7 @@ DEFUN ("window-scroll-bar-width", Fwindow_scroll_bar_width, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_SCROLL_BAR_AREA_WIDTH (decode_live_window (window)))); + return make_fixnum (WINDOW_SCROLL_BAR_AREA_WIDTH (decode_live_window (window))); } DEFUN ("window-scroll-bar-height", Fwindow_scroll_bar_height, @@ -1174,7 +1174,7 @@ DEFUN ("window-scroll-bar-height", Fwindow_scroll_bar_height, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return (make_fixnum (WINDOW_SCROLL_BAR_AREA_HEIGHT (decode_live_window (window)))); + return make_fixnum (WINDOW_SCROLL_BAR_AREA_HEIGHT (decode_live_window (window))); } DEFUN ("window-hscroll", Fwindow_hscroll, Swindow_hscroll, 0, 1, 0, @@ -4470,8 +4470,8 @@ window_resize_check (struct window *w, bool horflag) hardcodes the values of `window-safe-min-width' (2) and `window-safe-min-height' (1) which are defined in window.el. */ return (XFIXNUM (w->new_pixel) >= (horflag - ? (2 * FRAME_COLUMN_WIDTH (f)) - : FRAME_LINE_HEIGHT (f))); + ? 2 * FRAME_COLUMN_WIDTH (f) + : FRAME_LINE_HEIGHT (f))); } @@ -5350,15 +5350,13 @@ window_wants_mode_line (struct window *w) Lisp_Object window_mode_line_format = window_parameter (w, Qmode_line_format); - return ((WINDOW_LEAF_P (w) - && !MINI_WINDOW_P (w) - && !WINDOW_PSEUDO_P (w) - && !EQ (window_mode_line_format, Qnone) - && (!NILP (window_mode_line_format) - || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format))) - && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w)) - ? 1 - : 0); + return (WINDOW_LEAF_P (w) + && !MINI_WINDOW_P (w) + && !WINDOW_PSEUDO_P (w) + && !EQ (window_mode_line_format, Qnone) + && (!NILP (window_mode_line_format) + || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format))) + && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w)); } @@ -5381,18 +5379,16 @@ window_wants_header_line (struct window *w) Lisp_Object window_header_line_format = window_parameter (w, Qheader_line_format); - return ((WINDOW_LEAF_P (w) - && !MINI_WINDOW_P (w) - && !WINDOW_PSEUDO_P (w) - && !EQ (window_header_line_format, Qnone) - && (!NILP (window_header_line_format) - || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format))) - && (WINDOW_PIXEL_HEIGHT (w) - > (window_wants_mode_line (w) - ? 2 * WINDOW_FRAME_LINE_HEIGHT (w) - : WINDOW_FRAME_LINE_HEIGHT (w)))) - ? 1 - : 0); + return (WINDOW_LEAF_P (w) + && !MINI_WINDOW_P (w) + && !WINDOW_PSEUDO_P (w) + && !EQ (window_header_line_format, Qnone) + && (!NILP (window_header_line_format) + || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format))) + && (WINDOW_PIXEL_HEIGHT (w) + > (window_wants_mode_line (w) + ? 2 * WINDOW_FRAME_LINE_HEIGHT (w) + : WINDOW_FRAME_LINE_HEIGHT (w)))); } @@ -5410,24 +5406,23 @@ window_wants_header_line (struct window *w) * to accommodate a mode line and a header line too if necessary (the * mode line and a header line prevail). */ + bool window_wants_tab_line (struct window *w) { Lisp_Object window_tab_line_format = window_parameter (w, Qtab_line_format); - return ((WINDOW_LEAF_P (w) - && !MINI_WINDOW_P (w) - && !WINDOW_PSEUDO_P (w) - && !EQ (window_tab_line_format, Qnone) - && (!NILP (window_tab_line_format) - || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), tab_line_format))) - && (WINDOW_PIXEL_HEIGHT (w) - > (((window_wants_mode_line (w) ? 1 : 0) - + (window_wants_header_line (w) ? 1 : 0) - + 1) * WINDOW_FRAME_LINE_HEIGHT (w)))) - ? 1 - : 0); + return (WINDOW_LEAF_P (w) + && !MINI_WINDOW_P (w) + && !WINDOW_PSEUDO_P (w) + && !EQ (window_tab_line_format, Qnone) + && (!NILP (window_tab_line_format) + || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), tab_line_format))) + && (WINDOW_PIXEL_HEIGHT (w) + > (((window_wants_mode_line (w) ? 1 : 0) + + (window_wants_header_line (w) ? 1 : 0) + + 1) * WINDOW_FRAME_LINE_HEIGHT (w)))); } /* Return number of lines of text in window W, not counting the mode @@ -7192,7 +7187,7 @@ the return value is nil. Otherwise the value is t. */) minibuf_selected_window = data->minibuf_selected_window; SAFE_FREE (); - return (FRAME_LIVE_P (f) ? Qt : Qnil); + return FRAME_LIVE_P (f) ? Qt : Qnil; } @@ -7481,7 +7476,7 @@ saved by this function. */) ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window))); save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0); XSETWINDOW_CONFIGURATION (tem, data); - return (tem); + return tem; } /* Called after W's margins, fringes or scroll bars was adjusted. */ diff --git a/src/window.h b/src/window.h index 21d2f3d367..71946a5695 100644 --- a/src/window.h +++ b/src/window.h @@ -750,11 +750,11 @@ wset_next_buffers (struct window *w, Lisp_Object val) /* True if W is a tab bar window. */ #if defined (HAVE_WINDOW_SYSTEM) -#define WINDOW_TAB_BAR_P(W) \ - (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \ - && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window)) +# define WINDOW_TAB_BAR_P(W) \ + (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \ + && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window)) #else -#define WINDOW_TAB_BAR_P(W) false +# define WINDOW_TAB_BAR_P(W) false #endif /* True if W is a tool bar window. */ diff --git a/src/xdisp.c b/src/xdisp.c index 89a72ff751..9d1fdecaff 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13176,7 +13176,8 @@ redisplay_tab_bar (struct frame *f) GLYPH doesn't display a tab-bar item. */ static bool -tab_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx, bool *close_p) +tab_bar_item_info (struct frame *f, struct glyph *glyph, + int *prop_idx, bool *close_p) { Lisp_Object prop; int charpos; commit be27f02bcfe1f99b1bfe0ed2a5669f320bb1ef59 Author: Stefan Kangas Date: Fri Aug 9 09:39:16 2019 +0200 Make mouse scroll show a message instead of dinging at buffer limits * lisp/mwheel.el (mwheel-scroll): Show a message instead of dinging at end of buffer and beginning of buffer. This should be less intrusive, especially when using a trackpad. (Bug#16196) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index dfea55374b..4862406fa1 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -237,7 +237,8 @@ non-Windows systems." (window-point))) (mods (delq 'click (delq 'double (delq 'triple (event-modifiers event))))) - (amt (assoc mods mouse-wheel-scroll-amount))) + (amt (assoc mods mouse-wheel-scroll-amount)) + saw-error) (unless (eq scroll-window selected-window) ;; Mark window to be scrolled for redisplay. (select-window scroll-window 'mark-for-redisplay)) @@ -251,57 +252,66 @@ non-Windows systems." ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...). (setq amt (* amt (event-click-count event)))) (when (numberp amt) (setq amt (* amt (event-line-count event)))) - (unwind-protect - (let ((button (mwheel-event-button event))) - (cond ((eq button mouse-wheel-down-event) - (condition-case nil (funcall mwheel-scroll-down-function amt) - ;; Make sure we do indeed scroll to the beginning of - ;; the buffer. - (beginning-of-buffer - (unwind-protect - (funcall mwheel-scroll-down-function) - ;; If the first scroll succeeded, then some scrolling - ;; is possible: keep scrolling til the beginning but - ;; do not signal an error. For some reason, we have - ;; to do it even if the first scroll signaled an - ;; error, because otherwise the window is recentered - ;; for a reason that escapes me. This problem seems - ;; to only affect scroll-down. --Stef - (set-window-start (selected-window) (point-min)))))) - ((eq button mouse-wheel-up-event) - (condition-case nil (funcall mwheel-scroll-up-function amt) - ;; Make sure we do indeed scroll to the end of the buffer. - (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) - ((eq button mouse-wheel-left-event) ; for tilt scroll - (when mouse-wheel-tilt-scroll - (funcall (if mouse-wheel-flip-direction - mwheel-scroll-right-function - mwheel-scroll-left-function) amt))) - ((eq button mouse-wheel-right-event) ; for tilt scroll - (when mouse-wheel-tilt-scroll - (funcall (if mouse-wheel-flip-direction - mwheel-scroll-left-function - mwheel-scroll-right-function) amt))) - (t (error "Bad binding in mwheel-scroll")))) - (if (eq scroll-window selected-window) - ;; If there is a temporarily active region, deactivate it if - ;; scrolling moved point. - (when (and old-point (/= old-point (window-point))) - ;; Call `deactivate-mark' at the original position, so that - ;; the original region is saved to the X selection. - (let ((new-point (window-point))) - (goto-char old-point) - (deactivate-mark) - (goto-char new-point))) - (select-window selected-window t)))) - - (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time) - (if mwheel-inhibit-click-event-timer - (cancel-timer mwheel-inhibit-click-event-timer) - (add-hook 'pre-command-hook 'mwheel-filter-click-events)) - (setq mwheel-inhibit-click-event-timer - (run-with-timer mouse-wheel-inhibit-click-time nil - 'mwheel-inhibit-click-timeout)))) + (condition-case nil + (unwind-protect + (let ((button (mwheel-event-button event))) + (cond ((eq button mouse-wheel-down-event) + (condition-case nil (funcall mwheel-scroll-down-function amt) + ;; Make sure we do indeed scroll to the beginning of + ;; the buffer. + (beginning-of-buffer + (unwind-protect + (funcall mwheel-scroll-down-function) + ;; If the first scroll succeeded, then some scrolling + ;; is possible: keep scrolling til the beginning but + ;; do not signal an error. For some reason, we have + ;; to do it even if the first scroll signaled an + ;; error, because otherwise the window is recentered + ;; for a reason that escapes me. This problem seems + ;; to only affect scroll-down. --Stef + (set-window-start (selected-window) (point-min)))))) + ((eq button mouse-wheel-up-event) + (condition-case nil (funcall mwheel-scroll-up-function amt) + ;; Make sure we do indeed scroll to the end of the buffer. + (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) + ((eq button mouse-wheel-left-event) ; for tilt scroll + (when mouse-wheel-tilt-scroll + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-right-function + mwheel-scroll-left-function) amt))) + ((eq button mouse-wheel-right-event) ; for tilt scroll + (when mouse-wheel-tilt-scroll + (funcall (if mouse-wheel-flip-direction + mwheel-scroll-left-function + mwheel-scroll-right-function) amt))) + (t (error "Bad binding in mwheel-scroll")))) + (if (eq scroll-window selected-window) + ;; If there is a temporarily active region, deactivate it if + ;; scrolling moved point. + (when (and old-point (/= old-point (window-point))) + ;; Call `deactivate-mark' at the original position, so that + ;; the original region is saved to the X selection. + (let ((new-point (window-point))) + (goto-char old-point) + (deactivate-mark) + (goto-char new-point))) + (select-window selected-window t))) + ;; Do not ding at buffer limits. Show a message instead. + (beginning-of-buffer + (message (error-message-string '(beginning-of-buffer))) + (setq saw-error t)) + (end-of-buffer + (message (error-message-string '(end-of-buffer))) + (setq saw-error t))) + + (when (and (not saw-error) + mouse-wheel-click-event mouse-wheel-inhibit-click-time) + (if mwheel-inhibit-click-event-timer + (cancel-timer mwheel-inhibit-click-event-timer) + (add-hook 'pre-command-hook 'mwheel-filter-click-events)) + (setq mwheel-inhibit-click-event-timer + (run-with-timer mouse-wheel-inhibit-click-time nil + 'mwheel-inhibit-click-timeout))))) (put 'mwheel-scroll 'scroll-command t) commit 591c8bc70fc5f0e1de5aa9a05800375ca4da8587 Author: Stefan Kangas Date: Tue Aug 20 19:04:16 2019 +0200 Bind Scroll_Lock to scroll-lock-mode globally * lisp/bindings.el (global-map): Bind Scroll_Lock to scroll-lock-mode. (Bug#6861) * lisp/scroll-lock.el (scroll-lock-mode): Note that the binding will not work if 'w32-scroll-lock-modifier' is non-nil. * etc/NEWS: Announce it. diff --git a/etc/NEWS b/etc/NEWS index c8cc7537b0..db90e8e5c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -445,6 +445,11 @@ RGB triplets with a single hexadecimal digit per component. --- ** The toolbar now shows the equivalent key binding in its tooltips. +--- +** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally. +Note that this key binding will not work on MS-Windows systems if +'w32-scroll-lock-modifier' is non-nil. + * Editing Changes in Emacs 27.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index 0be1458798..16da2bdf9a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1054,6 +1054,7 @@ if `inhibit-field-text-motion' is non-nil." ;(define-key global-map [delete] 'backward-delete-char) ;; natural bindings for terminal keycaps --- defined in X keysym order +(define-key global-map [Scroll_Lock] 'scroll-lock-mode) (define-key global-map [C-S-backspace] 'kill-whole-line) (define-key global-map [home] 'move-beginning-of-line) (define-key global-map [C-home] 'beginning-of-buffer) diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 3a74c11b7a..36e2264fe4 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -54,7 +54,10 @@ When enabled, keys that normally move point by line or paragraph will scroll the buffer by the respective amount of lines instead and point will be kept vertically fixed relative to window -boundaries during scrolling." +boundaries during scrolling. + +Note that the default key binding to Scroll_Lock will not work on +MS-Windows systems if `w32-scroll-lock-modifier' is non-nil." :lighter " ScrLck" :keymap scroll-lock-mode-map (if scroll-lock-mode commit ef8fadf8c1399b4ce7086141ebf96610b6475df2 Author: Stefan Kangas Date: Mon Sep 16 23:42:56 2019 +0200 Add tests for secure-hash and improve doc string (Bug#37420) * src/fns.c (Fsecure_hash_algorithms): Fix typo. (Fsecure_hash): Add algorithm list to doc string. * test/src/fns-tests.el (test-secure-hash): New test. diff --git a/src/fns.c b/src/fns.c index b800f1c47f..fa52e5e197 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5081,7 +5081,7 @@ make_digest_string (Lisp_Object digest, int digest_size) DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, Ssecure_hash_algorithms, 0, 0, 0, - doc: /* Return a list of all the supported `secure_hash' algorithms. */) + doc: /* Return a list of all the supported `secure-hash' algorithms. */) (void) { return list (Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512); @@ -5388,7 +5388,12 @@ anything security-related. See `secure-hash' for alternatives. */) DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0, doc: /* Return the secure hash of OBJECT, a buffer or string. ALGORITHM is a symbol specifying the hash to use: -md5, sha1, sha224, sha256, sha384 or sha512. +- md5 corresponds to MD5 +- sha1 corresponds to SHA-1 +- sha224 corresponds to SHA-2 (SHA-224) +- sha256 corresponds to SHA-2 (SHA-256) +- sha384 corresponds to SHA-2 (SHA-384) +- sha512 corresponds to SHA-2 (SHA-512) The two optional arguments START and END are positions specifying for which part of OBJECT to compute the hash. If nil or omitted, uses the diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 7d56da77cf..6236c9276d 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -858,4 +858,22 @@ (puthash k k h))) (should (= 100 (hash-table-count h))))) +(ert-deftest test-secure-hash () + (should (equal (secure-hash 'md5 "foobar") + "3858f62230ac3c915f300c664312c63f")) + (should (equal (secure-hash 'sha1 "foobar") + "8843d7f92416211de9ebb963ff4ce28125932878")) + (should (equal (secure-hash 'sha224 "foobar") + "de76c3e567fca9d246f5f8d3b2e704a38c3c5e258988ab525f941db8")) + (should (equal (secure-hash 'sha256 "foobar") + (concat "c3ab8ff13720e8ad9047dd39466b3c89" + "74e592c2fa383d4a3960714caef0c4f2"))) + (should (equal (secure-hash 'sha384 "foobar") + (concat "3c9c30d9f665e74d515c842960d4a451c83a0125fd3de739" + "2d7b37231af10c72ea58aedfcdf89a5765bf902af93ecf06"))) + (should (equal (secure-hash 'sha512 "foobar") + (concat "0a50261ebd1a390fed2bf326f2673c145582a6342d5" + "23204973d0219337f81616a8069b012587cf5635f69" + "25f1b56c360230c19b273500ee013e030601bf2425")))) + (provide 'fns-tests) commit dd3592564aaaee15077800a093c9e04f5da898dc Author: Stefan Kangas Date: Thu Sep 26 12:31:37 2019 +0200 Declare unused vhdl code in align.el obsolete * lisp/align.el (align-vhdl-rules-list, align-set-vhdl-rules): Declare obsolete. (Bug#6207) (align-dq-string-modes, align-open-comment-modes): Move vhdl-mode to definition instead of adding it later. diff --git a/lisp/align.el b/lisp/align.el index cd72d52df4..d83f8341c9 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -206,7 +206,7 @@ If nil, then no messages will ever be printed to the minibuffer." (defcustom align-dq-string-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode)) + '(python-mode vhdl-mode)) "A list of modes where double quoted strings should be excluded." :type '(repeat symbol) :group 'align) @@ -219,7 +219,7 @@ If nil, then no messages will ever be printed to the minibuffer." (defcustom align-open-comment-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode makefile-mode)) + '(python-mode makefile-mode vhdl-mode)) "A list of modes with a single-line comment syntax. These are comments as in Lisp, which have a beginning, but end with the line (i.e., `comment-end' is an empty string)." @@ -805,9 +805,7 @@ See the variable `align-exclude-rules-list' for more details.") (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. - +;; Sample extension rule set for vhdl-mode. This is now obsolete. (defcustom align-vhdl-rules-list `((vhdl-declaration (regexp . "\\(signal\\|variable\\|constant\\)\\(\\s-+\\)\\S-") @@ -842,18 +840,14 @@ See the variable `align-exclude-rules-list' for more details.") "Alignment rules for `vhdl-mode'. See `align-rules-list' for more info." :type align-rules-list-type :group 'align) - (put 'align-vhdl-rules-list 'risky-local-variable t) +(make-obsolete-variable 'align-vhdl-rules-list "no longer used." "27.1") (defun align-set-vhdl-rules () "Setup the `align-mode-rules-list' variable for `vhdl-mode'." + (declare (obsolete nil "27.1")) (setq align-mode-rules-list align-vhdl-rules-list)) -(add-hook 'vhdl-mode-hook 'align-set-vhdl-rules) - -(add-to-list 'align-dq-string-modes 'vhdl-mode) -(add-to-list 'align-open-comment-modes 'vhdl-mode) - ;;; User Functions: ;;;###autoload commit 32558cfe53b187e3bbdfb532c7ce64ab9b0cd4f5 Author: Mattias Engdegård Date: Fri Oct 4 15:29:31 2019 +0200 Fix error in gnu compilation-mode regexp (bug#37582) * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Fix a mistake introduced when the regexp was translated to rx. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data) (compile-test-error-regexps): Add test case. * etc/compilation.txt: Add example. diff --git a/etc/compilation.txt b/etc/compilation.txt index eccdfa737f..0e39ab5e4a 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -286,6 +286,7 @@ jade:dbcommon.dsl:133:17:E: missing argument for function call G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found. file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found. {standard input}:27041: Warning: end of file not at end of a line; newline inserted +boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ] * Guile backtrace, 2.0.11 diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d80fef3103..83efb3e029 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -327,7 +327,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (: (* " ") (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)") "I:" - (: "[ skipping " (+ ".") " ]") + (: "[ skipping " (+ nonl) " ]") "instantiated from" "required from" (regexp "[Nn]ote")))) diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 3ff4521d2d..8e59a5401b 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -204,6 +204,8 @@ 1 nil 54 "G:/cygwin/dev/build-myproj.xml") ("{standard input}:27041: Warning: end of file not at end of a line; newline inserted" 1 nil 27041 "{standard input}") + ("boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" + 1 25 589 "boost/container/detail/flat_tree.hpp" 0) ;; Guile ("In foo.scm:\n" 1 nil nil "foo.scm") (" 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) @@ -407,7 +409,7 @@ The test data is in `compile-tests--test-regexps-data'." (mapc #'compile--test-error-line compile-tests--test-regexps-data) (should (eq compilation-num-errors-found 87)) (should (eq compilation-num-warnings-found 32)) - (should (eq compilation-num-infos-found 20))))) + (should (eq compilation-num-infos-found 21))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. commit d09cbcee9ce90171a20a3cae4a27dc08dcb1af41 Author: Mattias Engdegård Date: Fri Oct 4 15:23:13 2019 +0200 Make compile-tests re-runnable * test/lisp/progmodes/compile-tests.el (compile-test-error-regexps): Don't rely on compilation-num-errors (etc) all being zero, which they aren't if the test has been run before. (compile-tests--test-regexps-data): Change defvar to defconst. diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 0d4f7f2ff2..3ff4521d2d 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -30,7 +30,7 @@ (require 'ert) (require 'compile) -(defvar compile-tests--test-regexps-data +(defconst compile-tests--test-regexps-data ;; The computed column numbers are zero-indexed, so subtract 1 from ;; what's reported in the string. The end column numbers are for ;; the character after, so it matches what's reported in the string. @@ -401,10 +401,13 @@ can only work with the NUL byte to disambiguate colons.") The test data is in `compile-tests--test-regexps-data'." (with-temp-buffer (font-lock-mode -1) - (mapc #'compile--test-error-line compile-tests--test-regexps-data) - (should (eq compilation-num-errors-found 87)) - (should (eq compilation-num-warnings-found 32)) - (should (eq compilation-num-infos-found 20)))) + (let ((compilation-num-errors-found 0) + (compilation-num-warnings-found 0) + (compilation-num-infos-found 0)) + (mapc #'compile--test-error-line compile-tests--test-regexps-data) + (should (eq compilation-num-errors-found 87)) + (should (eq compilation-num-warnings-found 32)) + (should (eq compilation-num-infos-found 20))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. commit 5f06b9c478894c828fc5467b0aae360e2c2d1fd2 Author: Lars Ingebrigtsen Date: Fri Oct 4 15:29:30 2019 +0200 Remove semantic-make-local-hook call from CEDET * lisp/cedet/semantic/wisent/grammar.el (wisent-grammar-setupcode-builder): * lisp/cedet/semantic/util-modes.el (semantic-highlight-edits-mode) (semantic-show-unmatched-syntax-mode) (semantic-show-parser-state-mode): * lisp/cedet/semantic/mru-bookmark.el (semantic-mru-bookmark-mode): * lisp/cedet/semantic/imenu.el (semantic-create-imenu-index): * lisp/cedet/semantic/grammar.el (semantic-grammar-mode): * lisp/cedet/semantic/grammar-wy.el (semantic-grammar-wy--install-parser): * lisp/cedet/semantic/decorate/mode.el (semantic-decorate-add-pending-decoration) (semantic-decoration-mode): * lisp/cedet/semantic.el (semantic--set-buffer-cache): Remove all calls to the function. * lisp/cedet/semantic/fw.el (semantic-make-local-hook): Made obsolete alias for #'ignore by removing XEmacs compat code. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 8ffdbf0ff2..0b878cae52 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -535,7 +535,6 @@ is requested." (set (make-local-variable 'semantic-bovinate-nonterminal-check-obarray) nil) (semantic-parse-tree-set-up-to-date) - (semantic-make-local-hook 'after-change-functions) (add-hook 'after-change-functions 'semantic-change-function nil t) (run-hook-with-args 'semantic-after-toplevel-cache-change-hook semantic--buffer-cache) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 4e3ca2c6ee..9825f353ce 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -213,7 +213,6 @@ Applies only to the current BUFFER. The setting of FCN will be removed after it is run." (save-excursion (when buffer (set-buffer buffer)) - (semantic-make-local-hook 'semantic-decorate-flush-pending-decorations) (add-hook 'semantic-decorate-pending-decoration-hook fcn nil t))) (defun semantic-decorate-flush-pending-decorations (&optional buffer) @@ -267,10 +266,8 @@ non-nil if the minor mode is enabled." (error "Buffer %s was not set up for parsing" (buffer-name))) ;; Add hooks - (semantic-make-local-hook 'semantic-after-partial-cache-change-hook) (add-hook 'semantic-after-partial-cache-change-hook 'semantic-decorate-tags-after-partial-reparse nil t) - (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) (add-hook 'semantic-after-toplevel-cache-change-hook 'semantic-decorate-tags-after-full-reparse nil t) ;; Add decorations to available tags. The above hooks ensure diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 216a47547d..e07f090184 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -62,9 +62,7 @@ "Extract the window from EVENT." (car (car (cdr event)))) -(defalias 'semantic-make-local-hook - (if (featurep 'emacs) - #'identity #'make-local-hook)) +(define-obsolete-function-alias 'semantic-make-local-hook #'identity "27.1") (defalias 'semantic-mode-line-update #'force-mode-line-update) diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el index b5066d3d27..3b99469f55 100644 --- a/lisp/cedet/semantic/grammar-wy.el +++ b/lisp/cedet/semantic/grammar-wy.el @@ -428,7 +428,6 @@ semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table semantic-lex-types-obarray semantic-grammar-wy--token-table) ;; Collect unmatched syntax lexical tokens - (semantic-make-local-hook 'wisent-discarding-token-functions) (add-hook 'wisent-discarding-token-functions 'wisent-collect-unmatched-syntax nil t)) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 4237f9cef1..813580ba6c 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1348,11 +1348,9 @@ the change bounds to encompass the whole nonterminal tag." '(nonterminal)) ;; Before each change, clear the cached regexp used to highlight ;; macros local in this grammar. - (semantic-make-local-hook 'before-change-functions) (add-hook 'before-change-functions 'semantic--grammar-clear-macros-regexp-2 nil t) ;; Handle safe re-parse of grammar rules. - (semantic-make-local-hook 'semantic-edits-new-change-functions) (add-hook 'semantic-edits-new-change-functions 'semantic-grammar-edits-new-change-hook-fcn nil t)) diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 5119eb62f3..7dcf75fefa 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -240,10 +240,8 @@ Optional argument STREAM is an optional stream of tags used to create menus." (or stream (semantic-fetch-tags-fast))) (semantic-create-imenu-index-1 (or stream (semantic-fetch-tags-fast)) nil)) - (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) (add-hook 'semantic-after-toplevel-cache-change-hook 'semantic-imenu-flush-fcn nil t) - (semantic-make-local-hook 'semantic-after-partial-cache-change-hook) (add-hook 'semantic-after-partial-cache-change-hook 'semantic-imenu-flush-fcn nil t))) diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index 627c71a01b..13cfc586fd 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -288,7 +288,6 @@ non-nil if the minor mode is enabled." (setq semantic-mru-bookmark-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (semantic-make-local-hook 'semantic-edits-new-change-functions) (add-hook 'semantic-edits-new-change-functions 'semantic-mru-bookmark-change-hook-fcn nil t) (add-hook 'semantic-edits-move-change-hooks diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 954181c2cd..9e9f054d73 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -220,7 +220,6 @@ non-nil if the minor mode is enabled." (setq semantic-highlight-edits-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (semantic-make-local-hook 'semantic-edits-new-change-functions) (add-hook 'semantic-edits-new-change-functions 'semantic-highlight-edits-new-change-hook-fcn nil t)) ;; Remove hooks @@ -372,10 +371,8 @@ non-nil if the minor mode is enabled. (error "Buffer %s was not set up for parsing" (buffer-name))) ;; Add hooks - (semantic-make-local-hook 'semantic-unmatched-syntax-hook) (add-hook 'semantic-unmatched-syntax-hook 'semantic-show-unmatched-syntax nil t) - (semantic-make-local-hook 'semantic-pre-clean-token-hooks) (add-hook 'semantic-pre-clean-token-hooks 'semantic-clean-token-of-unmatched-syntax nil t) ;; Show unmatched syntax elements @@ -456,31 +453,23 @@ non-nil if the minor mode is enabled." (append mode-line-modified '(semantic-show-parser-state-string)))) ;; Add hooks - (semantic-make-local-hook 'semantic-edits-new-change-functions) (add-hook 'semantic-edits-new-change-functions 'semantic-show-parser-state-marker nil t) - (semantic-make-local-hook 'semantic-edits-incremental-reparse-failed-hook) (add-hook 'semantic-edits-incremental-reparse-failed-hook 'semantic-show-parser-state-marker nil t) - (semantic-make-local-hook 'semantic-after-partial-cache-change-hook) (add-hook 'semantic-after-partial-cache-change-hook 'semantic-show-parser-state-marker nil t) - (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) (add-hook 'semantic-after-toplevel-cache-change-hook 'semantic-show-parser-state-marker nil t) (semantic-show-parser-state-marker) - (semantic-make-local-hook 'semantic-before-auto-parse-hooks) (add-hook 'semantic-before-auto-parse-hooks 'semantic-show-parser-state-auto-marker nil t) - (semantic-make-local-hook 'semantic-after-auto-parse-hooks) (add-hook 'semantic-after-auto-parse-hooks 'semantic-show-parser-state-marker nil t) - (semantic-make-local-hook 'semantic-before-idle-scheduler-reparse-hook) (add-hook 'semantic-before-idle-scheduler-reparse-hook 'semantic-show-parser-state-auto-marker nil t) - (semantic-make-local-hook 'semantic-after-idle-scheduler-reparse-hook) (add-hook 'semantic-after-idle-scheduler-reparse-hook 'semantic-show-parser-state-marker nil t)) ;; Remove parts of mode line diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index d23e293552..e6b389b60b 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -304,7 +304,6 @@ Return the expanded expression." semantic-flex-keywords-obarray %s\n\ semantic-lex-types-obarray %s)\n\ ;; Collect unmatched syntax lexical tokens\n\ - (semantic-make-local-hook 'wisent-discarding-token-functions)\n\ (add-hook 'wisent-discarding-token-functions\n\ 'wisent-collect-unmatched-syntax nil t)" (semantic-grammar-parsetable) commit 33702988d9b0ff7ba816bf3a78cfd2586e16744e Author: Lars Ingebrigtsen Date: Fri Oct 4 15:24:42 2019 +0200 Remove some XEmacs compat code from ispell.el * lisp/textmodes/ispell.el (ispell-word): Remove XEmacs compat code. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 5c77e03b0b..c1b21fdd2e 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1932,12 +1932,7 @@ nil word is correct or spelling is accepted. quit spell session exited." (interactive (list ispell-following-word ispell-quietly current-prefix-arg t)) (cond - ((and region - (if (featurep 'emacs) - (use-region-p) - (and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active - (not (eq (region-beginning) (region-end)))))) + ((and region (use-region-p)) (ispell-region (region-beginning) (region-end))) (continue (ispell-continue)) (t commit b0ef37758ea4b15816e9adb36120862f1eb551d9 Author: Lars Ingebrigtsen Date: Fri Oct 4 15:23:54 2019 +0200 Remove some XEmacs compat code from ezimage.el * lisp/ezimage.el (defezimage): Remove XEmacs compat code. diff --git a/lisp/ezimage.el b/lisp/ezimage.el index 2b06878f8e..6c590f16ac 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -48,80 +48,12 @@ :type 'boolean) ;;; Create our own version of defimage -(eval-and-compile - -(if (featurep 'emacs) - (progn - (defmacro defezimage (variable imagespec docstring) - "Define VARIABLE as an image if `defimage' is not available. -IMAGESPEC is the image data, and DOCSTRING is documentation for the image." - `(progn - (defimage ,variable ,imagespec ,docstring) - (put (quote ,variable) 'ezimage t))) - -;; This hack is for the ezimage install which has an icons directory for -;; the default icons to be used. -;; (add-to-list 'load-path -;; (concat (file-name-directory -;; (locate-library "ezimage.el")) -;; "icons")) - - ) - - ;; XEmacs. - (if (not (fboundp 'make-glyph)) - - (defmacro defezimage (variable _imagespec docstring) - "Don't bother loading up an image... -Argument VARIABLE is the variable to define. -Argument IMAGESPEC is the list defining the image to create. -Argument DOCSTRING is the documentation for VARIABLE." - `(defvar ,variable nil ,docstring)) - - (defun ezimage-find-image-on-load-path (image) - "Find the image file IMAGE on the load path." - (let ((l (cons - ;; In XEmacs, try the data directory first (for an - ;; install in XEmacs proper.) Search the load - ;; path next (for user installs) - (locate-data-directory "ezimage") - load-path)) - (r nil)) - (while (and l (not r)) - (if (file-exists-p (concat (car l) "/" image)) - (setq r (concat (car l) "/" image)) - (if (file-exists-p (concat (car l) "/icons/" image)) - (setq r (concat (car l) "/icons/" image)) - )) - (setq l (cdr l))) - r)) - - (defun ezimage-convert-emacs21-imagespec-to-xemacs (spec) - "Convert the Emacs21 image SPEC into an XEmacs image spec. -The Emacs 21 spec is what I first learned, and is easy to convert." - (let* ((sl (car spec)) - (itype (nth 1 sl)) - (ifile (nth 3 sl))) - (vector itype ':file (ezimage-find-image-on-load-path ifile)))) - - (defmacro defezimage (variable imagespec docstring) - "Define VARIABLE as an image if `defimage' is not available. +(defmacro defezimage (variable imagespec docstring) + "Define VARIABLE as an image if `defimage' is not available. IMAGESPEC is the image data, and DOCSTRING is documentation for the image." - `(progn - (defvar ,variable - ;; The Emacs21 version of defimage looks just like the XEmacs image - ;; specifier, except that it needs a :type keyword. If we line - ;; stuff up right, we can use this cheat to support XEmacs specifiers. - (condition-case nil - (make-glyph - (make-image-specifier - (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec))) - 'buffer) - (error nil)) - ,docstring) - (put ',variable 'ezimage t))) - - ))) + `(progn + (defimage ,variable ,imagespec ,docstring) + (put (quote ,variable) 'ezimage t))) (defezimage ezimage-directory ((:type xpm :file "ezimage/dir.xpm" :ascent center)) commit 094e48e4e7d71ca2d26ab047494afaa703ca85eb Author: Stefan Kangas Date: Fri Oct 4 02:20:28 2019 +0200 Remove XEmacs compat code from re-builder.el * lisp/emacs-lisp/re-builder.el (top-level) (reb-color-display-p): Remove XEmacs compat code. diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 1054f1453b..f8e264cf39 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -103,10 +103,6 @@ ;;; Code: -;; On XEmacs, load the overlay compatibility library -(unless (fboundp 'make-overlay) - (require 'overlay)) - ;; User customizable variables (defgroup re-builder nil "Options for the RE Builder." @@ -319,12 +315,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defun reb-color-display-p () "Return t if display is capable of displaying colors." - (eq 'color - ;; emacs/xemacs compatibility - (if (fboundp 'frame-parameter) - (frame-parameter nil 'display-type) - (if (fboundp 'frame-property) - (frame-property (selected-frame) 'display-type))))) + (eq 'color (frame-parameter nil 'display-type))) (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." commit 8ef09cb30a526f34236f6696d06a2848043685ae Author: Lars Ingebrigtsen Date: Fri Oct 4 15:20:41 2019 +0200 Remove some XEmacs compat code from ediff*.el * lisp/vc/ediff-diff.el (ediff-goto-word): Ditto. * lisp/vc/ediff-init.el (ediff-has-face-support-p) (ediff-current-diff-A, ediff-current-diff-B) (ediff-current-diff-C, ediff-current-diff-Ancestor) (ediff-fine-diff-A, ediff-fine-diff-B, ediff-fine-diff-C) (ediff-fine-diff-Ancestor, ediff-even-diff-A) (ediff-even-diff-B, ediff-even-diff-C) (ediff-even-diff-Ancestor, ediff-odd-diff-A, ediff-odd-diff-B) (ediff-odd-diff-C, ediff-odd-diff-Ancestor) (ediff-with-syntax-table): Ditto. * lisp/vc/ediff-mult.el (ediff-dir-diffs-buffer-map) (ediff-setup-meta-map, ediff-set-meta-overlay): Ditto. * lisp/vc/ediff-util.el (ediff-setup-keymap) (ediff-toggle-wide-display, ediff-toggle-multiframe) (ediff-toggle-use-toolbar, ediff-really-quit) (ediff-good-frame-under-mouse) (ediff-make-bullet-proof-overlay): Ditto. * lisp/vc/ediff-wind.el (ediff-setup-control-frame) (ediff-refresh-control-frame): Remove XEmacs compat code. diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index d22c9399ac..0c8c89610f 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -1326,7 +1326,7 @@ arguments to `skip-chars-forward'." (syntax-tbl ediff-syntax-table)) (ediff-with-current-buffer buf (skip-chars-forward ediff-whitespace) - (ediff-with-syntax-table syntax-tbl + (with-syntax-table syntax-tbl (while (> n 1) (funcall fwd-word-fun) (skip-chars-forward ediff-whitespace) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index f98a7ed560..c007d93448 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -58,9 +58,7 @@ that Ediff doesn't know about.") (cond ((ediff-window-display-p)) (ediff-force-faces) ((ediff-color-display-p)) - ((featurep 'emacs) (memq (ediff-device-type) '(pc))) - ((featurep 'xemacs) (memq (ediff-device-type) '(tty pc))) - )) + (t (memq (ediff-device-type) '(pc))))) ;; toolbar support for emacs hasn't been implemented in ediff (defun ediff-has-toolbar-support-p () @@ -822,19 +820,15 @@ to temp files in buffer jobs and when Ediff needs to find fine differences." (defface ediff-current-diff-A - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#ffdddd") - (((class color) (min-colors 88) (background dark)) - :background "#553333") - (((class color) (min-colors 16)) - (:foreground "firebrick" :background "pale green")) - (((class color)) - (:foreground "blue3" :background "yellow3")) - (t (:inverse-video t))) - '((((type tty)) (:foreground "blue3" :background "yellow3")) - (((class color)) (:foreground "firebrick" :background "pale green")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) + :background "#ffdddd") + (((class color) (min-colors 88) (background dark)) + :background "#553333") + (((class color) (min-colors 16)) + (:foreground "firebrick" :background "pale green")) + (((class color)) + (:foreground "blue3" :background "yellow3")) + (t (:inverse-video t))) "Face for highlighting the selected difference in buffer A." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -855,21 +849,16 @@ this variable represents.") (defface ediff-current-diff-B - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#ddffdd") - (((class color) (min-colors 88) (background dark)) - :background "#335533") - (((class color) (min-colors 16)) - (:foreground "DarkOrchid" :background "Yellow")) - (((class color)) - (:foreground "magenta3" :background "yellow3" - :weight bold)) - (t (:inverse-video t))) - '((((type tty)) (:foreground "magenta3" :background "yellow3" - :weight bold)) - (((class color)) (:foreground "DarkOrchid" :background "Yellow")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) + :background "#ddffdd") + (((class color) (min-colors 88) (background dark)) + :background "#335533") + (((class color) (min-colors 16)) + (:foreground "DarkOrchid" :background "Yellow")) + (((class color)) + (:foreground "magenta3" :background "yellow3" + :weight bold)) + (t (:inverse-video t))) "Face for highlighting the selected difference in buffer B." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -889,19 +878,15 @@ this variable represents.") (defface ediff-current-diff-C - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#ffffaa") - (((class color) (min-colors 88) (background dark)) - :background "#888833") - (((class color) (min-colors 16)) - (:foreground "Navy" :background "Pink")) - (((class color)) - (:foreground "cyan3" :background "yellow3" :weight bold)) - (t (:inverse-video t))) - '((((type tty)) (:foreground "cyan3" :background "yellow3" :weight bold)) - (((class color)) (:foreground "Navy" :background "Pink")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) + :background "#ffffaa") + (((class color) (min-colors 88) (background dark)) + :background "#888833") + (((class color) (min-colors 16)) + (:foreground "Navy" :background "Pink")) + (((class color)) + (:foreground "cyan3" :background "yellow3" :weight bold)) + (t (:inverse-video t))) "Face for highlighting the selected difference in buffer C." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -921,21 +906,17 @@ this variable represents.") (defface ediff-current-diff-Ancestor - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#cfdeee") - (((class color) (min-colors 88) (background dark)) - :background "#004151") - (((class color) (min-colors 16) (background light)) - :background "#cfdeee") - (((class color) (min-colors 16) (background dark)) - :background "#004151") - (((class color)) - (:foreground "black" :background "magenta3")) - (t (:inverse-video t))) - '((((type tty)) (:foreground "black" :background "magenta3")) - (((class color)) (:foreground "Black" :background "VioletRed")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) + :background "#cfdeee") + (((class color) (min-colors 88) (background dark)) + :background "#004151") + (((class color) (min-colors 16) (background light)) + :background "#cfdeee") + (((class color) (min-colors 16) (background dark)) + :background "#004151") + (((class color)) + (:foreground "black" :background "magenta3")) + (t (:inverse-video t))) "Face for highlighting the selected difference in buffer Ancestor." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -955,19 +936,15 @@ this variable represents.") (defface ediff-fine-diff-A - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#ffbbbb") - (((class color) (min-colors 88) (background dark)) - :background "#aa2222") - (((class color) (min-colors 16)) - (:foreground "Navy" :background "sky blue")) - (((class color)) - (:foreground "white" :background "sky blue" :weight bold)) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "white" :background "sky blue" :weight bold)) - (((class color)) (:foreground "Navy" :background "sky blue")) - (t (:underline t :stipple "gray3")))) + '((((class color) (min-colors 88) (background light)) + :background "#ffbbbb") + (((class color) (min-colors 88) (background dark)) + :background "#aa2222") + (((class color) (min-colors 16)) + (:foreground "Navy" :background "sky blue")) + (((class color)) + (:foreground "white" :background "sky blue" :weight bold)) + (t (:underline t :stipple "gray3"))) "Face for highlighting the refinement of the selected diff in buffer A." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -980,19 +957,15 @@ this variable represents.") (ediff-hide-face ediff-fine-diff-face-A) (defface ediff-fine-diff-B - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#aaffaa") - (((class color) (min-colors 88) (background dark)) - :background "#22aa22") - (((class color) (min-colors 16)) - (:foreground "Black" :background "cyan")) - (((class color)) - (:foreground "magenta3" :background "cyan3")) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "magenta3" :background "cyan3")) - (((class color)) (:foreground "Black" :background "cyan")) - (t (:underline t :stipple "gray3")))) + '((((class color) (min-colors 88) (background light)) + :background "#aaffaa") + (((class color) (min-colors 88) (background dark)) + :background "#22aa22") + (((class color) (min-colors 16)) + (:foreground "Black" :background "cyan")) + (((class color)) + (:foreground "magenta3" :background "cyan3")) + (t (:underline t :stipple "gray3"))) "Face for highlighting the refinement of the selected diff in buffer B." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1005,24 +978,18 @@ this variable represents.") (ediff-hide-face ediff-fine-diff-face-B) (defface ediff-fine-diff-C - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#ffff55") - (((class color) (min-colors 88) (background dark)) - :background "#aaaa22") - (((type pc)) - (:foreground "white" :background "Turquoise")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "Turquoise")) - (((class color)) - (:foreground "yellow3" :background "Turquoise" - :weight bold)) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "yellow3" :background "Turquoise" - :weight bold)) - (((type pc)) (:foreground "white" :background "Turquoise")) - (((class color)) (:foreground "Black" :background "Turquoise")) - (t (:underline t :stipple "gray3")))) + '((((class color) (min-colors 88) (background light)) + :background "#ffff55") + (((class color) (min-colors 88) (background dark)) + :background "#aaaa22") + (((type pc)) + (:foreground "white" :background "Turquoise")) + (((class color) (min-colors 16)) + (:foreground "Black" :background "Turquoise")) + (((class color)) + (:foreground "yellow3" :background "Turquoise" + :weight bold)) + (t (:underline t :stipple "gray3"))) "Face for highlighting the refinement of the selected diff in buffer C." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1035,21 +1002,17 @@ this variable represents.") (ediff-hide-face ediff-fine-diff-face-C) (defface ediff-fine-diff-Ancestor - (if (featurep 'emacs) - '((((class color) (min-colors 88) (background light)) - :background "#00c5c0") - (((class color) (min-colors 88) (background dark)) - :background "#009591") - (((class color) (min-colors 16) (background light)) - :background "#00c5c0") - (((class color) (min-colors 16) (background dark)) - :background "#009591") - (((class color)) - (:foreground "red3" :background "green")) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "red3" :background "green")) - (((class color)) (:foreground "Black" :background "Green")) - (t (:underline t :stipple "gray3")))) + '((((class color) (min-colors 88) (background light)) + :background "#00c5c0") + (((class color) (min-colors 88) (background dark)) + :background "#009591") + (((class color) (min-colors 16) (background light)) + :background "#00c5c0") + (((class color) (min-colors 16) (background dark)) + :background "#009591") + (((class color)) + (:foreground "red3" :background "green")) + (t (:underline t :stipple "gray3"))) "Face for highlighting the refinement of the selected diff in the ancestor buffer. At present, this face is not used and no fine differences are computed for the ancestor buffer." @@ -1073,22 +1036,16 @@ this variable represents.") (t "Stipple"))) (defface ediff-even-diff-A - (if (featurep 'emacs) - `((((type pc)) - (:foreground "green3" :background "light grey")) - (((class color) (min-colors 88)) - (:background "light grey")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "red3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "red3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "green3" :background "light grey")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple ,stipple-pixmap)))) + `((((type pc)) + (:foreground "green3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) + (((class color) (min-colors 16)) + (:foreground "Black" :background "light grey")) + (((class color)) + (:foreground "red3" :background "light grey" + :weight bold)) + (t (:italic t :stipple ,stipple-pixmap))) "Face for highlighting even-numbered non-current differences in buffer A." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1101,17 +1058,13 @@ this variable represents.") (ediff-hide-face ediff-even-diff-face-A) (defface ediff-even-diff-B - (if (featurep 'emacs) - `((((class color) (min-colors 88)) - (:background "Grey")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "blue3" :background "Grey" :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "blue3" :background "Grey" :weight bold)) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple ,stipple-pixmap)))) + `((((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) + (:foreground "White" :background "Grey")) + (((class color)) + (:foreground "blue3" :background "Grey" :weight bold)) + (t (:italic t :stipple ,stipple-pixmap))) "Face for highlighting even-numbered non-current differences in buffer B." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1124,22 +1077,16 @@ this variable represents.") (ediff-hide-face ediff-even-diff-face-B) (defface ediff-even-diff-C - (if (featurep 'emacs) - `((((type pc)) - (:foreground "yellow3" :background "light grey")) - (((class color) (min-colors 88)) - (:background "light grey")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "yellow3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "yellow3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "yellow3" :background "light grey")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple ,stipple-pixmap)))) + `((((type pc)) + (:foreground "yellow3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) + (((class color) (min-colors 16)) + (:foreground "Black" :background "light grey")) + (((class color)) + (:foreground "yellow3" :background "light grey" + :weight bold)) + (t (:italic t :stipple ,stipple-pixmap))) "Face for highlighting even-numbered non-current differences in buffer C." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1152,22 +1099,16 @@ this variable represents.") (ediff-hide-face ediff-even-diff-face-C) (defface ediff-even-diff-Ancestor - (if (featurep 'emacs) - `((((type pc)) - (:foreground "cyan3" :background "light grey")) - (((class color) (min-colors 88)) - (:background "Grey")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "cyan3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "cyan3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "cyan3" :background "light grey")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple ,stipple-pixmap)))) + `((((type pc)) + (:foreground "cyan3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) + (:foreground "White" :background "Grey")) + (((class color)) + (:foreground "cyan3" :background "light grey" + :weight bold)) + (t (:italic t :stipple ,stipple-pixmap))) "Face for highlighting even-numbered non-current differences in the ancestor buffer." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1187,20 +1128,15 @@ this variable represents.") (Ancestor . ediff-even-diff-Ancestor))) (defface ediff-odd-diff-A - (if (featurep 'emacs) - '((((type pc)) - (:foreground "green3" :background "gray40")) - (((class color) (min-colors 88)) - (:background "Grey")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "red3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "red3" :background "black" :weight bold)) - (((type pc)) (:foreground "green3" :background "gray40")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple "gray1")))) + '((((type pc)) + (:foreground "green3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) + (:foreground "White" :background "Grey")) + (((class color)) + (:foreground "red3" :background "black" :weight bold)) + (t (:italic t :stipple "gray1"))) "Face for highlighting odd-numbered non-current differences in buffer A." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1214,20 +1150,15 @@ this variable represents.") (defface ediff-odd-diff-B - (if (featurep 'emacs) - '((((type pc)) - (:foreground "White" :background "gray40")) - (((class color) (min-colors 88)) - (:background "light grey")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "cyan3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "cyan3" :background "black" :weight bold)) - (((type pc)) (:foreground "White" :background "gray40")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple "gray1")))) + '((((type pc)) + (:foreground "White" :background "gray40")) + (((class color) (min-colors 88)) + (:background "light grey")) + (((class color) (min-colors 16)) + (:foreground "Black" :background "light grey")) + (((class color)) + (:foreground "cyan3" :background "black" :weight bold)) + (t (:italic t :stipple "gray1"))) "Face for highlighting odd-numbered non-current differences in buffer B." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1240,20 +1171,15 @@ this variable represents.") (ediff-hide-face ediff-odd-diff-face-B) (defface ediff-odd-diff-C - (if (featurep 'emacs) - '((((type pc)) - (:foreground "yellow3" :background "gray40")) - (((class color) (min-colors 88)) - (:background "Grey")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "yellow3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "yellow3" :background "black" :weight bold)) - (((type pc)) (:foreground "yellow3" :background "gray40")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple "gray1")))) + '((((type pc)) + (:foreground "yellow3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) + (:foreground "White" :background "Grey")) + (((class color)) + (:foreground "yellow3" :background "black" :weight bold)) + (t (:italic t :stipple "gray1"))) "Face for highlighting odd-numbered non-current differences in buffer C." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1266,17 +1192,13 @@ this variable represents.") (ediff-hide-face ediff-odd-diff-face-C) (defface ediff-odd-diff-Ancestor - (if (featurep 'emacs) - '((((class color) (min-colors 88)) - (:background "gray40")) - (((class color) (min-colors 16)) - (:foreground "cyan3" :background "gray40")) - (((class color)) - (:foreground "green3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "green3" :background "black" :weight bold)) - (((class color)) (:foreground "cyan3" :background "gray40")) - (t (:italic t :stipple "gray1")))) + '((((class color) (min-colors 88)) + (:background "gray40")) + (((class color) (min-colors 16)) + (:foreground "cyan3" :background "gray40")) + (((class color)) + (:foreground "green3" :background "black" :weight bold)) + (t (:italic t :stipple "gray1"))) "Face for highlighting odd-numbered non-current differences in the ancestor buffer." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, @@ -1778,24 +1700,8 @@ Unless optional argument INPLACE is non-nil, return a new string." (convert-standard-filename fname) fname)) -(if (featurep 'emacs) - (defalias 'ediff-with-syntax-table 'with-syntax-table) - (if (fboundp 'with-syntax-table) - (defalias 'ediff-with-syntax-table 'with-syntax-table) - ;; stolen from subr.el in emacs 21 - (defmacro ediff-with-syntax-table (table &rest body) - (let ((old-table (make-symbol "table")) - (old-buffer (make-symbol "buffer"))) - `(let ((,old-table (syntax-table)) - (,old-buffer (current-buffer))) - (unwind-protect - (progn - (set-syntax-table (copy-syntax-table ,table)) - ,@body) - (save-current-buffer - (set-buffer ,old-buffer) - (set-syntax-table ,old-table)))))))) - +(define-obsolete-function-alias 'ediff-with-syntax-table + #'with-syntax-table "27.1") (provide 'ediff-init) ;;; ediff-init.el ends here diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 66d14e6b06..3a869bff3e 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -154,8 +154,7 @@ Useful commands (type ? to hide them and free up screen): (define-key map "\C-?" 'previous-line) (define-key map "p" 'previous-line) (define-key map "C" 'ediff-dir-diff-copy-file) - (define-key map (if (featurep 'emacs) [mouse-2] [button2]) - 'ediff-dir-diff-copy-file) + (define-key map [mouse-2] 'ediff-dir-diff-copy-file) (define-key map [delete] 'previous-line) (define-key map [backspace] 'previous-line) map) @@ -433,9 +432,7 @@ Toggled by ediff-toggle-verbose-help-meta-buffer" ) (if ediff-no-emacs-help-in-control-buffer (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item)) - (if (featurep 'emacs) - (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function) - (define-key ediff-meta-buffer-map [button2] ediff-meta-action-function)) + (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function) (use-local-map ediff-meta-buffer-map) ;; modify ediff-meta-buffer-map here @@ -1542,9 +1539,7 @@ Useful commands: (defun ediff-set-meta-overlay (b e prop &optional session-number hidden) (let (overl) (setq overl (ediff-make-overlay b e)) - (if (featurep 'emacs) - (ediff-overlay-put overl 'mouse-face 'highlight) - (ediff-overlay-put overl 'highlight t)) + (ediff-overlay-put overl 'mouse-face 'highlight) (ediff-overlay-put overl 'ediff-meta-info prop) (ediff-overlay-put overl 'invisible hidden) (ediff-overlay-put overl 'follow-link t) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index ee6631dc3a..6b2f023a22 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -126,8 +126,7 @@ to invocation.") (setq ediff-mode-map (make-sparse-keymap)) (suppress-keymap ediff-mode-map) - (define-key ediff-mode-map - (if (featurep 'emacs) [mouse-2] [button2]) 'ediff-help-for-quick-help) + (define-key ediff-mode-map [mouse-2] 'ediff-help-for-quick-help) (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help) (define-key ediff-mode-map "p" 'ediff-previous-difference) @@ -1267,8 +1266,7 @@ This is especially useful when comparing buffers side-by-side." (interactive) (ediff-barf-if-not-control-buffer) (or (ediff-window-display-p) - (user-error "%sEmacs is not running as a window application" - (if (featurep 'emacs) "" "X"))) + (user-error "Emacs is not running as a window application")) (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows (let ((ctl-buf ediff-control-buffer)) (setq ediff-wide-display-p (not ediff-wide-display-p)) @@ -1297,8 +1295,7 @@ which see." (interactive) (let (window-setup-func) (or (ediff-window-display-p) - (user-error "%sEmacs is not running as a window application" - (if (featurep 'emacs) "" "X"))) + (user-error "Emacs is not running as a window application")) (cond ((eq ediff-window-setup-function #'ediff-setup-windows-multiframe) (setq ediff-multiframe nil) @@ -1344,8 +1341,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." (if (featurep 'ediff-tbar) (progn (or (ediff-window-display-p) - (user-error "%sEmacs is not running as a window application" - (if (featurep 'emacs) "" "X"))) + (user-error "Emacs is not running as a window application")) (if (ediff-use-toolbar-p) (ediff-kill-bottom-toolbar)) ;; do this only after killing the toolbar @@ -2562,10 +2558,7 @@ temporarily reverses the meaning of this variable." (cond ((ediff-good-frame-under-mouse)) (t warp-frame))) (if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse) - (set-mouse-position (if (featurep 'emacs) - warp-frame - (frame-selected-window warp-frame)) - 2 1)) + (set-mouse-position warp-frame 2 1)) (mapc #'funcall after-quit-hook-internal) )) @@ -2576,14 +2569,11 @@ temporarily reverses the meaning of this variable." (let ((frame-or-win (car (mouse-position))) (buf-name "") frame obj-ok) - (setq obj-ok - (if (featurep 'emacs) - (frame-live-p frame-or-win) - (window-live-p frame-or-win))) + (setq obj-ok (frame-live-p frame-or-win)) (if obj-ok - (setq frame (if (featurep 'emacs) frame-or-win (window-frame frame-or-win)) + (setq frame frame-or-win buf-name - (buffer-name (window-buffer (frame-selected-window frame))))) + (buffer-name (window-buffer (frame-selected-window frame))))) (if (string-match "Minibuf" buf-name) nil frame))) @@ -3830,8 +3820,7 @@ Ediff Control Panel to restore highlighting." (make-overlay beg end buff nil 'rear-advance))) ;; never detach - (ediff-overlay-put - overl (if (featurep 'emacs) 'evaporate 'detachable) nil) + (ediff-overlay-put overl 'evaporate nil) ;; make overlay open-ended ;; In emacs, it is made open ended at creation time (when (featurep 'xemacs) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index d4a60a16df..7ca3941a37 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -959,7 +959,7 @@ create a new splittable frame if none is found." ediff-control-frame ctl-frame) ;; protect against undefined face-attribute (condition-case nil - (if (and (featurep 'emacs) (face-attribute 'mode-line :box)) + (if (face-attribute 'mode-line :box) (set-face-attribute 'mode-line ctl-frame :box nil)) (error))) @@ -1257,18 +1257,11 @@ It assumes that it is called from within the control buffer." (defun ediff-refresh-control-frame () - (if (featurep 'emacs) - ;; set frame/icon titles for Emacs - (modify-frame-parameters - ediff-control-frame - (list (cons 'title (ediff-make-base-title)) - (cons 'icon-name (ediff-make-narrow-control-buffer-id)) - )) - ;; set frame/icon titles for XEmacs - (setq frame-title-format (ediff-make-base-title) - frame-icon-title-format (ediff-make-narrow-control-buffer-id)) - ;; force an update of the frame title - (modify-frame-parameters ediff-control-frame '(())))) + ;; Set frame/icon titles. + (modify-frame-parameters + ediff-control-frame + (list (cons 'title (ediff-make-base-title)) + (cons 'icon-name (ediff-make-narrow-control-buffer-id))))) (defun ediff-make-narrow-control-buffer-id (&optional skip-name) commit f1d9e41ab022358c5086227d5b267f3f35d27666 Author: Stefan Monnier Date: Fri Oct 4 08:56:18 2019 -0400 * lisp/subr.el (generate-new-buffer): Move (from files.el) before first use (with-temp-file, with-output-to-string): Use it. * lisp/files.el (generate-new-buffer): Move to subr.el. diff --git a/lisp/files.el b/lisp/files.el index 09180fd555..20bc204b06 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1934,11 +1934,6 @@ this function prepends a \"|\" to the final result if necessary." (concat "|" lastname) lastname)))) -(defun generate-new-buffer (name) - "Create and return a buffer with a name based on NAME. -Choose the buffer's name using `generate-new-buffer-name'." - (get-buffer-create (generate-new-buffer-name name))) - (defcustom automount-dir-prefix (purecopy "^/tmp_mnt/") "Regexp to match the automounter prefix in a directory name." :group 'files diff --git a/lisp/subr.el b/lisp/subr.el index fcfc396d14..985bdc6b71 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3415,6 +3415,11 @@ also `with-temp-buffer'." (when (window-live-p (nth 1 state)) (select-window (nth 1 state) 'norecord))) +(defun generate-new-buffer (name) + "Create and return a buffer with a name based on NAME. +Choose the buffer's name using `generate-new-buffer-name'." + (get-buffer-create (generate-new-buffer-name name))) + (defmacro with-selected-window (window &rest body) "Execute the forms in BODY with WINDOW as the selected window. The value returned is the value of the last form in BODY. @@ -3580,8 +3585,7 @@ See also `with-temp-buffer'." (let ((temp-file (make-symbol "temp-file")) (temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-file ,file) - (,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp file*")))) + (,temp-buffer (generate-new-buffer " *temp file*"))) (unwind-protect (prog1 (with-current-buffer ,temp-buffer @@ -3620,7 +3624,7 @@ See also `with-temp-file' and `with-output-to-string'." (declare (indent 0) (debug t)) (let ((temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-buffer (generate-new-buffer " *temp*"))) - ;; FIXME: kill-buffer can change current-buffer in some odd cases. + ;; `kill-buffer' can change current-buffer in some odd cases. (with-current-buffer ,temp-buffer (unwind-protect (progn ,@body) @@ -3654,8 +3658,7 @@ of that nature." (defmacro with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." (declare (indent 0) (debug t)) - `(let ((standard-output - (get-buffer-create (generate-new-buffer-name " *string-output*")))) + `(let ((standard-output (generate-new-buffer " *string-output*"))) (unwind-protect (progn (let ((standard-output standard-output)) commit 9a3089fea004e83992b6c4d05ecb7517b6c519ba Author: Dmitry Gutov Date: Fri Oct 4 15:50:16 2019 +0300 (project--vc-list-files): Optimize the Hg implementation * lisp/progmodes/project.el (project--vc-list-files): Optimize the Hg implementation. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2c0c32345d..ef2499030a 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -322,10 +322,9 @@ backend implementation of `project-external-roots'.") "\0" t)))) (`Hg (let ((default-directory (file-name-as-directory dir)) - args - files) + args) ;; Include unregistered. - (setq args (nconc args '("--all"))) + (setq args (nconc args '("-mcardu" "--no-status" "-0"))) (when extra-ignores (setq args (nconc args (mapcan @@ -333,13 +332,10 @@ backend implementation of `project-external-roots'.") (list "--exclude" i)) extra-ignores)))) (with-temp-buffer - (apply #'vc-hg-command t 0 "." - "status" args) - (goto-char (point-min)) - (while (re-search-forward "^[?C]\s+\\(.*\\)$" nil t) - (setq files (cons (concat dir (match-string 1)) - files)))) - (nreverse files))))) + (apply #'vc-hg-command t 0 "." "status" args) + (mapcar + (lambda (s) (concat dir s)) + (split-string (buffer-string) "\0" t))))))) (cl-defmethod project-ignores ((project (head vc)) dir) (let* ((root (cdr project)) commit 1039c2e2eb14d5016b9178aaa656c7d1759723d5 Author: Lars Ingebrigtsen Date: Fri Oct 4 14:44:34 2019 +0200 Remove some more XEmacs compat code from viper*.el * lisp/emulation/viper-ex.el (viper-ex-read-file-name): Ditto. * lisp/emulation/viper-init.el (viper-ms-style-os-p) (viper-has-face-support-p, viper-deactivate-input-method) (viper-activate-input-method, viper-set-input-method): Ditto. * lisp/emulation/viper-util.el (viper-get-saved-cursor-color-in-replace-mode) (viper-get-saved-cursor-color-in-insert-mode) (viper-get-saved-cursor-color-in-emacs-mode) (viper-set-replace-overlay, viper-key-to-emacs-key) (viper-set-unread-command-events): Ditto. * lisp/emulation/viper.el (viper-go-away, viper-set-hooks) (viper-non-hook-settings): Remove XEmacs compat code. diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 26bca686cb..6df6a55b4c 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -1101,10 +1101,7 @@ reversed." (copy-keymap minibuffer-local-completion-map)) beg end cont val) - (viper-add-keymap ex-read-filename-map - (if (featurep 'emacs) - minibuffer-local-completion-map - read-file-name-map)) + (viper-add-keymap ex-read-filename-map minibuffer-local-completion-map) (setq cont (setq viper-keep-reading-filename t)) (while cont diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 5a80804e75..ea041564cc 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -62,9 +62,7 @@ (defun viper-window-display-p () (and (viper-device-type) (not (memq (viper-device-type) '(tty stream pc))))) -(defcustom viper-ms-style-os-p - (memq system-type (if (featurep 'emacs) '(ms-dos windows-nt) - '(ms-dos windows-nt windows-95))) +(defcustom viper-ms-style-os-p (memq system-type '(ms-dos windows-nt)) "Non-nil if Emacs is running under an MS-style OS: MS-DOS, or MS-Windows." :type 'boolean :tag "Is it Microsoft-made OS?" @@ -89,8 +87,7 @@ In all likelihood, you don't need to bother with this setting." (cond ((viper-window-display-p)) (viper-force-faces) ((viper-color-display-p)) - ((featurep 'emacs) (memq (viper-device-type) '(pc))) - ((featurep 'xemacs) (memq (viper-device-type) '(tty pc))))) + (t (memq (viper-device-type) '(pc))))) ;;; Macros @@ -334,25 +331,12 @@ Use `\\[viper-set-expert-level]' to change this.") (or current-input-method default-input-method)) ""))))) -(defun viper-deactivate-input-method () - (cond ((and (featurep 'emacs) (fboundp 'deactivate-input-method)) - (deactivate-input-method)) - ((and (featurep 'xemacs) (boundp 'current-input-method)) - ;; XEmacs had broken quail-mode for some time, so we are working around - ;; it here - (setq quail-mode nil) - (if (featurep 'quail) - (quail-delete-overlays)) - (setq describe-current-input-method-function nil) - (setq current-input-method nil) - (run-hooks 'input-method-deactivate-hook) - (force-mode-line-update)) - )) +(define-obsolete-function-alias 'viper-deactivate-input-method + #'deactivate-input-method "27.1") + (defun viper-activate-input-method () - (cond ((and (featurep 'emacs) (fboundp 'activate-input-method)) - (activate-input-method default-input-method)) - ((featurep 'xemacs) - (if (fboundp 'quail-mode) (quail-mode 1))))) + (declare (obsolete activate-input-method "27.1")) + (activate-input-method default-input-method)) ;; Set quail-mode to ARG (defun viper-set-input-method (arg) @@ -360,10 +344,9 @@ Use `\\[viper-set-expert-level]' to change this.") (let (viper-mule-hook-flag) ; temporarily deactivate viper mule hooks (cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method) ;; activate input method - (viper-activate-input-method)) + (activate-input-method default-input-method)) (t ; deactivate input method - (viper-deactivate-input-method))) - )) + (deactivate-input-method))))) ;; VI-style Undo diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 1d7bb1580c..046cee9912 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -166,30 +166,21 @@ Otherwise return the normal value." (defun viper-get-saved-cursor-color-in-replace-mode () (or - (funcall - (if (featurep 'emacs) 'frame-parameter 'frame-property) - (selected-frame) - 'viper-saved-cursor-color-in-replace-mode) + (frame-parameter (selected-frame) 'viper-saved-cursor-color-in-replace-mode) (or (and (eq viper-current-state 'emacs-mode) (viper-frame-value viper-emacs-state-cursor-color)) (viper-frame-value viper-vi-state-cursor-color)))) (defun viper-get-saved-cursor-color-in-insert-mode () (or - (funcall - (if (featurep 'emacs) 'frame-parameter 'frame-property) - (selected-frame) - 'viper-saved-cursor-color-in-insert-mode) + (frame-parameter (selected-frame) 'viper-saved-cursor-color-in-insert-mode) (or (and (eq viper-current-state 'emacs-mode) (viper-frame-value viper-emacs-state-cursor-color)) (viper-frame-value viper-vi-state-cursor-color)))) (defun viper-get-saved-cursor-color-in-emacs-mode () (or - (funcall - (if (featurep 'emacs) 'frame-parameter 'frame-property) - (selected-frame) - 'viper-saved-cursor-color-in-emacs-mode) + (frame-parameter (selected-frame) 'viper-saved-cursor-color-in-emacs-mode) (viper-frame-value viper-vi-state-cursor-color))) ;; restore cursor color from replace overlay @@ -738,8 +729,7 @@ Otherwise return the normal value." (viper-move-replace-overlay beg end) (setq viper-replace-overlay (make-overlay beg end (current-buffer))) ;; never detach - (overlay-put - viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil) + (overlay-put viper-replace-overlay 'evaporate nil) (overlay-put viper-replace-overlay 'priority viper-replace-overlay-priority) ;; If Emacs will start supporting overlay maps, as it currently supports @@ -939,10 +929,10 @@ Otherwise return the normal value." (string-to-char key-name)) ;; Emacs doesn't recognize `return' and `escape' as events on ;; dumb terminals, so we translate them into characters - ((and (featurep 'emacs) (not (viper-window-display-p)) + ((and (not (viper-window-display-p)) (string= key-name "return")) ?\C-m) - ((and (featurep 'emacs) (not (viper-window-display-p)) + ((and (not (viper-window-display-p)) (string= key-name "escape")) ?\e) ;; pass symbol-event as is @@ -978,41 +968,28 @@ Otherwise return the normal value." (define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1") -;; Smooths out the difference between Emacs's unread-command-events -;; and XEmacs unread-command-event. Arg is a character, an event, a list of -;; events or a sequence of keys. +;; Arg is a character, an event, a list of events or a sequence of +;; keys. ;; -;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event -;; symbol in unread-command-events list may cause Emacs to turn this symbol -;; into an event. Below, we delete nil from event lists, since nil is the most -;; common symbol that might appear in this wrong context. +;; Due to the way unread-command-events works in Emacs, a non-event +;; symbol in unread-command-events list may cause Emacs to turn this +;; symbol into an event. Below, we delete nil from event lists, since +;; nil is the most common symbol that might appear in this wrong +;; context. (defun viper-set-unread-command-events (arg) - (if (featurep 'emacs) - (setq - unread-command-events - (let ((new-events - (cond ((eventp arg) (list arg)) - ((listp arg) arg) - ((sequencep arg) - (listify-key-sequence arg)) - (t (error - "viper-set-unread-command-events: Invalid argument, %S" - arg))))) - (if (not (eventp nil)) - (setq new-events (delq nil new-events))) - (append new-events unread-command-events))) - ;; XEmacs - (setq - unread-command-events - (append - (cond ((characterp arg) (list (character-to-event arg))) - ((eventp arg) (list arg)) - ((stringp arg) (mapcar 'character-to-event arg)) - ((vectorp arg) (append arg nil)) ; turn into list - ((listp arg) nil) - (t (error - "viper-set-unread-command-events: Invalid argument, %S" arg))) - unread-command-events)))) + (setq + unread-command-events + (let ((new-events + (cond ((eventp arg) (list arg)) + ((listp arg) arg) + ((sequencep arg) + (listify-key-sequence arg)) + (t (error + "viper-set-unread-command-events: Invalid argument, %S" + arg))))) + (if (not (eventp nil)) + (setq new-events (delq nil new-events))) + (append new-events unread-command-events)))) ;; Check if vec is a vector of key-press events representing characters diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 0f5c92c2c9..7297d99886 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -689,11 +689,10 @@ It also can't undo some Viper settings." (viper-standard-value 'major-mode viper-saved-non-viper-variables)) - (if (featurep 'emacs) - (setq-default - mark-even-if-inactive - (viper-standard-value - 'mark-even-if-inactive viper-saved-non-viper-variables))) + (setq-default + mark-even-if-inactive + (viper-standard-value + 'mark-even-if-inactive viper-saved-non-viper-variables)) ;; Ideally, we would like to be able to de-localize local variables (unless @@ -1018,7 +1017,7 @@ Two differences: (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) + (deactivate-input-method) (apply orig-fun args)))) ) ; viper-set-hooks @@ -1035,8 +1034,7 @@ Two differences: require-final-newline t) ;; don't bark when mark is inactive - (if (featurep 'emacs) - (setq mark-even-if-inactive t)) + (setq mark-even-if-inactive t) (setq scroll-step 1) @@ -1134,9 +1132,7 @@ These two lines must come in the order given.")) (cons 'mode-line-buffer-identification (list (default-value 'mode-line-buffer-identification))) (cons 'global-mode-string (list global-mode-string)) - (if (featurep 'emacs) - (cons 'mark-even-if-inactive (list mark-even-if-inactive))) - ))) + (cons 'mark-even-if-inactive (list mark-even-if-inactive))))) ;; Set some useful macros, advices commit 07959a0ffbb585931d1d62c266e83d79931cc561 Author: Lars Ingebrigtsen Date: Fri Oct 4 14:29:58 2019 +0200 Remove more XEmacs compat code from viper-*.el * lisp/emulation/viper-cmd.el (viper-special-read-and-insert-char) (viper-next-line-carefully, viper-next-line) (viper-previous-line): Ditto. * lisp/emulation/viper-mous.el (viper-surrounding-word) (viper-parse-mouse-key): Remove XEmacs compat code. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index bdb205ce7c..f193c4273b 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -789,7 +789,6 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to viper-emacs-kbd-minor-mode ch) (cond ((and viper-special-input-method - (featurep 'emacs) (fboundp 'quail-input-method)) ;; (let ...) is used to restore unread-command-events to the ;; original state. We don't want anything left in there after @@ -2594,9 +2593,8 @@ On reaching beginning of line, stop and signal error." (condition-case nil ;; do not use forward-line! need to keep column (let ((line-move-visual nil)) - (if (featurep 'emacs) - (with-no-warnings (next-line arg)) - (next-line arg))) + (with-no-warnings + (next-line arg))) (error nil))) @@ -2886,9 +2884,8 @@ On reaching beginning of line, stop and signal error." (if com (viper-move-marker-locally 'viper-com-point (point))) ;; do not use forward-line! need to keep column (let ((line-move-visual nil)) - (if (featurep 'emacs) - (with-no-warnings (next-line val)) - (next-line val))) + (with-no-warnings + (next-line val))) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'next-line) @@ -2934,9 +2931,8 @@ If point is on a widget or a button, simulate clicking on that widget/button." (if com (viper-move-marker-locally 'viper-com-point (point))) ;; do not use forward-line! need to keep column (let ((line-move-visual nil)) - (if (featurep 'emacs) - (with-no-warnings (previous-line val)) - (previous-line val))) + (with-no-warnings + (previous-line val))) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'previous-line) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index e1f7c1643b..e076e98886 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -214,10 +214,8 @@ is ignored." ) ; if ;; XEmacs doesn't have set-text-properties, but there buffer-substring ;; doesn't return properties together with the string, so it's not needed. - (if (featurep 'emacs) - (set-text-properties 0 (length result) nil result)) - result - )) + (set-text-properties 0 (length result) nil result) + result)) (defun viper-mouse-click-get-word (click count click-count) @@ -493,49 +491,27 @@ bindings in the Viper manual." () (setq button-spec (cond ((memq 1 key) - (if (featurep 'emacs) - (if (eq 'up event-type) - "mouse-1" "down-mouse-1") - (if (eq 'up event-type) - 'button1up 'button1))) + (if (eq 'up event-type) + "mouse-1" "down-mouse-1")) ((memq 2 key) - (if (featurep 'emacs) - (if (eq 'up event-type) - "mouse-2" "down-mouse-2") - (if (eq 'up event-type) - 'button2up 'button2))) + (if (eq 'up event-type) + "mouse-2" "down-mouse-2")) ((memq 3 key) - (if (featurep 'emacs) - (if (eq 'up event-type) - "mouse-3" "down-mouse-3") - (if (eq 'up event-type) - 'button3up 'button3))) + (if (eq 'up event-type) + "mouse-3" "down-mouse-3")) (t (error "%S: invalid button number, %S" key-var key))) meta-spec - (if (memq 'meta key) - (if (featurep 'emacs) "M-" 'meta) - (if (featurep 'emacs) "" nil)) + (if (memq 'meta key) "M-" "") shift-spec - (if (memq 'shift key) - (if (featurep 'emacs) "S-" 'shift) - (if (featurep 'emacs) "" nil)) + (if (memq 'shift key) "S-" "") control-spec - (if (memq 'control key) - (if (featurep 'emacs) "C-" 'control) - (if (featurep 'emacs) "" nil))) - - (setq key-spec (if (featurep 'emacs) - (vector - (intern - (concat - control-spec meta-spec shift-spec button-spec))) - (vector - (delq - nil - (list - control-spec meta-spec shift-spec button-spec))))) - ))) + (if (memq 'control key) "C-" "")) + + (setq key-spec + (vector + (intern (concat control-spec meta-spec + shift-spec button-spec))))))) (defun viper-unbind-mouse-search-key () (if viper-mouse-up-search-key-parsed commit 7174a2b59f4cb883beb70bb3d182d59ab425e2f1 Author: Lars Ingebrigtsen Date: Fri Oct 4 14:25:17 2019 +0200 Remove XEmacs-only code from snake.el * lisp/play/snake.el (snake-mode): Remove XEmacs-only code. diff --git a/lisp/play/snake.el b/lisp/play/snake.el index d0f9457906..2769a621a4 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -368,17 +368,6 @@ Argument SNAKE-BUFFER is the name of the buffer." (use-local-map snake-null-map) - (unless (featurep 'emacs) - (setq mode-popup-menu - '("Snake Commands" - ["Start new game" snake-start-game] - ["End game" snake-end-game - (snake-active-p)] - ["Pause" snake-pause-game - (and (snake-active-p) (not snake-paused))] - ["Resume" snake-pause-game - (and (snake-active-p) snake-paused)]))) - (setq gamegrid-use-glyphs snake-use-glyphs-flag) (setq gamegrid-use-color snake-use-color-flag) commit 68b91333d5a070c84afeadc273fd5c44df70f0a6 Author: Lars Ingebrigtsen Date: Fri Oct 4 14:24:36 2019 +0200 Remove XEmacs code from tetris.el * lisp/play/tetris.el (tetris-mode): Remove XEmacs-only code. diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index a797a26d59..a8fa7b7586 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -599,17 +599,6 @@ Drops the shape one square, testing for collision." (use-local-map tetris-null-map) - (unless (featurep 'emacs) - (setq mode-popup-menu - '("Tetris Commands" - ["Start new game" tetris-start-game] - ["End game" tetris-end-game - (tetris-active-p)] - ["Pause" tetris-pause-game - (and (tetris-active-p) (not tetris-paused))] - ["Resume" tetris-pause-game - (and (tetris-active-p) tetris-paused)]))) - (setq show-trailing-whitespace nil) (setq gamegrid-use-glyphs tetris-use-glyphs) commit 280bdc06cefa6e72e91c9da362770452d9bbbbd4 Author: Lars Ingebrigtsen Date: Fri Oct 4 14:22:41 2019 +0200 Remove XEmacs compat code from idlw-shell.el * lisp/progmodes/idlw-shell.el (idlwave-shell-make-temp-file): Make into obsolete alias. (idlwave-shell-temp-file): Adjust callers. diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index e4f46bf882..dde51b355e 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -577,38 +577,17 @@ TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or ((eq type 'rinfo) (or idlwave-shell-temp-rinfo-save-file (setq idlwave-shell-temp-rinfo-save-file - (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix)))) + (make-temp-file idlwave-shell-temp-pro-prefix)))) ((eq type 'pro) (or idlwave-shell-temp-pro-file (setq idlwave-shell-temp-pro-file - (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix)))) + (make-temp-file idlwave-shell-temp-pro-prefix)))) (t (error "Wrong argument (idlwave-shell-temp-file): %s" (symbol-name type))))) -(defun idlwave-shell-make-temp-file (prefix) - "Create a temporary file." - (if (featurep 'emacs) - (make-temp-file prefix) - (if (fboundp 'make-temp-file) - (make-temp-file prefix) - (let (file - (temp-file-dir (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp"))) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temp-file-dir))) - (write-region "" nil file nil 'silent nil 'excl) - 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) - file)))) - +(define-obsolete-function-alias 'idlwave-shell-make-temp-file + #'make-temp-file "27.1") (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" "Command used by `idlwave-shell-resync-dirs' to query IDL for commit 4df55f8f2fc5f73dec77582a03f1cc3c849c4836 Author: Juanma Barranquero Date: Fri Oct 4 14:02:13 2019 +0200 Revert "Improve docstrings auto-generated by `define-minor-mode'" This reverts commit a397fa06d18d6ae37a3a1288f269e1ae9eb3b569. The original change breaks bootstrapping because of a circular dependency. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 6d5b5141aa..5e7b29eddf 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -95,17 +95,11 @@ if ARG is `toggle'; disable the mode otherwise.") \\{%s}" mode-pretty-name keymap-sym)))) (if (string-match-p "\\bARG\\b" doc) doc - (let* ((fill-prefix nil) - (docstring-fc (bound-and-true-p emacs-lisp-docstring-fill-column)) - (fill-column (if (integerp docstring-fc) docstring-fc 65)) - (argdoc (format easy-mmode--arg-docstring - mode-pretty-name))) - (with-temp-buffer - (insert (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" - (concat argdoc "\\1") - doc nil nil 1)) - (fill-region (point-min) (point-max) 'left t) - (buffer-string)))))) + (let ((argdoc (format easy-mmode--arg-docstring + mode-pretty-name))) + (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" + (concat argdoc "\\1") + doc nil nil 1))))) ;;;###autoload (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) commit d8c2da46e7e51a11882dabd593af29f4146aa0b3 Author: Dmitry Gutov Date: Fri Oct 4 11:29:49 2019 +0300 ; Fix reported warnings diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2cf11afc36..2c0c32345d 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -295,6 +295,10 @@ backend implementation of `project-external-roots'.") (project--dir-ignores project dir))))) (or dirs (project-roots project)))) +(declare-function vc-git--program-version "vc-git") +(declare-function vc-git--run-command-string "vc-git") +(declare-function vc-hg-command "vc-hg") + (defun project--vc-list-files (dir backend extra-ignores) (pcase backend (`Git @@ -327,7 +331,7 @@ backend implementation of `project-external-roots'.") (mapcan (lambda (i) (list "--exclude" i)) - (copy-list extra-ignores))))) + extra-ignores)))) (with-temp-buffer (apply #'vc-hg-command t 0 "." "status" args) commit 7844846e3fedac8f32f0d81d3c5e906715d39fd2 Author: Dmitry Gutov Date: Fri Oct 4 11:08:38 2019 +0300 Use file-name-as-directory * lisp/progmodes/project.el (project--vc-list-files): Use file-name-as-directory, to be on the safe side. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2304734bd2..2cf11afc36 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -298,7 +298,7 @@ backend implementation of `project-external-roots'.") (defun project--vc-list-files (dir backend extra-ignores) (pcase backend (`Git - (let ((default-directory dir) + (let ((default-directory (file-name-as-directory dir)) (args '("-z"))) ;; Include unregistered. (setq args (append args '("-c" "-o" "--exclude-standard"))) @@ -317,7 +317,7 @@ backend implementation of `project-external-roots'.") (apply #'vc-git--run-command-string nil "ls-files" args) "\0" t)))) (`Hg - (let ((default-directory dir) + (let ((default-directory (file-name-as-directory dir)) args files) ;; Include unregistered. commit 3886a5c140b03f07c8faea7cacad0a791bc54fa5 Author: Stefan Kangas Date: Fri Oct 4 01:54:56 2019 +0200 Remove more XEmacs compat code in cperl-mode.el * lisp/progmodes/cperl-mode.el (condition-case, cperl-problems) (cperl-problems-old-emaxen, cperl-init-faces) (cperl-word-at-point): Remove more XEmacs compat code. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8e94da082a..3c06d23095 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -89,9 +89,6 @@ (error nil)) (defvar msb-menu-cond) (defvar gud-perldb-history) - (defvar font-lock-background-mode) ; not in Emacs - (defvar font-lock-display-type) ; ditto - (defvar paren-backwards-message) ; Not in newer XEmacs? (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) `(find-face ,arg)) @@ -704,7 +701,7 @@ to detect it and bulk out). See documentation of a variable `cperl-problems-old-emaxen' for the problems which disappear if you upgrade Emacs to a reasonably new -version (20.3 for Emacs, and those of 2004 for XEmacs).") +version (20.3 for Emacs).") (defvar cperl-problems-old-emaxen 'please-ignore-this-line "Description of problems in CPerl mode specific for older Emacs versions. @@ -712,8 +709,7 @@ version (20.3 for Emacs, and those of 2004 for XEmacs).") Emacs had a _very_ restricted syntax parsing engine until version 20.1. Most problems below are corrected starting from this version of Emacs, and all of them should be fixed in version 20.3. (Or apply -patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in -this respect (until 2003). +patches to Emacs 19.33/34 - see tips.) Note that even with newer Emacsen in some very rare cases the details of interaction of `font-lock' and syntaxification may be not cleaned @@ -5897,8 +5893,6 @@ indentation and initial hashes. Behaves usually outside of comment." t nil)))) ;; Do it the dull way, without choose-color - (defvar cperl-guessed-background nil - "Display characteristics as guessed by cperl.") (cperl-force-face font-lock-constant-face "Face for constant and label names") (cperl-force-face font-lock-variable-name-face @@ -5927,19 +5921,6 @@ indentation and initial hashes. Behaves usually outside of comment." ;; (defconst cperl-nonoverridable-face ;; 'cperl-nonoverridable-face ;; "Face to use for data types from another group.")) - ;;(if (not (featurep 'xemacs)) nil - ;; (or (boundp 'font-lock-comment-face) - ;; (defconst font-lock-comment-face - ;; 'font-lock-comment-face - ;; "Face to use for comments.")) - ;; (or (boundp 'font-lock-keyword-face) - ;; (defconst font-lock-keyword-face - ;; 'font-lock-keyword-face - ;; "Face to use for keywords.")) - ;; (or (boundp 'font-lock-function-name-face) - ;; (defconst font-lock-function-name-face - ;; 'font-lock-function-name-face - ;; "Face to use for function names."))) (if (and (not (cperl-is-face 'cperl-array-face)) (cperl-is-face 'font-lock-emphasized-face)) @@ -5960,17 +5941,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;; (defconst cperl-array-face ;; 'cperl-array-face ;; "Face to use for arrays.")) - ;; Here we try to guess background - (let ((background - (if (boundp 'font-lock-background-mode) - font-lock-background-mode - 'light))) - (defvar cperl-guessed-background - (if (and (boundp 'font-lock-display-type) - (eq font-lock-display-type 'grayscale)) - 'gray - background) - "Background as guessed by CPerl mode") + (let ((background 'light)) (and (not (cperl-is-face 'font-lock-constant-face)) (cperl-is-face 'font-lock-reference-face) (copy-face 'font-lock-reference-face 'font-lock-constant-face)) @@ -6400,8 +6371,6 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (funcall (or (and (boundp 'find-tag-default-function) find-tag-default-function) (get major-mode 'find-tag-default-function) - ;; XEmacs 19.12 has `find-tag-default-hook'; it is - ;; automatically used within `find-tag-default': 'find-tag-default)))))) (defun cperl-info-on-command (command) commit a397fa06d18d6ae37a3a1288f269e1ae9eb3b569 Author: Juanma Barranquero Date: Fri Oct 4 01:26:07 2019 +0200 Improve docstrings auto-generated by `define-minor-mode' * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): When using `easy-mmode--arg-docstring' to auto-generate a docstring, refill it up to `emacs-lisp-docstring-fill-column'. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 5e7b29eddf..6d5b5141aa 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -95,11 +95,17 @@ if ARG is `toggle'; disable the mode otherwise.") \\{%s}" mode-pretty-name keymap-sym)))) (if (string-match-p "\\bARG\\b" doc) doc - (let ((argdoc (format easy-mmode--arg-docstring - mode-pretty-name))) - (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" - (concat argdoc "\\1") - doc nil nil 1))))) + (let* ((fill-prefix nil) + (docstring-fc (bound-and-true-p emacs-lisp-docstring-fill-column)) + (fill-column (if (integerp docstring-fc) docstring-fc 65)) + (argdoc (format easy-mmode--arg-docstring + mode-pretty-name))) + (with-temp-buffer + (insert (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'" + (concat argdoc "\\1") + doc nil nil 1)) + (fill-region (point-min) (point-max) 'left t) + (buffer-string)))))) ;;;###autoload (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) commit 93dd959711222cf594051fa397d6a6e324e136fc Author: Stefan Kangas Date: Sun Sep 22 02:21:54 2019 +0200 More doc fixes in package.el (Bug#37544) * lisp/emacs-lisp/package.el (package-menu-hide-low-priority) (package-pinned-packages, package-load-descriptor) package-archive-version, package-archive-contents) package--read-archive-file, package-read-archive-contents) (package-unsigned-archives, package-read-all-archive-contents) (package--download-and-read-archives, package-install): * lisp/subr.el (package--description-file): * test/lisp/emacs-lisp/package-tests.el: Doc fixes. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ab1fb8b90f..188f398a56 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -36,7 +36,7 @@ ;; work.) ;; A package is described by its name and version. The distribution -;; format is either a tar file or a single .el file. +;; format is either a tar file or a single .el file. ;; A tar file should be named "NAME-VERSION.tar". The tar file must ;; unpack into a directory named after the package and version: @@ -160,6 +160,7 @@ ;;; Customization options + ;;;###autoload (defcustom package-enable-at-startup t "Whether to make installed packages available when Emacs starts. @@ -239,7 +240,7 @@ This variable has three possible values: t: both criteria are used. This variable has no effect if `package-menu--hide-packages' is -nil, so it can be toggled with \\ \\[package-menu-toggle-hiding]." +nil, so it can be toggled with \\\\[package-menu-toggle-hiding]." :type '(choice (const :tag "Don't hide anything" nil) (const :tag "Hide per package-archive-priorities" archive) @@ -282,8 +283,7 @@ they are ignored (for this package). If ARCHIVE does not contain PACKAGE, the package will be unavailable." :type '(alist :key-type (symbol :tag "Package") :value-type (string :tag "Archive name")) - ;; I don't really see why this is risky... - ;; I suppose it could prevent you receiving updates for a package, + ;; This could prevent you from receiving updates for a package, ;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue ;; if PACKAGE has a known vulnerability that is fixed in newer versions. :risky t @@ -368,7 +368,9 @@ value of variable `package-check-signature'." package-check-signature)) (defcustom package-unsigned-archives nil - "List of archives where we do not check for package signatures." + "List of archives where we do not check for package signatures. +This should be a list of strings matching the names of package +archives in the variable `package-archives'." :type '(repeat (string :tag "Archive name")) :risky t :version "24.4") @@ -403,6 +405,7 @@ synchronously." ;; user) it makes sense to take the package name as a symbol instead, ;; but keep in mind there could be multiple `package-desc's with the ;; same name. + (defvar package--default-summary "No description available.") (cl-defstruct (package-desc @@ -545,9 +548,9 @@ package." (nth 1 keywords) keywords))) -(defun package-desc-priority (p) - "Return the priority of the archive of package-desc object P." - (package-archive-priority (package-desc-archive p))) +(defun package-desc-priority (pkg-desc) + "Return the priority of the archive of package-desc object PKG-DESC." + (package-archive-priority (package-desc-archive pkg-desc))) (cl-defstruct (package--bi-desc (:constructor package-make-builtin (version summary)) @@ -564,6 +567,7 @@ package." ;; command `package-initialize' is also closely related to this ;; section, but it is left for a later section because it also affects ;; other stuff. + (defvar package--builtins nil "Alist of built-in packages. The actual value is initialized by loading the library @@ -591,6 +595,7 @@ loaded and/or activated, customize `package-load-list'.") (put 'package-activated-list 'risky-local-variable t) ;;;; Populating `package-alist'. + ;; The following functions are called on each installed package by ;; `package-load-all-descriptors', which ultimately populates the ;; `package-alist' variable. @@ -622,7 +627,9 @@ If there already exists a package by that name in new-pkg-desc))) (defun package-load-descriptor (pkg-dir) - "Load the description file in directory PKG-DIR." + "Load the package description file in directory PKG-DIR. +Create a new `package-desc' object, add it to `package-alist' and +return it." (let ((pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)) (signed-file (concat pkg-dir ".signed"))) @@ -679,6 +686,7 @@ EXTRA-PROPERTIES is currently unused." ;;; Package activation ;; Section for functions used by `package-activate', which see. + (defun package-disabled-p (pkg-name version) "Return whether PKG-NAME at VERSION can be activated. The decision is made according to `package-load-list'. @@ -1167,6 +1175,7 @@ The return result is a `package-desc'." ;;; Communicating with Archives ;; Set of low-level functions for communicating with archives and ;; signature checking. + (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name nil 'silent))) @@ -1193,6 +1202,8 @@ The return result is a `package-desc'." (declare-function epg-signature-to-string "epg" (signature)) (defun package--display-verify-error (context sig-file) + "Show error details with CONTEXT for failed verification of SIG-FILE. +The details are shown in a new buffer called \"*Error\"." (unless (equal (epg-context-error-output context) "") (with-output-to-temp-buffer "*Error*" (with-current-buffer standard-output @@ -1380,13 +1391,14 @@ else, even if an error is signaled." ;; function `package-read-all-archive-contents' from a cache on disk. ;; The `package-initialize' command is also closely related to this ;; section, but it has its own section. + (defconst package-archive-version 1 - "Version number of the package archive understood by this file. + "Version number of the package archive understood by package.el. Lower version numbers than this will probably be understood as well.") ;; We don't prime the cache since it tends to get out of date. (defvar package-archive-contents nil - "Cache of the contents of the Emacs Lisp Package Archive. + "Cache of the contents of all archives in `package-archives'. This is an alist mapping package names (symbols) to non-empty lists of `package-desc' structures.") (put 'package-archive-contents 'risky-local-variable t) @@ -1482,9 +1494,9 @@ Also, add the originating archive to the `package-desc' structure." (package--append-to-alist pkg-desc package-archive-contents))))) (defun package--read-archive-file (file) - "Re-read archive file FILE, if it exists. -Will return the data from the file, or nil if the file does not exist. -Will throw an error if the archive version is too new." + "Read cached archive FILE data, if it exists. +Return the data from the file, or nil if the file does not exist. +If the archive version is too new, signal an error." (let ((filename (expand-file-name file package-user-dir))) (when (file-exists-p filename) (with-temp-buffer @@ -1497,8 +1509,10 @@ Will throw an error if the archive version is too new." (cdr contents)))))) (defun package-read-archive-contents (archive) - "Re-read archive contents for ARCHIVE. -If successful, set the variable `package-archive-contents'. + "Read cached archive file for ARCHIVE. +If successful, set or update the variable `package-archive-contents'. +ARCHIVE should be a string matching the name of a package archive +in the variable `package-archives'. If the archive version is too new, signal an error." ;; Version 1 of 'archive-contents' is identical to our internal ;; representation. @@ -1516,8 +1530,8 @@ by arbitrary functions to decide whether it is necessary to call it again.") (defun package-read-all-archive-contents () - "Re-read `archive-contents', if it exists. -If successful, set `package-archive-contents'." + "Read cached archive file for all archives in `package-archives'. +If successful, set or update `package-archive-contents'." (setq package-archive-contents nil) (setq package--old-archive-priorities package-archive-priorities) (dolist (archive package-archives) @@ -1586,6 +1600,7 @@ The variable `package-load-list' controls which packages to load." ;;;; Populating `package-archive-contents' from archives ;; This subsection populates the variables listed above from the ;; actual archives, instead of from a local cache. + (defvar package--downloads-in-progress nil "List of in-progress asynchronous downloads.") @@ -1666,8 +1681,10 @@ similar to an entry in `package-alist'. Save the cached copy to (defun package--download-and-read-archives (&optional async) "Download descriptions of all `package-archives' and read them. -This populates `package-archive-contents'. If ASYNC is non-nil, -perform the downloads asynchronously." +Populate `package-archive-contents' with the result. + +If optional argument ASYNC is non-nil, perform the downloads +asynchronously." ;; The downloaded archive contents will be read as part of ;; `package--update-downloads-in-progress'. (dolist (archive package-archives) @@ -1705,6 +1722,7 @@ downloads in the background." ;; keeping track of which packages were installed strictly as ;; dependencies, and determining which packages cannot be removed ;; because they are dependencies. + (defun package-compute-transaction (packages requirements &optional seen) "Return a list of packages to be installed, including PACKAGES. PACKAGES should be a list of `package-desc'. @@ -2015,12 +2033,17 @@ using `package-compute-transaction'." ;;;###autoload (defun package-install (pkg &optional dont-select) "Install the package PKG. -PKG can be a `package-desc' or a symbol naming one of the available packages -in an archive in `package-archives'. Interactively, prompt for its name. +PKG can be a `package-desc' or a symbol naming one of the +available packages in an archive in `package-archives'. When +called interactively, prompt for the package name. -If called interactively or if DONT-SELECT nil, add PKG to +Mark the installed package as selected by adding it to `package-selected-packages'. +When called from Lisp and optional argument DONT-SELECT is +non-nil, install the package but do not add it to +`package-select-packages'. + If PKG is a `package-desc' and it is already installed, don't try to install it but still mark it as selected." (interactive @@ -2151,6 +2174,7 @@ If some packages are not installed propose to install them." ;;; Package Deletion + (defun package--newest-p (pkg) "Return non-nil if PKG is the newest package with its name." (equal (cadr (assq (package-desc-name pkg) package-alist)) @@ -3026,6 +3050,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ;;; Package menu faces + (defface package-name '((t :inherit link)) "Face used on package names in the package menu." @@ -3094,6 +3119,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ;;; Package menu printing + (defun package-menu--print-info-simple (pkg) "Return a package entry suitable for `tabulated-list-entries'. PKG is a `package-desc' object. diff --git a/lisp/subr.el b/lisp/subr.el index da619fef14..fcfc396d14 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5520,6 +5520,7 @@ NAME is the package name as a symbol, and VERSION is its version as a list.") (defun package--description-file (dir) + "Return package description file name for package DIR." (concat (let ((subdir (file-name-nondirectory (directory-file-name dir)))) (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index c757bccf67..f450fd27c2 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -28,7 +28,12 @@ ;; Run this in a clean Emacs session using: ;; -;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit +;; $ emacs -Q --batch -L . -l package-tests.el -l ert -f ert-run-tests-batch-and-exit +;; +;; From the top level directory of the Emacs development repository, +;; you can use this instead: +;; +;; $ make -C test package-tests ;;; Code: commit a750770ba0591b24303869fbb4b349f33165cb85 Author: Dmitry Gutov Date: Fri Oct 4 02:03:04 2019 +0300 Speed up project-files for Git projects * lisp/progmodes/project.el (project-files): New method. Implementation for VC projects that uses 'git ls-files' or 'hg status --all' for listing. With gratitude to Tassilo Horn who has done most of the legwork and wrote the first version of the code (https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00069.html). (project--vc-list-files): New function, to be used by the above. (project--find-regexp-in-files): Silence warnings about nonexistent files. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4693d07fa8..2304734bd2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -277,6 +277,66 @@ backend implementation of `project-external-roots'.") (funcall project-vc-external-roots-function))) (project-roots project))) +(cl-defmethod project-files ((project (head vc)) &optional dirs) + (cl-mapcan + (lambda (dir) + (let (backend) + (if (and (file-equal-p dir (cdr project)) + (setq backend (vc-responsible-backend dir)) + (cond + ((eq backend 'Hg)) + ((and (eq backend 'Git) + (or + (not project-vc-ignores) + (version<= "1.9" (vc-git--program-version))))))) + (project--vc-list-files dir backend project-vc-ignores) + (project--files-in-directory + dir + (project--dir-ignores project dir))))) + (or dirs (project-roots project)))) + +(defun project--vc-list-files (dir backend extra-ignores) + (pcase backend + (`Git + (let ((default-directory dir) + (args '("-z"))) + ;; Include unregistered. + (setq args (append args '("-c" "-o" "--exclude-standard"))) + (when extra-ignores + (setq args (append args + (cons "--" + (mapcar + (lambda (i) + (if (string-match "\\./" i) + (format ":!/:%s" (substring i 2)) + (format ":!:%s" i))) + extra-ignores))))) + (mapcar + (lambda (file) (concat dir file)) + (split-string + (apply #'vc-git--run-command-string nil "ls-files" args) + "\0" t)))) + (`Hg + (let ((default-directory dir) + args + files) + ;; Include unregistered. + (setq args (nconc args '("--all"))) + (when extra-ignores + (setq args (nconc args + (mapcan + (lambda (i) + (list "--exclude" i)) + (copy-list extra-ignores))))) + (with-temp-buffer + (apply #'vc-hg-command t 0 "." + "status" args) + (goto-char (point-min)) + (while (re-search-forward "^[?C]\s+\\(.*\\)$" nil t) + (setq files (cons (concat dir (match-string 1)) + files)))) + (nreverse files))))) + (cl-defmethod project-ignores ((project (head vc)) dir) (let* ((root (cdr project)) backend) @@ -391,7 +451,8 @@ pattern to search for." (status nil) (hits nil) (xrefs nil) - (command (format "xargs -0 grep %s -nHE -e %s" + ;; 'git ls-files' can output broken symlinks. + (command (format "xargs -0 grep %s -snHE -e %s" (if (and case-fold-search (isearch-no-upper-case-p regexp t)) "-i" commit 0fc8177414801e428ca184e8a9ba8b79a291c15a Author: Basil L. Contovounesios Date: Fri Sep 27 00:04:33 2019 +0100 Further improve button.el support for help-echo The last change to forward-button added support for help-echo values that are functions. This patch fixes the arguments passed to such functions and further adds support for help-echo values that are forms (bug#37515). * doc/lispref/display.texi (Button Properties): Fix description of help-echo button property. * lisp/button.el (button--help-echo): New function. (forward-button): Use it. (backward-button): Clarify help-echo reference in docstring. * test/lisp/button-tests.el (button--help-echo-string) (button--help-echo-form, button--help-echo-function): New tests. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 494bf0d3f7..61bd4ce883 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6607,14 +6607,23 @@ in the variable @code{button-map}, which defines @key{RET} and The button type. @xref{Button Types}. @item help-echo -@kindex help-index @r{(button property)} -A string displayed by the Emacs tool-tip help system; by default, -@code{"mouse-2, RET: Push this button"}. +@kindex help-echo @r{(button property)} +A string displayed by the Emacs tooltip help system; by default, +@code{"mouse-2, RET: Push this button"}. Alternatively, a function +that returns, or a form that evaluates to, a string to be displayed or +@code{nil}. For details see @ref{Text help-echo}. + +The function is called with three arguments, @var{window}, +@var{object}, and @var{pos}. The second argument, @var{object}, is +either the overlay that had the property (for overlay buttons), or the +buffer containing the button (for text property buttons). The other +arguments have the same meaning as for the special text property +@code{help-echo}. @item follow-link @kindex follow-link @r{(button property)} -The follow-link property, defining how a @key{mouse-1} click behaves -on this button, @xref{Clickable Text}. +The @code{follow-link} property, defining how a @key{mouse-1} click +behaves on this button, @xref{Clickable Text}. @item button @kindex button @r{(button property)} diff --git a/lisp/button.el b/lisp/button.el index 32efc2f95b..04e77ca904 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -467,13 +467,22 @@ return t." (button-activate button use-mouse-action) t)))) +(defun button--help-echo (button) + "Evaluate BUTTON's `help-echo' property and return its value." + (let ((help (button-get button 'help-echo))) + (if (functionp help) + (let ((obj (if (overlayp button) button (current-buffer)))) + (funcall help (selected-window) obj (button-start button))) + (eval help lexical-binding)))) + (defun forward-button (n &optional wrap display-message no-error) "Move to the Nth next button, or Nth previous button if N is negative. If N is 0, move to the start of any button at point. If WRAP is non-nil, moving past either end of the buffer continues from the other end. -If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed. -Any button with a non-nil `skip' property is skipped over. +If DISPLAY-MESSAGE is non-nil, the button's `help-echo' property +is displayed. Any button with a non-nil `skip' property is +skipped over. If NO-ERROR, return nil if no further buttons could be found instead of erroring out. @@ -506,13 +515,9 @@ Returns the button found." (unless (button-get button 'skip) (setq n (1- n))))))) (if (null button) - (if no-error - nil + (unless no-error (user-error (if wrap "No buttons!" "No more buttons"))) - (let ((msg (and display-message (button-get button 'help-echo)))) - (when (functionp msg) - (setq msg (funcall msg (selected-window) (current-buffer) - (button-start button)))) + (let ((msg (and display-message (button--help-echo button)))) (when msg (message "%s" msg))) button))) @@ -522,8 +527,9 @@ Returns the button found." If N is 0, move to the start of any button at point. If WRAP is non-nil, moving past either end of the buffer continues from the other end. -If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed. -Any button with a non-nil `skip' property is skipped over. +If DISPLAY-MESSAGE is non-nil, the button's `help-echo' property +is displayed. Any button with a non-nil `skip' property is +skipped over. If NO-ERROR, return nil if no further buttons could be found instead of erroring out. diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el index d54a992ab8..44a7ea6f6e 100644 --- a/test/lisp/button-tests.el +++ b/test/lisp/button-tests.el @@ -37,4 +37,60 @@ (widget-create 'link "link widget") (should-not (button-at (1- (point)))))) +(ert-deftest button--help-echo-string () + "Test `button--help-echo' with strings." + (with-temp-buffer + ;; Text property buttons. + (let ((button (insert-text-button "text" 'help-echo "text help"))) + (should (equal (button--help-echo button) "text help"))) + ;; Overlay buttons. + (let ((button (insert-button "overlay" 'help-echo "overlay help"))) + (should (equal (button--help-echo button) "overlay help"))))) + +(ert-deftest button--help-echo-form () + "Test `button--help-echo' with forms." + (with-temp-buffer + ;; Test text property buttons with dynamic scoping. + (let* ((help (make-symbol "help")) + (form `(funcall (let ((,help "lexical form")) + (lambda () ,help)))) + (button (insert-text-button "text" 'help-echo form))) + (set help "dynamic form") + (should (equal (button--help-echo button) "dynamic form"))) + ;; Test overlay buttons with lexical scoping. + (setq lexical-binding t) + (let* ((help (make-symbol "help")) + (form `(funcall (let ((,help "lexical form")) + (lambda () ,help)))) + (button (insert-button "overlay" 'help-echo form))) + (set help "dynamic form") + (should (equal (button--help-echo button) "lexical form"))))) + +(ert-deftest button--help-echo-function () + "Test `button--help-echo' with functions." + (with-temp-buffer + ;; Text property buttons. + (let* ((owin (selected-window)) + (obuf (current-buffer)) + (opos (point)) + (help (lambda (win obj pos) + (should (eq win owin)) + (should (eq obj obuf)) + (should (= pos opos)) + "text function")) + (button (insert-text-button "text" 'help-echo help))) + (should (equal (button--help-echo button) "text function")) + ;; Overlay buttons. + (setq help (lambda (win obj pos) + (should (eq win owin)) + (should (overlayp obj)) + (should (eq obj button)) + (should (eq (overlay-buffer obj) obuf)) + (should (= (overlay-start obj) opos)) + (should (= pos opos)) + "overlay function")) + (setq opos (point)) + (setq button (insert-button "overlay" 'help-echo help)) + (should (equal (button--help-echo button) "overlay function"))))) + ;;; button-tests.el ends here commit 660d509acd9da23d9795b5aaa12a5453e6c61bbd Author: Basil L. Contovounesios Date: Tue Oct 1 02:22:31 2019 +0100 Use lexical-binding in button.el * lisp/button.el: Use lexical-binding. Expand Keywords header. Quote function symbols as such. Use ;;;-comments where appropriate. (button): Remove outdated commentary of defface. (define-button-type, make-button, insert-button, make-text-button) (insert-text-button): Clarify in docstring that PROPERTIES argument is a plist. (button-type-subtype-p, button-has-type-p): Do not overspecify return value in docstring. (button-put): Fix typo in commentary. diff --git a/lisp/button.el b/lisp/button.el index 9112e518b0..32efc2f95b 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -1,9 +1,9 @@ -;;; button.el --- clickable buttons +;;; button.el --- clickable buttons -*- lexical-binding: t -*- ;; ;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; ;; Author: Miles Bader -;; Keywords: extensions +;; Keywords: extensions, hypermedia ;; Package: emacs ;; ;; This file is part of GNU Emacs. @@ -49,11 +49,8 @@ ;;; Code: -;; Globals +;;; Globals -;; Use color for the MS-DOS port because it doesn't support underline. -;; FIXME if MS-DOS correctly answers the (supports) question, it need -;; no longer be a special case. (defface button '((t :inherit link)) "Default face used for buttons." :group 'basic-faces) @@ -81,25 +78,25 @@ "Keymap useful for buffers containing buttons. Mode-specific keymaps may want to use this as their parent keymap.") -;; Default properties for buttons +;; Default properties for buttons. (put 'default-button 'face 'button) (put 'default-button 'mouse-face 'highlight) (put 'default-button 'keymap button-map) (put 'default-button 'type 'button) -;; action may be either a function to call, or a marker to go to -(put 'default-button 'action 'ignore) +;; `action' may be either a function to call, or a marker to go to. +(put 'default-button 'action #'ignore) (put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) ;; Make overlay buttons go away if their underlying text is deleted. (put 'default-button 'evaporate t) -;; Prevent insertions adjacent to the text-property buttons from -;; inheriting its properties. +;; Prevent insertions adjacent to text-property buttons from +;; inheriting their properties. (put 'default-button 'rear-nonsticky t) -;; A `category-symbol' property for the default button type +;; A `category-symbol' property for the default button type. (put 'button 'button-category-symbol 'default-button) -;; Button types (which can be used to hold default properties for buttons) +;;; Button types (which can be used to hold default properties for buttons) ;; Because button-type properties are inherited by buttons using the ;; special `category' property (implemented by both overlays and @@ -118,7 +115,7 @@ Buttons inherit them by setting their `category' property to that symbol." (defun define-button-type (name &rest properties) "Define a `button type' called NAME (a symbol). -The remaining arguments form a sequence of PROPERTY VALUE pairs, +The remaining arguments form a plist of PROPERTY VALUE pairs, specifying properties to use as defaults for buttons with this type \(a button's type may be set by giving it a `type' property when creating the button, using the :type keyword argument). @@ -148,7 +145,7 @@ changes to a supertype are not reflected in its subtypes)." (when (eq prop :supertype) (setq prop 'supertype)) (put catsym prop (pop properties)))) - ;; Make sure there's a `supertype' property + ;; Make sure there's a `supertype' property. (unless (get catsym 'supertype) (put catsym 'supertype 'button)) name)) @@ -162,14 +159,14 @@ changes to a supertype are not reflected in its subtypes)." (get (button-category-symbol type) prop)) (defun button-type-subtype-p (type supertype) - "Return t if button-type TYPE is a subtype of SUPERTYPE." + "Return non-nil if button-type TYPE is a subtype of SUPERTYPE." (or (eq type supertype) (and type (button-type-subtype-p (button-type-get type 'supertype) supertype)))) -;; Button properties and other attributes +;;; Button properties and other attributes (defun button-start (button) "Return the position at which BUTTON starts." @@ -203,9 +200,9 @@ changes to a supertype are not reflected in its subtypes)." "Set BUTTON's PROP property to VAL." ;; Treat some properties specially. (cond ((memq prop '(type :type)) - ;; We translate a `type' property a `category' property, since - ;; that's what's actually used by overlays/text-properties for - ;; inheriting properties. + ;; We translate a `type' property to a `category' property, + ;; since that's what's actually used by overlay and + ;; text-property buttons for inheriting properties. (setq prop 'category) (setq val (button-category-symbol val))) ((eq prop 'category) @@ -261,7 +258,7 @@ value instad of BUTTON." (button-get button 'type)) (defun button-has-type-p (button type) - "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." + "Return non-nil if BUTTON has button-type TYPE, or one of its subtypes." (button-type-subtype-p (button-get button 'type) type)) (defun button--area-button-p (b) @@ -272,11 +269,11 @@ Such area buttons are used for buttons in the mode-line and header-line." (defalias 'button--area-button-string #'car "Return area button BUTTON's button-string.") -;; Creating overlay buttons +;;; Creating overlay buttons (defun make-button (beg end &rest properties) "Make a button from BEG to END in the current buffer. -The remaining arguments form a sequence of PROPERTY VALUE pairs, +The remaining arguments form a plist of PROPERTY VALUE pairs, specifying properties to add to the button. In addition, the keyword argument :type may be used to specify a button-type from which to inherit other properties; see @@ -292,12 +289,12 @@ Also see `make-text-button', `insert-button'." ;; If the user didn't specify a type, use the default. (unless (overlay-get overlay 'category) (overlay-put overlay 'category 'default-button)) - ;; OVERLAY is the button, so return it + ;; OVERLAY is the button, so return it. overlay)) (defun insert-button (label &rest properties) "Insert a button with the label LABEL. -The remaining arguments form a sequence of PROPERTY VALUE pairs, +The remaining arguments form a plist of PROPERTY VALUE pairs, specifying properties to add to the button. In addition, the keyword argument :type may be used to specify a button-type from which to inherit other properties; see @@ -310,11 +307,11 @@ Also see `insert-text-button', `make-button'." properties)) -;; Creating text-property buttons +;;; Creating text-property buttons (defun make-text-button (beg end &rest properties) "Make a button from BEG to END in the current buffer. -The remaining arguments form a sequence of PROPERTY VALUE pairs, +The remaining arguments form a plist of PROPERTY VALUE pairs, specifying properties to add to the button. In addition, the keyword argument :type may be used to specify a button-type from which to inherit other properties; see @@ -352,8 +349,8 @@ Also see `insert-text-button'." ;; text-properties for inheritance. (setcar type-entry 'category) (setcar (cdr type-entry) - (button-category-symbol (car (cdr type-entry))))) - ;; Now add all the text properties at once + (button-category-symbol (cadr type-entry)))) + ;; Now add all the text properties at once. (add-text-properties beg end ;; Each button should have a non-eq `button' ;; property so that next-single-property-change can @@ -365,7 +362,7 @@ Also see `insert-text-button'." (defun insert-text-button (label &rest properties) "Insert a button with the label LABEL. -The remaining arguments form a sequence of PROPERTY VALUE pairs, +The remaining arguments form a plist of PROPERTY VALUE pairs, specifying properties to add to the button. In addition, the keyword argument :type may be used to specify a button-type from which to inherit other properties; see @@ -383,7 +380,7 @@ Also see `make-text-button'." properties)) -;; Finding buttons in a buffer +;;; Finding buttons in a buffer (defun button-at (pos) "Return the button at position POS in the current buffer, or nil. @@ -436,7 +433,7 @@ instead of starting at the next button." (button-at (1- pos))))))) -;; User commands +;;; User commands (defun push-button (&optional pos use-mouse-action) "Perform the action specified by a button at location POS. @@ -535,7 +532,6 @@ Returns the button found." (interactive "p\nd\nd") (forward-button (- n) wrap display-message no-error)) - (provide 'button) ;;; button.el ends here commit f12fcdf4cd878b7b3f1221c5818fe221cb339724 Author: John Yates Date: Thu Oct 3 18:55:35 2019 +0200 Preserve point better in hs-hide-comment-region * lisp/progmodes/hideshow.el (hs-hide-comment-region): Preserve point better when collapsing the region (bug#10856). Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 0fb5c55512..c4c75a6c04 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -551,11 +551,13 @@ Original match data is restored upon return." (defun hs-hide-comment-region (beg end &optional repos-end) "Hide a region from BEG to END, marking it as a comment. Optional arg REPOS-END means reposition at end." - (let ((beg-eol (progn (goto-char beg) (line-end-position))) + (let ((goal-col (current-column)) + (beg-bol (progn (goto-char beg) (line-beginning-position))) + (beg-eol (line-end-position)) (end-eol (progn (goto-char end) (line-end-position)))) (hs-discard-overlays beg-eol end-eol) - (hs-make-overlay beg-eol end-eol 'comment beg end)) - (goto-char (if repos-end end beg))) + (hs-make-overlay beg-eol end-eol 'comment beg end) + (goto-char (if repos-end end (min end (+ beg-bol goal-col)))))) (defun hs-hide-block-at-point (&optional end comment-reg) "Hide block if on block beginning. commit bbbced061fbd335da162fbeb023476765b2d9f55 Author: Lars Ingebrigtsen Date: Thu Oct 3 18:07:12 2019 +0200 Make lisp-do-defun do the right thing with trailing comments * lisp/progmodes/inf-lisp.el (lisp-do-defun): Avoid including trailing comments in the region (bug#7974). diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 3476a7f635..dafb89a5b6 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -345,8 +345,11 @@ The actually processing is done by `do-string' and `do-region' which determine whether the code is compiled before evaluation. DEFVAR forms reset the variables to the init values." (save-excursion - (end-of-defun) - (skip-chars-backward " \t\n\r\f") ; Makes allegro happy + ;; Find the end of the defun this way to avoid having the region + ;; possibly end with a comment (it there'a a comment after the + ;; final parenthesis). + (beginning-of-defun) + (forward-sexp) (let ((end (point)) (case-fold-search t)) (beginning-of-defun) (if (looking-at "(defvar") commit 3ad9e5133e7c9895c41bb31b2209d2c1f8fe3239 Author: Lars Ingebrigtsen Date: Thu Oct 3 17:17:50 2019 +0200 Fix bytecomp.el warning a different way than the previous patch * lisp/emacs-lisp/bytecomp.el (emacs-lisp-compilation-mode-map): No need to use set-keymap-parent here; `define-derived-mode' will do that automatically. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1d0f07a941..905d99a597 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,7 +124,7 @@ (require 'backquote) (require 'macroexp) (require 'cconv) -(require 'compile) +(eval-when-compile (require 'compile)) ;; Refrain from using cl-lib at run-time here, since it otherwise prevents ;; us from emitting warnings when compiling files which use cl-lib without ;; requiring it! (bug#30635) @@ -1047,7 +1047,6 @@ message buffer `default-directory'." (defvar emacs-lisp-compilation-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map compilation-minor-mode-map) (define-key map "g" 'emacs-lisp-compilation-recompile) map)) commit 4cf9bbcbc141c29c6ec66178ef46d3b21d276c1a Author: Lars Ingebrigtsen Date: Thu Oct 3 16:57:03 2019 +0200 Fix comment in previous doc-view patch * lisp/doc-view.el (doc-view-open-text): Comment fix. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 1f864f8a45..1fbaebd626 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1523,7 +1523,7 @@ For now these keys are useful: (set-buffer-modified-p nil) (doc-view-minor-mode) (goto-char (point-min)) - ;; Put point at the start of the page the user what + ;; Put point at the start of the page the user was ;; reading. Pages are separated by Control-L characters. (re-search-forward page-delimiter nil t (1- page)) (add-hook 'write-file-functions commit c1c9af312ed32f9e006452eef56ecabf6438cae9 Author: Lars Ingebrigtsen Date: Thu Oct 3 16:54:44 2019 +0200 In doc-view, keep point on the equivalent page in the text version * lisp/doc-view.el (doc-view-open-text): After opening the text version, put point on the page the user was reading (bug#16541). diff --git a/lisp/doc-view.el b/lisp/doc-view.el index f75421e7b5..1f864f8a45 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1505,7 +1505,8 @@ For now these keys are useful: (interactive) (if doc-view--current-converter-processes (message "DocView: please wait till conversion finished.") - (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir)))) + (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))) + (page (doc-view-current-page))) (if (file-readable-p txt) (let ((inhibit-read-only t) (buffer-undo-list t) @@ -1521,6 +1522,10 @@ For now these keys are useful: (setq-local doc-view--buffer-file-name dv-bfn) (set-buffer-modified-p nil) (doc-view-minor-mode) + (goto-char (point-min)) + ;; Put point at the start of the page the user what + ;; reading. Pages are separated by Control-L characters. + (re-search-forward page-delimiter nil t (1- page)) (add-hook 'write-file-functions (lambda () ;; FIXME: If the user changes major mode and then commit 44dfa7a834c11897fd64dba7b15cb0dcce0af980 Author: Stefan Monnier Date: Thu Oct 3 10:36:00 2019 -0400 * lisp/pcomplete.el: Mark 'pcomplete' command as obsolete Remove redundant ':group's. (pcomplete, pcomplete-help): Mark as obsolete. diff --git a/etc/NEWS b/etc/NEWS index 00a01999a7..c8cc7537b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1532,6 +1532,11 @@ available for output of asynchronous shell commands. ** Pcomplete +*** The 'pcomplete' command is now obsolete +The Pcomplete functionality can be obtained via completion-at-point +instead, by adding pcomplete-completions-at-point to +completion-at-point-functions. + *** The function 'pcomplete-uniquify-list' has been renamed from 'pcomplete-uniqify-list'. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 7f20314258..d0e52f9651 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -409,7 +409,7 @@ to writing a completion function." (let ((filename (pcomplete-arg)) glob-name) (if (file-name-directory filename) (if eshell-force-execution - (pcomplete-dirs-or-entries nil 'file-readable-p) + (pcomplete-dirs-or-entries nil #'file-readable-p) (pcomplete-executables)) (if (and (> (length filename) 0) (eq (aref filename 0) eshell-explicit-command-char)) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 401e5aa1da..281f292427 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -30,7 +30,7 @@ ;; To use pcomplete with shell-mode, for example, you will need the ;; following in your init file: ;; -;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup) +;; (add-hook 'shell-mode-hook #'pcomplete-shell-setup) ;; ;; Most of the code below simply provides support mechanisms for ;; writing completion functions. Completion functions themselves are @@ -105,7 +105,7 @@ ;; ;; (defun pcomplete/example () ;; (pcomplete-here (pcomplete-entries)) -;; (if (pcomplete-test 'file-directory-p) +;; (if (pcomplete-test #'file-directory-p) ;; (pcomplete-here (pcomplete-dirs)) ;; (pcomplete-here (pcomplete-entries)))) ;; @@ -129,31 +129,26 @@ (defcustom pcomplete-file-ignore nil "A regexp of filenames to be disregarded during file completion." - :type '(choice regexp (const :tag "None" nil)) - :group 'pcomplete) + :type '(choice regexp (const :tag "None" nil))) (defcustom pcomplete-dir-ignore nil "A regexp of names to be disregarded during directory completion." - :type '(choice regexp (const :tag "None" nil)) - :group 'pcomplete) + :type '(choice regexp (const :tag "None" nil))) (defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) ;; FIXME: the doc mentions file-name completion, but the code ;; seems to apply it to all completions. "If non-nil, ignore case when doing filename completion." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (defcustom pcomplete-autolist nil "If non-nil, automatically list possibilities on partial completion. This mirrors the optional behavior of tcsh." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (defcustom pcomplete-suffix-list (list ?/ ?:) "A list of characters which constitute a proper suffix." - :type '(repeat character) - :group 'pcomplete) + :type '(repeat character)) (make-obsolete-variable 'pcomplete-suffix-list nil "24.1") (defcustom pcomplete-recexact nil @@ -161,25 +156,22 @@ This mirrors the optional behavior of tcsh." This mirrors the optional behavior of tcsh. A non-nil value is useful if `pcomplete-autolist' is non-nil too." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (define-obsolete-variable-alias 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") -(defcustom pcomplete-man-function 'man +(defcustom pcomplete-man-function #'man "A function to that will be called to display a manual page. It will be passed the name of the command to document." - :type 'function - :group 'pcomplete) + :type 'function) -(defcustom pcomplete-compare-entry-function 'string-lessp +(defcustom pcomplete-compare-entry-function #'string-lessp "This function is used to order file entries for completion. The behavior of most all shells is to sort alphabetically." :type '(radio (function-item string-lessp) (function-item file-newer-than-file-p) - (function :tag "Other")) - :group 'pcomplete) + (function :tag "Other"))) (defcustom pcomplete-help nil "A string or function (or nil) used for context-sensitive help. @@ -188,8 +180,7 @@ If non-nil, it must a sexp that will be evaluated, and whose result will be shown in the minibuffer. If nil, the function `pcomplete-man-function' will be called with the current command argument." - :type '(choice string sexp (const :tag "Use man page" nil)) - :group 'pcomplete) + :type '(choice string sexp (const :tag "Use man page" nil))) (defcustom pcomplete-expand-before-complete nil "If non-nil, expand the current argument before completing it. @@ -199,11 +190,10 @@ resolved first, and the resultant value that will be completed against to be inserted in the buffer. Note that exactly what gets expanded and how is entirely up to the behavior of the `pcomplete-parse-arguments-function'." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (defcustom pcomplete-parse-arguments-function - 'pcomplete-parse-buffer-arguments + #'pcomplete-parse-buffer-arguments "A function to call to parse the current line's arguments. It should be called with no parameters, and with point at the position of the argument that is to be completed. @@ -218,8 +208,7 @@ representation of that argument), and BEG-POS gives the beginning position of each argument, as it is seen by the user. The establishes a relationship between the fully resolved value of the argument, and the textual representation of the argument." - :type 'function - :group 'pcomplete) + :type 'function) (defcustom pcomplete-cycle-completions t "If non-nil, hitting the TAB key cycles through the completion list. @@ -230,8 +219,7 @@ it acts more like zsh or 4nt, showing the first maximal match first, followed by any further matches on each subsequent pressing of the TAB key. \\[pcomplete-list] is the key to press if the user wants to see the list of possible completions." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (defcustom pcomplete-cycle-cutoff-length 5 "If the number of completions is greater than this, don't cycle. @@ -246,8 +234,7 @@ has already entered enough input to disambiguate most of the possibilities, and therefore they are probably most interested in cycling through the candidates. Set this value to nil if you want cycling to always be enabled." - :type '(choice integer (const :tag "Always cycle" nil)) - :group 'pcomplete) + :type '(choice integer (const :tag "Always cycle" nil))) (defcustom pcomplete-restore-window-delay 1 "The number of seconds to wait before restoring completion windows. @@ -258,19 +245,17 @@ displayed will be restored), after this many seconds of idle time. If set to nil, completion windows will be left on second until the user removes them manually. If set to 0, they will disappear immediately after the user enters a key other than TAB." - :type '(choice integer (const :tag "Never restore" nil)) - :group 'pcomplete) + :type '(choice integer (const :tag "Never restore" nil))) (defcustom pcomplete-try-first-hook nil "A list of functions which are called before completing an argument. This can be used, for example, for completing things which might apply to all arguments, such as variable names after a $." - :type 'hook - :group 'pcomplete) + :type 'hook) (defsubst pcomplete-executables (&optional regexp) "Complete amongst a list of directories and executables." - (pcomplete-entries regexp 'file-executable-p)) + (pcomplete-entries regexp #'file-executable-p)) (defmacro pcomplete-here (&optional form stub paring form-only) "Complete against the current argument, if at the end. @@ -310,13 +295,11 @@ generate the completions list. This means that the hook (lambda () (pcomplete-here (pcomplete-executables)))) "Function called for completing the initial command argument." - :type 'function - :group 'pcomplete) + :type 'function) -(defcustom pcomplete-command-name-function 'pcomplete-command-name +(defcustom pcomplete-command-name-function #'pcomplete-command-name "Function called for determining the current command name." - :type 'function - :group 'pcomplete) + :type 'function) (defcustom pcomplete-default-completion-function (function @@ -324,16 +307,14 @@ generate the completions list. This means that the hook (while (pcomplete-here (pcomplete-entries))))) "Function called when no completion rule can be found. This function is used to generate completions for every argument." - :type 'function - :group 'pcomplete) + :type 'function) (defcustom pcomplete-use-paring t "If t, pare alternatives that have already been used. If nil, you will always see the completion set of possible options, no matter which of those options have already been used in previous command arguments." - :type 'boolean - :group 'pcomplete) + :type 'boolean) (defcustom pcomplete-termination-string " " "A string that is inserted after any completion or expansion. @@ -342,8 +323,7 @@ words separated by spaces. However, if your list uses a different separator character, or if the completion occurs in a word that is already terminated by a character, this variable should be locally modified to be an empty string, or the desired separation string." - :type 'string - :group 'pcomplete) + :type 'string) ;;; Internal Variables: @@ -528,6 +508,7 @@ Same as `pcomplete' but using the standard completion UI." "Support extensible programmable completion. To use this function, just bind the TAB key to it, or add it to your completion functions list (it should occur fairly early in the list)." + (declare (obsolete "use completion-at-point and pcomplete-completions-at-point" "27.1")) (interactive "p") (if (and interactively pcomplete-cycle-completions @@ -579,7 +560,8 @@ completion functions list (it should occur fairly early in the list)." This will modify the current buffer." (interactive) (let ((pcomplete-expand-before-complete t)) - (pcomplete))) + (with-suppressed-warnings ((obsolete pcomplete)) + (pcomplete)))) ;;;###autoload (defun pcomplete-continue () @@ -596,7 +578,8 @@ This will modify the current buffer." (interactive) (let ((pcomplete-expand-before-complete t) (pcomplete-expand-only-p t)) - (pcomplete) + (with-suppressed-warnings ((obsolete pcomplete)) + (pcomplete)) (when (and pcomplete-current-completions (> (length pcomplete-current-completions) 0)) ;?? (delete-char (- pcomplete-last-completion-length)) @@ -611,9 +594,11 @@ This will modify the current buffer." ;;;###autoload (defun pcomplete-help () "Display any help information relative to the current argument." + (declare (obsolete "use completion-help-at-point and pcomplete-completions-at-point" "27.1")) (interactive) (let ((pcomplete-show-help t)) - (pcomplete))) + (with-suppressed-warnings ((obsolete pcomplete)) + (pcomplete)))) ;;;###autoload (defun pcomplete-list () @@ -626,7 +611,8 @@ This will modify the current buffer." (setq pcomplete-current-completions nil pcomplete-last-completion-raw nil)) (let ((pcomplete-show-list t)) - (pcomplete))) + (with-suppressed-warnings ((obsolete pcomplete)) + (pcomplete)))) ;;; Internal Functions: @@ -751,9 +737,9 @@ COMPLETEF-SYM should be the symbol where the dynamic-complete-functions are kept. For comint mode itself, this is `comint-dynamic-complete-functions'." (set (make-local-variable 'pcomplete-parse-arguments-function) - 'pcomplete-parse-comint-arguments) + #'pcomplete-parse-comint-arguments) (add-hook 'completion-at-point-functions - 'pcomplete-completions-at-point nil 'local) + #'pcomplete-completions-at-point nil 'local) (set (make-local-variable completef-sym) (copy-sequence (symbol-value completef-sym))) (let* ((funs (symbol-value completef-sym)) @@ -915,12 +901,12 @@ component, `default-directory' is used as the basis for completion." (or (eq action t) (eq (car-safe action) 'boundaries)))) (let ((newstring - (mapconcat 'identity (nreverse (cons string strings)) ""))) + (mapconcat #'identity (nreverse (cons string strings)) ""))) ;; FIXME: We could also try to return unexpanded envvars. (complete-with-action action table newstring pred)) (let* ((envpos (apply #'+ (mapcar #' length strings))) (newstring - (mapconcat 'identity (nreverse (cons string strings)) "")) + (mapconcat #'identity (nreverse (cons string strings)) "")) (bounds (completion-boundaries newstring table pred (or (cdr-safe action) "")))) (if (>= (car bounds) envpos) @@ -950,7 +936,7 @@ component, `default-directory' is used as the basis for completion." (defsubst pcomplete-dirs (&optional regexp) "Complete amongst a list of directories." - (pcomplete-entries regexp 'file-directory-p)) + (pcomplete-entries regexp #'file-directory-p)) ;; generation of completion lists @@ -1055,7 +1041,7 @@ See the documentation for `pcomplete-here'." (setq pcomplete-stub stub)) (if (or (eq paring t) (eq paring 0)) (setq pcomplete-seen nil) - (setq pcomplete-norm-func (or paring 'file-truename))) + (setq pcomplete-norm-func (or paring #'file-truename))) (unless form-only (run-hooks 'pcomplete-try-first-hook)) (throw 'pcomplete-completions @@ -1128,7 +1114,7 @@ Typing SPC flushes the help buffer." pcomplete-restore-window-delay) (setq pcomplete-window-restore-timer (run-with-timer pcomplete-restore-window-delay nil - 'pcomplete-restore-windows)))))) + #'pcomplete-restore-windows)))))) ;; insert completion at point @@ -1181,12 +1167,12 @@ extra checking, and munging of the COMPLETIONS list." ;; pare it down, if applicable (when (and pcomplete-use-paring pcomplete-seen) (setq pcomplete-seen - (mapcar 'directory-file-name pcomplete-seen)) + (mapcar #'directory-file-name pcomplete-seen)) (dolist (p pcomplete-seen) (add-to-list 'pcomplete-seen (funcall pcomplete-norm-func p))) (setq completions - (apply-partially 'completion-table-with-predicate + (apply-partially #'completion-table-with-predicate completions (when pcomplete-seen (lambda (f) @@ -1269,8 +1255,10 @@ If specific documentation can't be given, be generic." (if (listp pcomplete-help) (message "%s" (eval pcomplete-help)) (save-window-excursion (info)) + (declare-function Info-goto-node + "info" (nodename &optional fork strict-case)) (switch-to-buffer-other-window "*info*") - (funcall (symbol-function 'Info-goto-node) pcomplete-help)) + (funcall #'Info-goto-node pcomplete-help)) (if pcomplete-man-function (let ((cmd (funcall pcomplete-command-name-function))) (if (and cmd (> (length cmd) 0)) @@ -1297,7 +1285,7 @@ If specific documentation can't be given, be generic." (defun pcomplete-process-result (cmd &rest args) "Call CMD using `call-process' and return the simplest result." (with-temp-buffer - (apply 'call-process cmd nil t nil args) + (apply #'call-process cmd nil t nil args) (skip-chars-backward "\n") (buffer-substring (point-min) (point)))) commit c164f749794e7252887cce10cbfa31fd012351c3 Author: Lars Ingebrigtsen Date: Thu Oct 3 16:32:55 2019 +0200 Mention the vc diff switches in diff-switches * lisp/vc/diff.el (diff-switches): Mention the vc diff switches in the doc string (bug#4422). diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 5fa771f5f1..9ece8bc1fb 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -39,7 +39,12 @@ ;;;###autoload (defcustom diff-switches (purecopy "-u") - "A string or list of strings specifying switches to be passed to diff." + "A string or list of strings specifying switches to be passed to diff. + +This variable is also used in the `vc-diff' command (and related +commands) if the backend-specific diff switch variable isn't +set (`vc-git-diff-switches' for git, for instance), and +`vc-diff-switches' isn't set." :type '(choice string (repeat string)) :group 'diff) commit dacafba03d8cbd6132d84f5c73b61e2ebee6b85a Author: Alan Mackenzie Date: Thu Oct 3 14:26:14 2019 +0000 C++ Mode: Correct the fontification of const auto foo * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): Correct a coding error involving `and' and `or'. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d1cca115f3..4ca440fd84 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9714,12 +9714,12 @@ This function might do hidden buffer changes." (c-forward-syntactic-ws)) - (when (or (and new-style-auto - (looking-at c-auto-ops-re)) - (and (or maybe-typeless backup-maybe-typeless) - (not got-identifier) - (not got-prefix) - at-type)) + (when (and (not got-identifier) + (or (and new-style-auto + (looking-at c-auto-ops-re)) + (and (or maybe-typeless backup-maybe-typeless) + (not got-prefix) + at-type))) ;; Have found no identifier but `c-typeless-decl-kwds' has ;; matched so we know we're inside a declaration. The ;; preceding type must be the identifier instead. commit cbe3f5f7203b54a7e0ffc65dee83289f1a966077 Author: Lars Ingebrigtsen Date: Thu Oct 3 16:15:15 2019 +0200 Touch up previous shr-dom-to-xml encoding change * lisp/net/shr.el (shr-dom-to-xml): Include an XML declaration if we're encoding the data. (shr-parse-image-data): Add comment about why encoding is necessary. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index cf32763a4f..628cc17a5b 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1180,7 +1180,9 @@ Return a string with image data." (eq content-type 'image/svg+xml)) (setq data ;; Note that libxml2 doesn't parse everything perfectly, - ;; so glitches may occur during this transformation. + ;; so glitches may occur during this transformation. And + ;; encode as utf-8: There may be text (and other elements) + ;; that are non-ASCII. (shr-dom-to-xml (libxml-parse-xml-region (point) (point-max)) 'utf-8))) ;; SVG images often do not have a specified foreground/background @@ -1342,7 +1344,10 @@ ones, in case fg and bg are nil." (with-temp-buffer (shr-dom-print dom) (when charset - (encode-coding-region (point-min) (point-max) charset)) + (encode-coding-region (point-min) (point-max) charset) + (goto-char (point-min)) + (insert (format "\n" + charset))) (buffer-string))) (defun shr-dom-print (dom) commit 0b5fe611e996a609866c3d84ee6c2d1e5dffd812 Author: Lars Ingebrigtsen Date: Wed Oct 2 13:19:17 2019 +0200 Fix up previous SVG-multibyte fix * lisp/net/shr.el (shr-dom-to-xml): For SVG images, take an optional charset parameter to return unibyte data. (shr-parse-image-data): Use it. (shr-tag-svg): Ditto. (svg--wrap-svg): Revert previous kludge. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index ef236bf7c4..cf32763a4f 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1146,14 +1146,13 @@ width/height instead." ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) -(autoload 'mm-disable-multibyte "mm-util") (autoload 'browse-url-mail "browse-url") (defun shr-get-image-data (url) "Get image data for URL. Return a string with image data." (with-temp-buffer - (mm-disable-multibyte) + (set-buffer-multibyte nil) (when (ignore-errors (url-cache-extract (url-cache-create-filename (shr-encode-url url))) t) @@ -1183,7 +1182,7 @@ Return a string with image data." ;; Note that libxml2 doesn't parse everything perfectly, ;; so glitches may occur during this transformation. (shr-dom-to-xml - (libxml-parse-xml-region (point) (point-max))))) + (libxml-parse-xml-region (point) (point-max)) 'utf-8))) ;; SVG images often do not have a specified foreground/background ;; color, so wrap them in styles. (when (eq content-type 'image/svg+xml) @@ -1199,9 +1198,7 @@ Return a string with image data." " " (face-foreground 'default) (car size) (cdr size) - (base64-encode-string (encode-coding-string - data (car (detect-coding-string data))) - t))) + (base64-encode-string data t))) (buffer-string)))) (defun shr-image-displayer (content-function) @@ -1341,9 +1338,11 @@ ones, in case fg and bg are nil." (defun shr-tag-comment (_dom) ) -(defun shr-dom-to-xml (dom) +(defun shr-dom-to-xml (dom &optional charset) (with-temp-buffer (shr-dom-print dom) + (when charset + (encode-coding-region (point-min) (point-max) charset)) (buffer-string))) (defun shr-dom-print (dom) @@ -1376,7 +1375,8 @@ ones, in case fg and bg are nil." (not shr-inhibit-images) (dom-attr dom 'width) (dom-attr dom 'height)) - (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml) + (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8) + 'image/svg+xml) "SVG Image"))) (defun shr-tag-sup (dom) commit e7e55e5e4dad95c5e605553d4ad3daa1422d0ea3 Author: Alan Mackenzie Date: Thu Oct 3 12:50:08 2019 +0000 C++ Mode: Fontify correctly declarators with identifier preceded by & The problem was bar in the following being spuriously recognised as a function, and foo as a type, as though the & were a *: Foo foo (&bar);. * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): New variable got-function-name-prefix, which is set when an operator like * (but not &) precedes the putative identifer in parentheses. Test this variable when deciding whether or not to "move the type backwards" to the previous identifier. * lisp/progmodes/cc-langs.el (c-type-decl-operator-prefix-key): New lang const and var. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 6d7d322def..d1cca115f3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9544,6 +9544,9 @@ This function might do hidden buffer changes." ;; True if there's a prefix match outside the outermost ;; paren pair that surrounds the declarator. got-prefix-before-parens + ;; True if there's a prefix, such as "*" which might precede the + ;; identifier in a function declaration. + got-function-name-prefix ;; True if there's a suffix match outside the outermost ;; paren pair that surrounds the declarator. The value is ;; the position of the first suffix match. @@ -9605,6 +9608,9 @@ This function might do hidden buffer changes." (unless got-prefix-before-parens (setq got-prefix-before-parens (= paren-depth 0))) (setq got-prefix t) + (when (save-match-data + (looking-at c-type-decl-operator-prefix-key)) + (setq got-function-name-prefix t)) (goto-char (match-end 1))) (c-forward-syntactic-ws))) @@ -9773,7 +9779,7 @@ This function might do hidden buffer changes." (throw 'at-decl-or-cast t)) (when (and got-parens - (not got-prefix) + (not got-function-name-prefix) ;; (not got-suffix-after-parens) (or backup-at-type maybe-typeless diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 6ba14a8229..d092094817 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3423,7 +3423,7 @@ Identifier syntax is in effect when this is matched \(see 'dont-doc) (c-lang-defconst c-type-decl-operator-prefix-key - "Regexp matching any declarator operator which isn't a keyword + "Regexp matching any declarator operator which isn't a keyword, that might precede the identifier in a declaration, e.g. the \"*\" in \"char *argv\". The end of the first submatch is taken as the end of the operator. Identifier syntax is in effect when commit 5b09393f2cde83f10c84926ba579782fb52e05b8 Author: Michael Albinus Date: Thu Oct 3 10:47:12 2019 +0200 Fix typo in last commit diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 4d5dc21bd7..9507eda27e 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -63,7 +63,7 @@ (setq shadow-homedir invocation-directory) (add-to-list 'tramp-connection-properties - `(,(file-remote-p "/mock::%s") "~" ,invocation-directory))) + `(,(file-remote-p "/mock::") "~" ,invocation-directory))) (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") commit b27c7f3e6083ee8b5d13c2e2103ee6391f2d331f Author: Michael Albinus Date: Thu Oct 3 10:44:02 2019 +0200 Further adaptions for shadowfile-tests.el * test/lisp/shadowfile-tests.el: Change some traces. (shadow-test-remote-temporary-file-directory): Adapt also remote home directory. (shadow--tests-cleanup): Cleanup Tramp. diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index c60767c27c..4d5dc21bd7 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -56,16 +56,17 @@ 'tramp-default-host-alist `("\\`mock\\'" nil ,(system-name))) ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in - ;; batch mode only, therefore. It cannot be + ;; batch mode only, therefore. `shadow-homedir' cannot be ;; `temporary-directory', because the tests with "~" would fail. (unless (and (null noninteractive) (file-directory-p "~/")) - (setenv "HOME" invocation-directory)) + (setenv "HOME" (file-name-unquote temporary-file-directory)) + (setq shadow-homedir invocation-directory) + (add-to-list + 'tramp-connection-properties + `(,(file-remote-p "/mock::%s") "~" ,invocation-directory))) (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") -(message - "%s %s" temporary-file-directory shadow-test-remote-temporary-file-directory) - (setq password-cache-expiry nil shadow-debug (getenv "EMACS_HYDRA_CI") tramp-verbose 0 @@ -76,11 +77,6 @@ (ignore-errors (file-truename shadow-test-remote-temporary-file-directory))) -(when shadow-debug - (message - "%s %s" - temporary-file-directory shadow-test-remote-temporary-file-directory)) - ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) @@ -95,6 +91,9 @@ (defun shadow--tests-cleanup () "Reset all `shadowfile' internals." + ;; Cleanup Tramp. + (tramp-cleanup-connection + (tramp-dissect-file-name shadow-test-remote-temporary-file-directory) t t) ;; Delete auto-saved files. (with-current-buffer (find-file-noselect shadow-info-file 'nowarn) (ignore-errors (delete-file (make-auto-save-file-name))) @@ -740,6 +739,12 @@ guaranteed by the originator of a cluster definition." ;; Cleanup & initialize. (shadow--tests-cleanup) (shadow-initialize) + (when shadow-debug + (message + "%s %s %s %s %s" + temporary-file-directory + shadow-test-remote-temporary-file-directory + shadow-homedir shadow-info-file shadow-todo-file)) ;; Define clusters. (setq cluster1 "cluster1"